Domain.pm

package Ravada::Domain;

use warnings;
use strict;

=head1 NAME

Ravada::Domain - Domains ( Virtual Machines ) library for Ravada

=cut

use Carp qw(carp confess croak cluck);
use Data::Dumper;
use File::Copy qw(copy move);
use File::Rsync;
use Hash::Util qw(lock_hash unlock_hash);
use Image::Magick;
use JSON::XS;
use Moose::Role;
use NetAddr::IP;
use IPC::Run3 qw(run3);
use Time::Piece;

no warnings "experimental::signatures";
use feature qw(signatures);

use Ravada::Domain::Driver;
use Ravada::Utils;

our $TIMEOUT_SHUTDOWN = 20;
our $CONNECTOR;

our $MIN_FREE_MEMORY = 1024*1024;
our $IPTABLES_CHAIN = 'RAVADA';

our %PROPAGATE_FIELD = map { $_ => 1} qw( run_timeout );

our $TIME_CACHE_NETSTAT = 60; # seconds to cache netstat data output
our $RETRY_SET_TIME=10;

_init_connector();

requires 'name';
requires 'remove';
requires 'display_info';

requires 'is_active';
requires 'is_hibernated';
requires 'is_paused';
requires 'is_removed';

requires 'start';
requires 'shutdown';
requires 'shutdown_now';
requires 'force_shutdown';
requires '_do_force_shutdown';

requires 'pause';
requires 'resume';

requires 'rename';
requires 'dettach';
requires 'set_time';

#storage
requires 'add_volume';
requires 'remove_volume';
requires 'list_volumes';
requires 'list_volumes_info';

requires 'disk_device';

requires 'disk_size';

#hardware info

requires 'get_info';
requires 'set_memory';
requires 'set_max_mem';

requires 'autostart';
requires 'hybernate';
requires 'hibernate';

#remote methods
requires 'migrate';

requires 'get_driver';
requires 'get_controller_by_name';
requires 'list_controllers';
requires 'set_controller';
requires 'remove_controller';
requires 'change_hardware';
#
##########################################################

has 'domain' => (
    isa => 'Any'
    ,is => 'rw'
);

has 'timeout_shutdown' => (
    isa => 'Int'
    ,is => 'ro'
    ,default => $TIMEOUT_SHUTDOWN
);

has 'readonly' => (
    isa => 'Int'
    ,is => 'ro'
    ,default => 0
);

has 'storage' => (
    is => 'ro'
    ,isa => 'Object'
    ,required => 0
);

has '_vm' => (
    is => 'rw',
    ,isa => 'Object'
    ,required => 0
);

has 'description' => (
    is => 'rw'
    ,isa => 'Str'
    ,required => 0
    ,trigger => \&_update_description
);

##################################################################################3
#


##################################################################################3
#
# Method Modifiers
#

around 'display_info' => \&_around_display_info;
around 'display_file_tls' => \&_around_display_file_tls;

around 'add_volume' => \&_around_add_volume;
around 'remove_volume' => \&_around_remove_volume;
around 'list_volumes_info' => \&_around_list_volumes_info;

before 'remove' => \&_pre_remove_domain;
#\&_allow_remove;
 after 'remove' => \&_after_remove_domain;

around 'prepare_base' => \&_around_prepare_base;
#before 'prepare_base' => \&_pre_prepare_base;
# after 'prepare_base' => \&_post_prepare_base;

#before 'start' => \&_start_preconditions;
# after 'start' => \&_post_start;
around 'start' => \&_around_start;

before 'pause' => \&_allow_shutdown;
 after 'pause' => \&_post_pause;

before 'hybernate' => \&_allow_shutdown;
 after 'hybernate' => \&_post_hibernate;

before 'hibernate' => \&_allow_shutdown;
 after 'hibernate' => \&_post_hibernate;

before 'resume' => \&_allow_manage;
 after 'resume' => \&_post_resume;

before 'shutdown' => \&_pre_shutdown;
after 'shutdown' => \&_post_shutdown;

around 'shutdown_now' => \&_around_shutdown_now;
around 'force_shutdown' => \&_around_shutdown_now;

before 'remove_base' => \&_pre_remove_base;
after 'remove_base' => \&_post_remove_base;
after 'spinoff' => \&_post_spinoff;

before 'rename' => \&_pre_rename;
after 'rename' => \&_post_rename;

after 'dettach' => \&_post_dettach;

before 'clone' => \&_pre_clone;

after 'screenshot' => \&_post_screenshot;

after '_select_domain_db' => \&_post_select_domain_db;

before 'migrate' => \&_pre_migrate;
after 'migrate' => \&_post_migrate;

around 'get_info' => \&_around_get_info;
around 'set_max_mem' => \&_around_set_max_mem;
around 'set_memory' => \&_around_set_memory;

around 'is_active' => \&_around_is_active;

around 'is_hibernated' => \&_around_is_hibernated;

around 'autostart' => \&_around_autostart;

before 'set_controller' => \&_pre_change_hardware;
before 'remove_controller' => \&_pre_change_hardware;
before 'change_hardware' => \&_pre_change_hardware;

after 'set_controller' => \&_post_change_hardware;
after 'remove_controller' => \&_post_change_hardware;
after 'change_hardware' => \&_post_change_hardware;

around 'name' => \&_around_name;

##################################################
#

sub BUILD {
    my $self = shift;
    my $args = shift;

    my $name;
    $name = $args->{name}               if exists $args->{name};

    $self->{_name} = $name  if $name;

    $self->_init_connector();

    $self->is_known();
}

sub _check_clean_shutdown($self) {
    return if !$self->is_known || $self->readonly || $self->is_volatile;

    if (( $self->_data('status') eq 'active' && !$self->is_active )
        || $self->_active_iptables(id_domain => $self->id)) {
            $self->_post_shutdown();
    }
}

sub _set_last_vm($self,$force=0) {
    my $id_vm;
    $id_vm = $self->_data('id_vm')  if $self->is_known();
    return $self->_set_vm($id_vm, $force)   if $id_vm;
}

sub _set_vm($self, $vm, $force=0) {
    if (!ref($vm)) {
        $vm = Ravada::VM->open($vm);
    }

    my $domain;
    eval { $domain = $vm->search_domain($self->name) };
    die $@ if $@ && $@ !~ /no domain with matching name/;
    if ($domain && ($force || $domain->is_active)) {
       $self->_vm($vm);
       $self->domain($domain->domain);
        $self->_update_id_vm();
    }
    return $vm->id;

}

sub _check_equal_storage_pools($self, $vm2) {
    my $vm1 = $self->_vm;
    my @sp;
    push @sp,($vm1->default_storage_pool_name)  if $vm1->default_storage_pool_name;
    push @sp,($vm1->base_storage_pool)  if $vm1->base_storage_pool;
    push @sp,($vm1->clone_storage_pool) if $vm1->clone_storage_pool;

    my %sp1 = map { $_ => 1 } @sp;

    my @sp1 = grep /./,keys %sp1;

    my %sp2 = map { $_ => 1 } $vm2->list_storage_pools();

    for my $pool ( @sp1 ) {
        next if $sp2{ $pool };
        die "Error: Storage pool '$pool' not found on node ".$vm2->name."\n"
            .Dumper([keys %sp2]);
    }
    return 1;
}

sub _vm_connect {
    my $self = shift;
    $self->_vm->connect();
}

sub _vm_disconnect {
    my $self = shift;
    $self->_vm->disconnect();
}

sub _around_start($orig, $self, @arg) {

    $self->_start_preconditions(@arg);

    my %arg;
    if (!(scalar(@arg) % 2) ) {
        %arg = @arg;
    } else {
        $arg{user} = $arg[0];
    }

    my $listen_ip = delete $arg{listen_ip};
    my $remote_ip = $arg{remote_ip};

    for (;;) {
        eval { $self->_start_checks(@arg) };
        if ($@ && $@ =~/base file not found/ && !$self->_vm->is_local) {
            $self->_request_set_base();
            next;
        }
        if (!defined $listen_ip) {
            my $display_ip;
            if ($remote_ip) {
                my $set_password = 0;
                my $network = Ravada::Network->new(address => $remote_ip);
                $set_password = 1 if $network->requires_password();
                $display_ip = $self->_listen_ip($remote_ip);
                $arg{set_password} = $set_password;
            } else {
                $display_ip = $self->_listen_ip();
            }
            $arg{listen_ip} = $display_ip;
        }
        eval { $self->$orig(%arg) };
        my $error = $@;
        last if !$error;
        warn "WARNING: $error ".$self->_vm->name." ".$self->_vm->enabled if $error;
        if ($error && $self->id_base && !$self->is_local && $self->_vm->enabled) {
            $self->_request_set_base();
            next;
        }
        die $@;
    }
    $self->_post_start(%arg);

}

sub _request_set_base($self) {
    my $base = Ravada::Domain->open($self->id_base);
    $base->_set_base_vm_db($self->_vm->id,0);
    Ravada::Request->set_base_vm(
        uid => Ravada::Utils::user_daemon->id
        ,id_domain => $base->id
        ,id_vm => $self->_vm->id
    );
    my $vm_local = $self->_vm->new( host => 'localhost' );
    $self->_set_vm($vm_local, 1);
}

sub _start_preconditions{
    my ($self) = @_;

    die "Domain ".$self->name." is a base. Bases can't get started.\n"
        if $self->is_base();

    my $request;
    my $id_vm;
    if (scalar @_ %2 ) {
        my @args = @_;
        shift @args;
        my %args = @args;
        my $user = delete $args{user};
        my $remote_ip = delete $args{remote_ip};
        $request = delete $args{request} if exists $args{request};
        $id_vm = delete $args{id_vm};

        confess "ERROR: Unknown argument ".join("," , sort keys %args)
            ."\n\tknown: remote_ip, user"   if keys %args;
        _allow_manage_args(@_);
    } else {
        _allow_manage(@_);
    }
    #_check_used_memory(@_);
    $self->status('starting');
}

sub _start_checks($self, @args) {
    return if $self->_search_already_started('fast');
    my $vm_local = $self->_vm->new( host => 'localhost' );
    my $vm = $vm_local;

    my ($id_vm, $request);
    if (!scalar(@args) % 2) {
        my %args = @args;

        # We may be asked to start the machine in a specific id_vmanager
        $id_vm = delete $args{id_vm};
        $request = delete $args{request} if exists $args{request};
    }
    # If not specific id_manager we go to the last id_vmanager unless it was localhost
    # If the last VManager was localhost it will try to balance here.
    $id_vm = $self->_data('id_vm')
    if !$id_vm && defined $self->_data('id_vm')
    && $self->_data('id_vm') != $vm_local->id;

    if ($id_vm) {
        $vm = Ravada::VM->open($id_vm);
        if ( !$vm->is_enabled || !$vm->ping ) {
            $vm = $vm_local;
            $id_vm = undef;
        }
    }
    $self->_check_tmp_volumes();

    # if it is a clone ( it is not a base )
    if ($self->id_base) {
#        $self->_set_last_vm(1)
        if ( !$self->is_local
            && ( !$self->_vm->enabled || !base_in_vm($self->id_base,$self->_vm->id)
                || !$self->_vm->ping) ) {
            $self->_set_vm($vm_local, 1);
        }
        if ( !$vm->is_alive ) {
            $vm->disconnect();
            $vm->connect;
            $vm = $vm_local if !$vm->is_local && !$vm->is_alive;
        };
        if ($id_vm) {
            $self->_set_vm($vm);
        } else {
            $self->_balance_vm();
        }
        $self->rsync(request => $request)  if !$self->is_volatile && !$self->_vm->is_local();
    } elsif (!$self->is_local) {
        $self->_set_vm($vm_local, 1);
    }
    $self->_check_free_vm_memory();
    #TODO: remove them and make it more general now we have nodes
    #$self->_check_cpu_usage($request);
}

sub _search_already_started($self, $fast = 0) {
    my $sql = "SELECT id FROM vms where vm_type=?";
    $sql .= " AND is_active=1" if $fast;
    my $sth = $$CONNECTOR->dbh->prepare($sql);
    $sth->execute($self->_vm->type);
    my %started;
    while (my ($id) = $sth->fetchrow) {
        my $vm = Ravada::VM->open($id);
        next if !$vm->enabled;

        my $vm_active;
        eval {
            $vm_active = $vm->is_active;
        };
        my $error = $@;
        if ($error) {
            warn $error;
            $vm->enabled(0) if !$vm->is_local;
            next;
        }
        next if !$vm_active;

        my $domain;
        eval { $domain = $vm->search_domain($self->name) };
        if ( $@ ) {
            warn $@;
            $vm->enabled(0) if !$vm->is_local;
            next;
        }
        next if !$domain;
        if ( $domain->is_active || $domain->is_hibernated ) {
            $self->_set_vm($vm,'force');
            $started{$vm->id}++;

            my $status = 'shutdown';
            $status = 'active'  if $domain->is_active;
            $domain->_data(status => $status);
        }
    }
    if (keys %started > 1) {
        for my $id_vm (sort keys %started) {
            Ravada::Request->shutdown_domain(
                id_domain => $self->id
                , uid => $self->id_owner
                , id_vm => $id_vm
                ,timeout => $TIMEOUT_SHUTDOWN
            );
        }
    }
    return keys %started;
}

sub _balance_vm($self) {
    return if $self->{_migrated};

    my $base;
    $base = Ravada::Domain->open($self->id_base) if $self->id_base;

    my $vm_free;
    for (;;) {
        $vm_free = $self->_vm->balance_vm($base);
        return if !$vm_free;

        last if $vm_free->id == $self->_vm->id;
        eval { $self->migrate($vm_free) };
        last if !$@;
        if ($@ && $@ =~ /file not found/i) {
            $base->_set_base_vm_db($vm_free->id,0);
            Ravada::Request->set_base_vm(
                uid => Ravada::Utils::user_daemon->id
                ,id_domain => $base->id
                ,id_vm => $vm_free->id
            );
            next;
        }
        die $@;
    }
    return $vm_free->id;
}

sub _update_description {
    my $self = shift;

    return if defined $self->description
        && defined $self->_data('description')
        && $self->description eq $self->_data('description');

    my $sth = $$CONNECTOR->dbh->prepare(
        "UPDATE domains SET description=? "
        ." WHERE id=? ");
    $sth->execute($self->description,$self->id);
    $sth->finish;
    $self->{_data}->{description} = $self->{description};
}

sub _allow_manage_args {
    my $self = shift;

    confess "Disabled from read only connection"
        if $self->readonly;

    my %args = @_;

    confess "Missing user arg ".Dumper(\%args)
        if !$args{user} ;

    $self->_allowed($args{user});

}
sub _allow_manage {
    my $self = shift;

    return $self->_allow_manage_args(@_)
        if scalar(@_) % 2 == 0;

    my ($user) = @_;
    return $self->_allow_manage_args( user => $user);

}

sub _allow_remove($self, $user) {

    confess "ERROR: Undefined user" if !defined $user;

    return if !$self->is_known(); # already removed

    confess "Error: arg user is not Ravada::Auth object" if !ref($user);

    die "ERROR: remove not allowed for user ".$user->name
        unless $user->can_remove_machine($self);

    $self->_check_has_clones() if $self->is_known();
    if ( $self->is_known
        && $self->id_base
        && ($user->can_remove_clones() || $user->can_remove_clone_all())
    ) {
        my $base = $self->open(id => $self->id_base, id_vm => $self->_vm->id);
        return if ($user->can_remove_clone_all() || ($base->id_owner == $user->id));
    }

}

sub _allow_shutdown {
    my $self = shift;
    my %args;

    if (scalar @_ == 1 ) {
        $args{user} = shift;
    } else {
        %args = @_;
    }
    my $user = $args{user} || confess "ERROR: Missing user arg";

    if ( $self->id_base() && $user->can_shutdown_clone()) {
        my $base = Ravada::Domain->open($self->id_base)
            or confess "ERROR: Base domain id: ".$self->id_base." not found";
        return if $base->id_owner == $user->id;
    } elsif($user->can_shutdown_all) {
        return;
    }
    confess "User ".$user->name." [".$user->id."] not allowed to shutdown ".$self->name
        ." owned by ".($self->id_owner or '<UNDEF>')
            if !$user->can_shutdown($self->id);
}

sub _around_add_volume {
    my $orig = shift;
    my $self = shift;
    confess "ERROR in args ".Dumper(\@_)
        if scalar @_ % 2;
    my %args = @_;

    my $file = ($args{file} or $args{path});
    confess if $args{id_iso} && !$file;
    my $name = $args{name};
    $args{target} = $self->_new_target_dev() if !exists $args{target};

    if (!$name) {
        ($name) = $file =~ m{.*/(.*)} if !$name && $file;
        $name = $self->name if !$name;

        $name .= "-".$args{target}."-".Ravada::Utils::random_name(4);
        $args{name} = $name;
    }

    $args{size} = delete $args{capacity} if exists $args{capacity} && !exists $args{size};
    my $size = $args{size};
    if ( $file ) {
        $self->_check_volume_added($file);
    }
    $args{size} = Ravada::Utils::size_to_number($size) if defined $size;
    $args{allocation} = Ravada::Utils::size_to_number($args{allocation})
        if exists $args{allocation} && defined $args{allocation};

    my $free = $self->_vm->free_disk();
    my $free_out = int($free / 1024 / 1024 / 1024 ) * 1024 *1024 *1024;

    confess "Error creating volume, out of space $size . Disk free: "
            .Ravada::Utils::number_to_size($free_out)
            ."\n"
        if exists $args{size} && $args{size} >= $free;

    if ($name) {
        confess "Error: volume $name already exists"
            if grep {$_->info->{name} eq $name} $self->list_volumes_info;
    }
    confess "Error: target $args{target} already exists"
            if grep {$_->info->{target} eq $args{target} } $self->list_volumes_info;

    my $ok = $self->$orig(%args);
    confess "Error adding ".Dumper(\%args) if !$ok;

    return $ok;
}

sub _check_volume_added($self, $file) {
    return if $file =~ /\.iso$/i;

    my $sth = $$CONNECTOR->dbh->prepare("SELECT id,id_domain FROM volumes "
        ." WHERE file=?"
    );
    $sth->execute($file);
    my ($id, $id_domain) = $sth->fetchrow();
    $sth->finish;

    return if !$id;

    confess "Volume $file already in domain id $id_domain, this is ".$self->id;
}

sub _around_remove_volume {
    my $orig = shift;
    my $self = shift;
    my ($file) = @_;

    my $ok = $self->$orig(@_);

    return $ok if !$self->is_local;

    my $sth = $$CONNECTOR->dbh->prepare(
        "DELETE FROM volumes "
        ." WHERE id_domain=? AND file=?"
    );
    $sth->execute($self->id, $file);
    return $ok;
}

sub _around_list_volumes_info($orig, $self, $attribute=undef, $value=undef) {
    confess "Error: value must be supplied for filter attribute"
    if defined $attribute && !defined $value;

    return $self->$orig($attribute, $value) if ref($self) =~ /^Ravada::Front/i;

    my @volumes = $self->$orig($attribute => $value);

    return @volumes;
}

sub _around_prepare_base($orig, $self, @args) {
    #sub _around_prepare_base($orig, $self, $user, $request = undef) {
    my ($user, $request, $with_cd);
    if(ref($args[0]) =~/^Ravada::/) {
        ($user, $request) = @args;
    } else {
        my %args = @args;
        $user = delete $args{user};
        $request = delete $args{request};
        $with_cd = delete $args{with_cd};
        confess "Error: uknown args". Dumper(\%args) if keys %args;
    }
    $self->_pre_prepare_base($user, $request);

    if (!$self->is_local) {
        my $vm_local = $self->_vm->new( host => 'localhost' );
        $self->_vm($vm_local);
    }
    my @base_img = $self->$orig($with_cd);

    die "Error: No information files returned from prepare_base"
        if !scalar (\@base_img);

    $self->_prepare_base_db(@base_img);

    $self->_post_prepare_base($user, $request);
}

=head2 prepare_base

Prepares the virtual machine as a base:

=over

=item * shuts it down

=item * creates read only volumes based on this base

=item * locks it so it won't get started

=item * stores the virtual machine template for the clones

=cut

sub prepare_base($self, $with_cd) {
    my @base_img;
    for my $volume ($self->list_volumes_info()) {
        my $base_file = $volume->base_filename;
        next if !$base_file || $base_file =~ /\.iso$/;
        confess "Error: file '$base_file' already exists in ".$self->_vm->name
            if $self->_vm->file_exists($base_file);
    }

    for my $volume ($self->list_volumes_info()) {
        next if !$volume->info->{target} && $volume->info->{device} eq 'cdrom';
        next if $volume->info->{device} eq 'cdrom' && !$with_cd;
        confess "Undefined info->target ".Dumper($volume)
            if !$volume->info->{target};

        my $base = $volume->prepare_base();
        push @base_img,([$base, $volume->info->{target}]);
    }
    $self->post_prepare_base();
    return @base_img;
}

=head2 post_prepare_base

Placeholder for optional method implemented in subclasses. This will
run after preparing the base files.

=cut

sub post_prepare_base($self) {}

sub _pre_prepare_base($self, $user, $request = undef ) {

    $self->_allowed($user);

    my $owner = Ravada::Auth::SQL->search_by_id($self->id_owner);
    confess "User ".$user->name." [".$user->id."] not allowed to prepare base ".$self->domain
        ." owned by ".($owner->name or '<UNDEF>')."\n"
            unless $user->is_admin || (
                $self->id_owner == $user->id && $user->can_create_base());


    # TODO: if disk is not base and disks have not been modified, do not generate them
    # again, just re-attach them 
#    $self->_check_disk_modified(
    confess "ERROR: domain ".$self->name." is already a base" if $self->is_base();
    $self->_check_has_clones();

    $self->is_base(0);
    $self->_post_remove_base();
    if ($self->is_active) {
        $self->shutdown(user => $user);
        for ( 1 .. $TIMEOUT_SHUTDOWN ) {
            last if !$self->is_active;
            sleep 1;
        }
        if ($self->is_active ) {
            $request->status('working'
                    ,"Domain ".$self->name." still active, forcing hard shutdown")
                if $request;
            $self->force_shutdown($user);
            sleep 1;
        }
    }
    if (!$self->is_local) {
        my $vm_local = Ravada::VM->open( type => $self->vm );
        $self->migrate($vm_local);
    }
    if ($self->id_base ) {
        $self->spinoff();
    }
    $self->_check_free_space_prepare_base();
}

sub _check_free_space_prepare_base($self) {
    my $pool_base = $self->_vm->default_storage_pool_name;
    $pool_base = $self->_vm->base_storage_pool()   if $self->_vm->base_storage_pool();

    for my $volume ($self->list_volumes_info(device => 'disk')) {;
        $self->_vm->_check_free_disk($volume->capacity * 2, $pool_base);
    }
};

sub _post_prepare_base {
    my $self = shift;

    my ($user) = @_;

    $self->is_base(1);

    if ($self->id_base && !$self->description()) {
        my $base = Ravada::Domain->open($self->id_base);
        $self->description($base->description)  if $base->description();
    }

    $self->_remove_id_base();
    $self->_set_base_vm_db($self->_vm->id,1);
    $self->autostart(0,$user);
};

=pod

=head2 spinoff

Makes volumes indpendent from base

=cut

sub spinoff {
    my $self = shift;

    $self->_do_force_shutdown() if $self->is_active;
    confess "Error: spinoff from remote nodes not available. Node: ".$self->_vm->name
        if !$self->is_local;

    for my $volume ($self->list_volumes_info ) {
        next if !$volume->file || $volume->file =~ /\.iso$/i;
        my $bf;
        eval { $bf = $volume->backing_file };
        die $@ if $@ && $@ !~ /No backing file/;
        next if !$bf;
        $volume->spinoff;
    }
}


sub _around_autostart($orig, $self, @arg) {
    my ($value, $user) = @arg;
    $self->_allowed($user) if defined $value;
    confess "ERROR: Autostart can't be activated on base ".$self->name
        if $value && $self->is_base;

    confess "ERROR: You can't set autostart on readonly domains"
        if defined $value && $self->readonly;
    my $autostart = 0;
    my @orig_args = ();
    push @orig_args, ( $value) if defined $value;

    # We only set the internal autostart when domain is not in nodes
    if ($self->_domain_in_nodes) {
        if (defined $value) {
            $autostart = $value;
        } else {
            $autostart = $self->_data('autostart');
        }
    } elsif ( $self->$orig(@orig_args) ) {
        $autostart = 1;
    }
    $self->_data(autostart => $autostart)   if defined $value;
    return $autostart;
}

sub _check_has_clones {
    my $self = shift;
    return if !$self->is_known();

    my @clones = $self->clones;
    die "Domain ".$self->name." has ".scalar @clones." clones : ".Dumper(\@clones)
        if $#clones>=0;
}

sub _check_free_vm_memory {
    my $self = shift;

    return if !$self->_vm->min_free_memory;
    my $vm_free_mem = $self->_vm->free_memory;

    return if $vm_free_mem > $self->_vm->min_free_memory;

    my $msg = "Error: No free memory in ".$self->_vm->name.". Only "._gb($vm_free_mem)." out of "
        ._gb($self->_vm->min_free_memory)." GB required.\n";

    die $msg;
}

sub _check_tmp_volumes($self) {
    confess "Error: only clones temporary volumes can be checked."
        if !$self->id_base;
    my $vm_local = $self->_vm->new( host => 'localhost' );
    for my $vol ( $self->list_volumes_info) {
        next unless $vol->file && $vol->file =~ /\.(TMP|SWAP)\./;
        next if $vm_local->file_exists($vol->file);

        my $base = Ravada::Domain->open($self->id_base);
        my @volumes = $base->list_files_base_target;
        my ($file_base) = grep { $_->[1] eq $vol->info->{target} } @volumes;
        if (!$file_base) {
            warn "Error: I can't find base volume for target ".$vol->info->{target}
                .Dumper(\@volumes);
        }
        my $vol_base = Ravada::Volume->new( file => $file_base->[0]
            , vm => $vm_local
        );
        $vol_base->clone(file => $vol->file);
    }
}

sub _check_cpu_usage($self, $request=undef){

    return if ref($self) =~ /Void/i;
    if ($self->_vm->active_limit){
        chomp(my $cpu_count = `grep -c -P '^processor\\s+:' /proc/cpuinfo`);
        die "Error: Too many active domains." if (scalar $self->_vm->vm->list_domains() >= $self->_vm->active_limit);
    }
    
    my @cpu;
    my $msg;
    for ( 1 .. 10 ) {
        open( my $stat ,'<','/proc/loadavg') or die "WTF: $!";
        @cpu = split /\s+/, <$stat>;
        close $stat;

        if ( $cpu[0] < $self->_vm->max_load ) {
            $request->error('') if $request;
            return;
        }
        $msg = "Error: CPU Too loaded. ".($cpu[0])." out of "
        	.$self->_vm->max_load." max specified.";
        $request->error($msg)   if $request;
        die "$msg\n" if $cpu[0] > $self->_vm->max_load +1;
        sleep 1;
    }
    die "$msg\n";
}

sub _gb($mem=0) {
    my $gb = $mem / 1024 / 1024 ;

    $gb =~ s/(\d+\.\d).*/$1/;
    return ($gb);

}

=pod

sub _check_disk_modified {
    my $self = shift;

    if ( !$self->is_base() ) {
        return;
    }

    my $last_stat_base = 0;
    for my $file_base ( $self->list_files_base ) {
        my @stat_base = stat($file_base);
        $last_stat_base = $stat_base[9] if$stat_base[9] > $last_stat_base;
#        warn $last_stat_base;
    }

    my $files_updated = 0;
    for my $file ( $self->disk_device ) {
        my @stat = stat($file) or next;
        $files_updated++ if $stat[9] > $last_stat_base;
#        warn "\ncheck\t$file ".$stat[9]."\n vs \tfile_base $last_stat_base $files_updated\n";
    }
    die "Base already created and no disk images updated"
        if !$files_updated;
}

=cut

sub _allowed {
    my $self = shift;

    my ($user) = @_;

    confess "Missing user"  if !defined $user;
    confess "ERROR: User '$user' not class user , it is ".(ref($user) or 'SCALAR')
        if !ref $user || ref($user) !~ /Ravada::Auth/;

    return if $user->is_admin;
    my $id_owner;
    eval { $id_owner = $self->id_owner };
    my $err = $@;

    confess "User ".$user->name." [".$user->id."] not allowed to access ".$self->name
        ." owned by ".($id_owner or '<UNDEF>')
            if (defined $id_owner && $id_owner != $user->id );

    confess $err if $err;

}

sub _around_display_info($orig,$self,$user ) {
    $self->_allowed($user);
    my $display = $self->$orig($user);

    if (!$self->readonly) {
        $self->_set_display_ip($display);
        $self->_data(display => encode_json($display)) if $self->is_active;
    }
    return $display;
}

sub _set_display_ip($self, $display) {

    my $new_ip = ( $self->_vm->nat_ip
            or $self->_vm->public_ip
            or Ravada::display_ip()
    );
    unlock_hash(%$display);
    $display->{listen_ip} = $display->{ip};

    if ( $new_ip ) {
        $display->{ip} = $new_ip;
        $display->{display} =~ s{(\w+)://(.*?):(.*)}{$1://$new_ip:$3};
    }

    lock_hash(%$display);
}

sub _around_get_info($orig, $self) {
    my $info = $self->$orig();
    if (ref($self) =~ /^Ravada::Domain/ && $self->is_known()) {
        $info->{ip} = $self->ip() if $self->is_active;
        $self->_data(info => encode_json($info));
    }
    return $info;
}

sub _around_set_memory($orig, $self, $value) {
    my $ret = $self->$orig($value);
    if ($self->is_known) {
        my $info;
        eval { $info = decode_json($self->_data('info')) if $self->_data('info')};
        warn $@ if $@ && $@ !~ /malformed JSON/i;
        $info->{memory} = $value;
        $self->_data(info => encode_json($info));
    }
    return $ret;
}

sub _around_set_max_mem($orig, $self, $value) {
    my $ret = $self->$orig($value);
    if ($self->is_known) {
        my $info;
        eval { $info = decode_json($self->_data('info')) if $self->_data('info')};
        warn $@ if $@ && $@ !~ /malformed JSON/i;
        $info->{max_mem} = $value;
        $self->_data(info => encode_json($info))
    }
    return $ret;
}

##################################################################################3

sub _init_connector {
    return if $CONNECTOR && $$CONNECTOR;
    $CONNECTOR = \$Ravada::CONNECTOR if $Ravada::CONNECTOR;
    $CONNECTOR = \$Ravada::Front::CONNECTOR if !defined $$CONNECTOR
                                                && defined $Ravada::Front::CONNECTOR;
}

=head2 id
Returns the id of  the domain
    my $id = $domain->id();
=cut

sub id($self) {
    return $self->{_id} if exists $self->{_id};
    my $id = $_[0]->_data('id');
    $self->{_id} = $id;
    return $id;
}


##################################################################################

sub _execute_request($self, $field, $value) {
    my %req = (
        pools => 'manage_pools'
        ,pool_start => 'manage_pools'
        ,pool_clones => 'manage_pools'
    );
    my $exec = $req{$field} or return;

    Ravada::Request->_new_request(
        command => $exec
        ,args => { id_domain => $self->id , uid => Ravada::Utils::user_daemon->id }
    );
}

sub _data($self, $field, $value=undef, $table='domains') {

    _init_connector();

    my $data = "_data";
    my $field_id = 'id';
    if ($table ne 'domains' ) {
        $data = "_data_$table";
        $field_id = 'id_domain';
    }

    if (defined $value) {
        confess "Domain ".$self->name." is not in the DB"
            if !$self->is_known();

        confess "ERROR: Invalid field '$field'"
            if $field !~ /^[a-z]+[a-z0-9_]*$/;

        my $sth = $$CONNECTOR->dbh->prepare(
            "UPDATE $table set $field=? WHERE $field_id=?"
        );
        $sth->execute($value, $self->id);
        $sth->finish;
        $self->{$data}->{$field} = $value;
        $self->_propagate_data($field,$value) if $PROPAGATE_FIELD{$field};
        $self->_execute_request($field,$value);
    }
    return $self->{$data}->{$field} if exists $self->{$data}->{$field};

    my @field_select;
    if ($table eq 'domains' ) {
        if (exists $self->{_data}->{id} ) {
            @field_select = ( id => $self->{_data}->{id});
        } else {
            confess "ERROR: Unknown domain" if ref($self) =~ /^Ravada::Front::Domain/;
            @field_select = ( name => $self->name );
        }
    } else {
        @field_select = ( id_domain => $self->id );
    }

    $self->{$data} = $self->_select_domain_db( _table => $table, @field_select );

    confess "No DB info for domain @field_select in $table ".$self->name 
        if ! exists $self->{$data};
    confess "No field $field in $data ".Dumper(\@field_select)."\n".Dumper($self->{$data})
        if !exists $self->{$data}->{$field};

    return $self->{$data}->{$field};
}

sub _data_extra($self, $field, $value=undef) {
    $self->_insert_db_extra()   if !$self->is_known_extra();