Merge branch 'main' into fix/2122_access_group

lib/Ravada.pm

@@ -6626,6 +6626,8 @@ sub _req_method {
 ,set_time => \&_cmd_set_time
 ,compact => \&_cmd_compact
 ,purge => \&_cmd_purge
+,backup => \&_cmd_backup
+,restore_backup => \&_cmd_restore_backup
 
 ,list_storage_pools => \&_cmd_list_storage_pools
 ,active_storage_pool => \&_cmd_active_storage_pool
@@ -7300,6 +7302,30 @@ sub _cmd_move_volume($self, $request) {
     }
 }
 
+sub _cmd_backup($self, $request) {
+    my $user = Ravada::Auth::SQL->search_by_id($request->args('uid'));
+    die "Error: ".$user->name." not authorized to backup"
+        if !$user->is_admin;
+
+    my $domain = Ravada::Domain->open($request->args('id_domain'));
+    die "Error: I can not backup while machine is active".$domain->name."\n"
+    if $domain->is_active;
+
+    $request->output($domain->backup());
+}
+
+sub _cmd_restore_backup($self, $request) {
+    my $user = Ravada::Auth::SQL->search_by_id($request->args('uid'));
+    die "Error: ".$user->name." not authorized to backup"
+        if !$user->is_admin;
+
+    my $file = $request->args('file');
+    die "Error: missing file  '$file'" if ! -e $file;
+
+    $self->restore_backup($file,0);
+    $request->output();
+}
+
 =head2 set_debug_value
 
 Sets debug global variable from setting
@@ -7337,9 +7363,19 @@ sub restore_backup($self, $file, $interactive=undef) {
         $interactive = $ENV{TERM};
     }
 
-    return Ravada::Domain::restore_backup(undef, $file, $interactive, $self);
+    my ($name) = $file =~ m{.*/(.*?).\d{4}-\d\d-\d\d_\d\d-\d\d-};
+    my $domain = $self->search_domain($name);
+
+    die "Error: ".$domain->name." is active, shut it down to restore.\n"
+    if $domain && $domain->is_active;
+
+    return if $domain && $interactive && !$self->_confirm_restore();
+
+    return Ravada::Domain::restore_backup($domain, $file);
 }
 
+
+
 sub _restore_backup_data($self, $file_data, $file_data_extra
                             ,$file_data_owner) {
     open my $f,"<",$file_data or die "$! $file_data";

lib/Ravada/Domain.pm

@@ -2633,7 +2633,7 @@ sub is_locked {
 
     $self->_init_connector() if !defined $$CONNECTOR;
 
-    my $sth = $$CONNECTOR->dbh->prepare("SELECT id,at_time FROM requests "
+    my $sth = $$CONNECTOR->dbh->prepare("SELECT id,at_time,command FROM requests "
         ." WHERE id_domain=? AND status <> 'done'"
         ."   AND command <> 'open_exposed_ports'"
         ."   AND command <> 'open_iptables' "
@@ -2645,11 +2645,13 @@ sub is_locked {
         ."   AND command <> 'add_hardware'"
     );
     $sth->execute($self->id);
-    my ($id, $at_time) = $sth->fetchrow;
+    while (my ($id, $at_time,$command) = $sth->fetchrow) {
+        next if $at_time && $at_time - time > 1;
+        return $id;
+    };
     $sth->finish;
 
-    return 0 if $at_time && $at_time - time > 1;
-    return ($id or 0);
+    return 0;
 }
 
 =head2 id_owner
@@ -7729,17 +7731,6 @@ sub backup($self) {
     return $file_backup;
 }
 
-sub _confirm_restore($self) {
-    if ($ENV{TERM}) {
-            print "Virtual Machine ".$self->name." already exists."
-            ." All the data will be overwritten."
-            ." Are you sure you want to restore a backup ?";
-            my $answer = <STDIN>;
-            return 0 unless $answer =~ /^y/i;
-    }
-    return 1;
-}
-
 sub _parse_file($file) {
     CORE::open my $f,"<",$file or confess "$! $file";
     my $json = join "",<$f>;
@@ -7832,20 +7823,13 @@ sub _check_parent_base_volumes($data, $file) {
 
 }
 
-sub restore_backup($self, $backup, $interactive, $rvd_back=undef) {
+sub restore_backup($self, $backup) {
     my $file = $backup;
     $file = $backup->{file} if ref($backup);
 
     die "Error: missing file  '$file'" if ! -e $file;
 
     my ($name) = $file =~ m{.*/(.*?).\d{4}-\d\d-\d\d_\d\d-\d\d-};
-    if (!$self) {
-        $self = $rvd_back->search_domain($name);
-    }
-    die "Error: ".$self->name." is active, shut it down to restore.\n"
-    if $self && $self->is_active;
-
-    return if $self && $interactive && !$self->_confirm_restore();
 
     my $data = _extract_metadata($file,$name);
     _check_metadata_before_restore($data);

lib/Ravada/Request.pm

@@ -135,6 +135,8 @@ our %VALID_ARG = (
     }
     ,compact => { uid => 1, id_domain => 1 , keep_backup => 2 }
       ,purge => { uid => 1, id_domain => 1 }
+      ,backup => { uid => 1, id_domain => 1, compress => 2}
+      ,restore_backup => { uid => 1, file => 1, id_domain => 2 }
 
     ,list_machine_types => { uid => 1, id_vm => 2, vm_type => 2}
     ,list_cpu_models => { uid => 1, id_domain => 1}
@@ -192,7 +194,7 @@ our %CMD_SEND_MESSAGE = map { $_ => 1 }
             expose remove_expose
             rebase rebase_volumes
             shutdown_node reboot_node start_node
-            compact purge
+            compact purge backup
             start_domain
 
             create_network change_network remove_network
@@ -239,7 +241,7 @@ our %COMMAND = (
                     , 'remove_base_vm'
                     , 'screenshot'
                     , 'cleanup'
-                    , 'compact','spinoff'
+                    , 'compact','spinoff','backup'
                 ]
         ,priority => 20
     }

script/rvd_back

@@ -988,38 +988,105 @@ sub backup($rvd_back) {
     die "Error: please provide the virtual machine name to backup.\n"
     unless scalar(@ARGV);
 
+    my @reqs;
+    my %dupe;
     for my $name (@ARGV) {
         my $dom;
         if ( $name =~ /^\d+$/ ) {
             $dom = Ravada::Domain->open($name);
         } else {
             $dom = $rvd_back->search_domain($name);
         }
+        if (!$dom) {
+            warn "Error: Unknown domain $name\n";
+            next;
+        }
+        if ($dupe{$dom->name}++) {
+            warn "Warning: Backup of ".$dom->name." duplicated, requested only one.\n";
+        }
         if ($dom->is_active) {
             warn "Error: $name is active, not backing up.\n";
             next;
         }
-        print $dom->backup()."\n";
+        print "Requesting backup of ".$dom->name."\n";
+        my $req = Ravada::Request->backup(
+            uid => Ravada::Utils::user_daemon->id
+            ,id_domain => $dom->id
+        );
+        push @reqs,($req);
     }
+
+    _wait_request(@reqs);
     exit 0;
 }
 
+sub _wait_request(@reqs) {
+    my $t0 = time;
+    for (;;) {
+        last if !@reqs;
+        my $pending = 0;
+        my @reqs2;
+        for my $req (@reqs) {
+            if ($req->status eq 'done') {
+                print "Finished ".$req->command;
+                if ($req->error) {
+                    warn $req->error."\n";
+                }
+                print "\n\t".$req->output if $req->output;
+                print "\n";
+            } else {
+                push @reqs2,($req);
+            }
+        }
+        last if !@reqs2;
+        @reqs = @reqs2;
+        sleep 1;
+        if (time - $t0 > 10 ) {
+            print "Waiting for ".scalar(@reqs)." requests to finish\n";
+            $t0 = time;
+        }
+    }
+
+}
+
+sub _confirm_restore($name) {
+    if ($ENV{TERM}) {
+            print "Virtual Machine $name already exists."
+            ." All the data will be overwritten."
+            ." Are you sure you want to restore a backup ?";
+            my $answer = <STDIN>;
+            return 0 unless $answer =~ /^y/i;
+    }
+    return 1;
+}
+
+
 sub restore($rvd_back) {
     die "Error: please provide the file to restore.\n"
     unless scalar(@ARGV);
 
+    my @reqs;
     for my $item (@ARGV) {
         if ($item =~ m{/}) {
-            my $dom = $rvd_back->restore_backup($item,1);
-            if ($dom) {
-                print $dom->name." restored successfuly.\n";
-            } else {
-                print "backup for $item aborted.\n";
-            }
+
+            my ($name) = $item =~ m{.*/(.*?).\d{4}-\d\d-\d\d_\d\d-\d\d-};
+            my $dom = $rvd_back->search_domain($name);
+            next if $dom && !_confirm_restore($name);
+            my $id_domain;
+            $id_domain = $dom->id if $dom;
+
+            push @reqs,(Ravada::Request->restore_backup(
+                    id_domain => $id_domain
+                    ,file => $item
+                    ,uid => Ravada::Utils::user_daemon->id
+                ));
         } else {
             warn "Error: I can't find '$item'. Plese pass the path with the backed up filename.\n";
         }
     }
+
+    _wait_request(@reqs);
+    exit(0);
 }
 
 sub _list_domains($rvd_back

t/vm/backup.t

@@ -146,7 +146,7 @@ sub backup($vm,$remove_user=undef) {
     }
 
     my ($backup) = $domain->list_backups();
-    $domain->restore_backup($backup,0);
+    $domain->restore_backup($backup);
 
     my @md5_restored = _vols_md5($domain);
     is_deeply(\@md5_restored, \@md5) or exit;
@@ -387,6 +387,53 @@ sub backup_clash_user($vm) {
     #TODO
 }
 
+sub test_req_backup($vm) {
+    my $domain = create_domain($vm);
+    my $user = create_user();
+
+    my $req = Ravada::Request->backup(
+        uid => $user->id
+        ,id_domain => $domain->id
+    );
+    wait_request(check_error => 0);
+    like($req->error,qr/not authorized/i);
+
+    $domain->start(user_admin);
+
+    $req = Ravada::Request->backup(
+        uid => user_admin->id
+        ,id_domain => $domain->id
+    );
+    wait_request(check_error => 0);
+    like($req->error,qr/is active/i);
+
+    my $req_shutdown = Ravada::Request->shutdown_domain(
+        uid => user_admin->id
+        ,id_domain=> $domain->id
+    );
+    wait_request();
+
+    $req->redo();
+
+    wait_request();
+    is($req->error,'');
+    like($req->output,qr /\//);
+
+    remove_domain($domain);
+
+    my $file = $req->output;
+    chomp $file;
+    return $file;
+}
+
+sub test_req_restore($vm, $file) {
+    my $req = Ravada::Request->restore_backup(
+        uid => user_admin->id
+        ,file => $file
+    );
+    wait_request();
+}
+
 ########################################################################
 
 init();
@@ -402,6 +449,9 @@ for my $vm_name ( vm_names() ) {
         diag($msg)      if !$vm;
         skip $msg,10    if !$vm;
 
+        my $file = test_req_backup($vm);
+        test_req_restore($vm, $file);
+
         backup_auto_start($vm);
 
         backup_clone_and_base($vm);