Refactor set base in node

lib/Ravada.pm

@@ -2711,7 +2711,7 @@ sub _sql_insert_defaults($self){
             ,{
                 id_parent => $id_backend
                 ,name => 'delay_migrate_back'
-                ,value => 600
+                ,value => 60 * 60 * 24
             }
             ,{
                 id_parent => $id_backend
@@ -2978,6 +2978,7 @@ sub _upgrade_tables {
 
     $self->_upgrade_table('bases_vm','id_vm','int not null references `vms` (`id`) ON DELETE CASCADE');
     $self->_upgrade_table('bases_vm','id_domain','int not null references `domains` (`id`) ON DELETE CASCADE');
+    $self->_upgrade_table('bases_vm','id_request','integer');
 
     $self->_upgrade_table('domain_instances','id_vm','int not null references `vms` (`id`) ON DELETE CASCADE');
 
@@ -5752,8 +5753,8 @@ sub _cmd_connect_node($self, $request) {
     my $node;
 
     if ($id_node) {
-        $node = Ravada::VM->open($id_node);
-        $hostname = $node->host;
+        $node = Ravada::VM->open(id => $id_node, force => 1);
+        $hostname = $node->host if $node;
     } else {
         $node = Ravada::VM->open( type => $backend
             , host => $hostname
@@ -5762,7 +5763,7 @@ sub _cmd_connect_node($self, $request) {
     }
 
     die "I can't ping $hostname\n"
-        if ! $node->ping();
+        if !$node || ! $node->ping();
 
     $request->error("Ping ok. Trying to connect to $hostname");
     my ($out, $err);
@@ -5778,7 +5779,10 @@ sub _cmd_connect_node($self, $request) {
         $err .= "\n";
         die $err if $err;
     }
-    $node->connect() && $request->error("Connection OK");
+    $node->connect() && do {
+        $request->error("Connection OK");
+        $node->_data('cached_down' => 0);
+    };
 }
 
 sub _cmd_list_network_interfaces($self, $request) {
@@ -6003,7 +6007,7 @@ sub _refresh_active_vms ($self) {
     my %active_vm;
     for my $vm ($self->list_vms) {
         next if !$vm;
-        if ( !$vm->enabled() || !$vm->is_active ) {
+        if ( !$vm->vm || !$vm->enabled() || !$vm->is_active ) {
             $vm->shutdown_domains();
             $active_vm{$vm->id} = 0;
             $vm->disconnect();
@@ -6038,7 +6042,7 @@ sub _refresh_active_domains($self, $request=undef) {
             my $t0 = time;
             for my $domain_data (sort { $b->{date_changed} cmp $a->{date_changed} }
                                 @domains) {
-                $request->error("checking $domain_data->{name}") if $request;
+                $request->output("checking $domain_data->{name}") if $request;
                 next if $active_domain{$domain_data->{id}};
                 my $domain;
                 eval { $domain = Ravada::Domain->open($domain_data->{id}) };
@@ -6202,6 +6206,7 @@ sub _refresh_disabled_nodes($self, $request = undef ) {
 }
 
 sub _refresh_active_domain($self, $domain, $active_domain) {
+    return if $domain->is_locked();
     $domain->check_status();
 
     return $self->_refresh_hibernated($domain) if $domain->is_hibernated();
@@ -6326,6 +6331,18 @@ sub _cmd_set_base_vm {
     my $id_vm = $request->args('id_vm')         or die "ERROR: Missing id_vm";
     my $id_domain = $request->args('id_domain') or die "ERROR: Missing id_domain";
 
+    eval {
+        $self->_do_cmd_set_base_vm($uid, $id_vm, $id_domain, $value, $request);
+    };
+    my $err = $@;
+    if ($err) {
+        my $domain = Ravada::Front::Domain->open($id_domain);
+        $domain->_set_base_vm_db($id_vm, (!$value or 0), 0);
+        die $err;
+    }
+}
+
+sub _do_cmd_set_base_vm($self, $uid, $id_vm, $id_domain, $value, $request) {
     my $user = Ravada::Auth::SQL->search_by_id($uid);
     my $domain = Ravada::Domain->open($id_domain) or confess "Error: Unknown domain id $id_domain";
 

lib/Ravada/Domain.pm

@@ -367,12 +367,14 @@ sub _around_start($orig, $self, @arg) {
         $error = $@;
         last if !$error;
 
-        die "Error: starting ".$self->name." on ".$self->_vm->name." $error"
+        my $vm_name = Ravada::VM::_get_name_by_id($self->_data('id_vm'));
+
+        die "Error: starting ".$self->name." on ".$vm_name." $error"
         if $error =~ /there is no device|Did not find .*device/;
 
         die $error if $error =~ /No DRM render nodes/;
 
-        warn "WARNING: $error ".$self->_vm->name." ".$self->_vm->enabled if $error;
+        warn "WARNING: $error ".$vm_name if $error;
 
         ;# pool has asynchronous jobs running.
         next if $error && ref($error) && $error->code == 1
@@ -479,6 +481,8 @@ sub _start_checks($self, @args) {
         $request = delete $args{request} if exists $args{request};
         $enable_host_devices = delete $args{enable_host_devices};
     }
+    my $id_prev = $self->_data('id_vm');
+
     # 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')
@@ -531,7 +535,8 @@ sub _start_checks($self, @args) {
                     ,'set_base_vm', encode_json($args));
             }
 
-            $self->rsync(request => $request);
+            $self->rsync(request => $request)
+                unless defined $id_prev && $self->_vm->id == $id_prev;
         }
     }
     $self->_check_free_vm_memory();
@@ -5210,27 +5215,26 @@ sub _id_base_in_vm($self, $id_vm) {
     return $sth->fetchrow;
 }
 
-sub _set_base_vm_db($self, $id_vm, $value) {
+sub _set_base_vm_db($self, $id_vm, $value, $id_request=undef) {
     my $is_base;
     $is_base = $self->base_in_vm($id_vm) if $self->is_base;
 
-    return if defined $is_base && $value == $is_base;
-
     my $id_is_base = $self->_id_base_in_vm($id_vm);
     if (!defined $id_is_base) {
         return if !$value && !$self->is_known;
         my $sth = $$CONNECTOR->dbh->prepare(
-            "INSERT INTO bases_vm (id_domain, id_vm, enabled) "
-            ." VALUES(?, ?, ?)"
+            "INSERT INTO bases_vm (id_domain, id_vm, enabled, id_request) "
+            ." VALUES(?, ?, ?, ?)"
         );
-        $sth->execute($self->id, $id_vm, $value);
+        $sth->execute($self->id, $id_vm, $value, $id_request);
         $sth->finish;
     } else {
         my $sth = $$CONNECTOR->dbh->prepare(
-            "UPDATE bases_vm SET enabled=?"
+            "UPDATE bases_vm SET enabled=?, id_request=?"
             ." WHERE id_domain=? AND id_vm=?"
         );
-        $sth->execute($value, $self->id, $id_vm);
+        $value = 0 if !defined $value;
+        $sth->execute($value, $id_request, $self->id, $id_vm);
         $sth->finish;
     }
 }
@@ -5271,13 +5275,23 @@ sub set_base_vm($self, %args) {
     $vm = $node if $node;
     $vm = Ravada::VM->open($id_vm)  if !$vm;
 
+    if ( !$vm || !$vm->is_active || !$vm->vm) {
+        die "Error: VM ".Ravada::VM::_search_name($id_vm)." not available\n" 
+    }
+
     $value = 1 if !defined $value;
 
+    my $id_request;
+    if ($request) {
+        $request->status("working");
+        $id_request = $request->id;
+    }
+    $self->_set_base_vm_db($vm->id, $value, $id_request);
+
     if ($vm->is_local) {
         $self->_set_vm($vm,1); # force set vm on domain
         if (!$value) {
             $request->status("working","Removing base")     if $request;
-            $self->_set_base_vm_db($vm->id, $value);
             $self->remove_base($user);
         } else {
             $self->prepare_base($user) if !$self->is_base();
@@ -5406,17 +5420,27 @@ Returns a list for virtual machine managers where this domain is base
 
 =cut
 
-sub list_vms($self, $check_host_devices=0) {
+sub list_vms($self, $check_host_devices=0, $only_available=0) {
     confess "Domain is not base" if !$self->is_base;
 
-    my $sth = $$CONNECTOR->dbh->prepare("SELECT id_vm FROM bases_vm WHERE id_domain=? AND enabled = 1");
+    my $sth = $$CONNECTOR->dbh->prepare("SELECT id_vm, id_request "
+        ." FROM bases_vm WHERE id_domain=? AND enabled = 1");
     $sth->execute($self->id);
+    my $sth_req = $$CONNECTOR->dbh->prepare(
+        "SELECT status FROM requests "
+        ." WHERE id=? "
+    );
     my @vms;
-    while (my $id_vm = $sth->fetchrow) {
+    while (my ($id_vm, $id_request) = $sth->fetchrow) {
+        if ($id_request && $only_available) {
+            $sth_req->execute($id_request);
+            my ($status) =$sth_req->fetchrow;
+            next if $status && $status ne 'done';
+        }
         my $vm;
         eval { $vm = Ravada::VM->open($id_vm) };
         warn "id_domain: ".$self->id."\n".$@ if $@;
-        push @vms,($vm) if $vm && !$vm->is_locked();
+        push @vms,($vm) if $vm;
     }
     my $vm_local = $self->_vm->new( host => 'localhost' );
     if ( !grep { $_->name eq $vm_local->name } @vms) {

lib/Ravada/Front.pm

@@ -1101,6 +1101,7 @@ sub list_requests($self, $id_domain_req=undef, $seconds=60) {
         "SELECT requests.id, command, args, requests.date_changed, requests.status"
             ." ,requests.error, id_domain ,domains.name as domain"
             ." ,domains.alias as domain_alias"
+            ." ,requests.output "
         ." FROM requests left join domains "
         ."  ON requests.id_domain = domains.id"
         ." WHERE "
@@ -1111,9 +1112,9 @@ sub list_requests($self, $id_domain_req=undef, $seconds=60) {
     $sth->execute($time_recent);
     my @reqs;
     my ($id_request, $command, $j_args, $date_changed, $status
-        , $error, $id_domain, $domain, $alias);
+        , $error, $id_domain, $domain, $alias, $output);
     $sth->bind_columns(\($id_request, $command, $j_args, $date_changed, $status
-        , $error, $id_domain, $domain, $alias));
+        , $error, $id_domain, $domain, $alias, $output));
 
     while ( $sth->fetch) {
         my $epoch_date_changed = time;
@@ -1137,6 +1138,8 @@ sub list_requests($self, $id_domain_req=undef, $seconds=60) {
                 || $command eq 'list_network_interfaces'
                 || $command eq 'list_isos'
                 || $command eq 'manage_pools'
+                || $command eq 'list_storage_pools'
+                || $command eq 'list_cpu_models'
                 ;
         next if ( $command eq 'force_shutdown'
                 || $command eq 'force_reboot'
@@ -1166,6 +1169,7 @@ sub list_requests($self, $id_domain_req=undef, $seconds=60) {
             ,date => $date_changed
             ,message => Encode::decode_utf8($message)
             ,error => Encode::decode_utf8($error)
+            ,output => Encode::decode_utf8($output)
         };
     }
     $sth->finish;

lib/Ravada/HostDevice.pm

@@ -147,13 +147,27 @@ sub is_device($self, $device, $id_vm) {
 }
 
 sub _device_locked($self, $name, $id_vm=$self->id_vm) {
-    my $sth = $$CONNECTOR->dbh->prepare("SELECT id FROM host_devices_domain_locked "
+    my $sth = $$CONNECTOR->dbh->prepare(
+        "SELECT id,id_domain "
+        ." FROM host_devices_domain_locked "
         ." WHERE id_vm=? AND name=? "
     );
     $sth->execute($id_vm, $name);
-    my ($is_locked) = $sth->fetchrow;
-    $is_locked = 0 if !defined $is_locked;
-    return $is_locked;
+    my $sth_status = $$CONNECTOR->dbh->prepare(
+        "SELECT status FROM domains WHERE id=?"
+    );
+
+    my $sth_unlock = $$CONNECTOR->dbh->prepare(
+        "DELETE FROM host_devices_domain_locked "
+        ." WHERE id=?"
+    );
+    while ( my ($id_lock, $id_domain)= $sth->fetchrow ) {
+        $sth_status->execute($id_domain);
+        my ($status) = $sth_status->fetchrow;
+        return $id_domain if $status && $status ne 'down';
+        $sth_unlock->execute($id_lock);
+    }
+    return 0;
 }
 
 sub list_available_devices($self, $id_vm=$self->id_vm) {

lib/Ravada/Request.pm

@@ -1428,11 +1428,19 @@ sub set_base_vm {
     my $self = {};
     bless ($self, $class);
 
-    return $self->_new_request(
+    my $req = $self->_new_request(
             command => 'set_base_vm'
              , args => $args
     );
 
+    my $id_domain = $args->{id_domain};
+    my $domain = Ravada::Front::Domain->open($id_domain);
+    my $id_vm = $args->{id_vm};
+    $id_vm = $args->{id_node} if exists $args->{id_node} && $args->{id_node};
+
+    $domain->_set_base_vm_db($id_vm, $args->{value}, $req->id);
+
+    return $req;
 }
 
 =head2 remove_base_vm