fix: lock and shutdown machines before prepare (#1986)

fix: lock and shutdown machines before prepare

lib/Ravada.pm

@@ -3308,6 +3308,7 @@ sub _req_add_disk($uid, $id_domain, $type, $size, $request, $storage=undef) {
         ,name => 'disk'
         ,data => $data
         ,@after_req
+        ,at => time + 1
     );
 }
 sub _start_domain_after_create($domain, $request, $uid,$previous_request) {
@@ -3862,7 +3863,7 @@ sub process_requests {
         "pid=".($req->pid or '')." ".$req->status()
             ."$txt_retry "
             .$req->command
-            ." ".Dumper($req->args) if $DEBUG || $debug;
+            ." ".Dumper($req->args) if ( $DEBUG || $debug ) && $req->command ne 'set_time';
 
         my ($n_retry) = $req->status() =~ /retry (\d+)/;
         $n_retry = 0 if !$n_retry;
@@ -3872,14 +3873,16 @@ sub process_requests {
         next if !$DEBUG && !$debug;
 
         warn ''.localtime." req ".$req->id." , cmd: ".$req->command." ".$req->status()
-            ." , err: '".($req->error or '')."'\n"  if $DEBUG || $VERBOSE;
+            ." , err: '".($req->error or '')."'\n"  if ($DEBUG || $VERBOSE )
+            && $req->command ne 'set_time';
             #        sleep 1 if $DEBUG;
 
     }
 
+    my @reqs2 = grep { $_->command ne 'set_time' } @reqs;
     warn Dumper([map { $_->id." ".($_->pid or '')." ".$_->command." ".$_->status }
-            grep { $_->id } @reqs ])
-        if ($DEBUG || $debug ) && @reqs;
+            grep { $_->id } @reqs2 ])
+        if ($DEBUG || $debug ) && @reqs2;
 
     return scalar(@reqs);
 }
@@ -4520,7 +4523,7 @@ sub _wait_pids($self) {
             $request->status('done') if $request->status =~ /working/i;
         };
         warn("$$ request id=$id_req ".$request->command." ".$request->status()
-            .", error='".($request->error or '')."'\n") if $DEBUG && $request;
+            .", error='".($request->error or '')."'\n") if $DEBUG && $request && $request->command ne 'set_time';
     }
 }
 
@@ -4894,14 +4897,38 @@ sub _cmd_prepare_base {
     my $id_domain = $request->id_domain   or confess "Missing request id_domain";
     my $uid = $request->args('uid')     or confess "Missing argument uid";
 
+    my $domain = $self->search_domain_by_id($id_domain);
+    die "Unknown domain id '$id_domain'\n" if !$domain;
+
     my $user = Ravada::Auth::SQL->search_by_id( $uid)
         or confess "Error: Unknown user id $uid in request ".Dumper($request);
 
-    my $with_cd = $request->defined_arg('with_cd');
+    die "User ".$user->name." [".$user->id."] not allowed to prepare base "
+                .$domain->name."\n"
+            unless $user->is_admin || (
+                $domain->id_owner == $user->id && $user->can_create_base());
 
-    my $domain = $self->search_domain_by_id($id_domain);
 
-    die "Unknown domain id '$id_domain'\n" if !$domain;
+    my $with_cd = $request->defined_arg('with_cd');
+
+    if ($domain->is_active) {
+        my $req_shutdown = Ravada::Request->shutdown_domain(
+            uid => $user->id
+            ,id_domain => $domain->id
+            ,timeout => 0
+        );
+        $request->after_request($req_shutdown->id);
+        $request->at(time + 10);
+        if ( !defined $request->retry() ) {
+            $request->retry(5);
+            $request->status("retry");
+        } elsif($request->retry>0) {
+            $request->retry($request->retry-1);
+            $request->status("retry");
+        }
+        $request->error("Machine must be shut down ".$domain->name." [".$domain->id."]");
+        return;
+    }
 
     $self->_remove_unnecessary_request($domain);
     $self->_remove_unnecessary_downs($domain);
@@ -6200,6 +6227,7 @@ sub _req_method {
  ,list_cpu_models => \&_cmd_list_cpu_models
 ,enforce_limits => \&_cmd_enforce_limits
 ,force_shutdown => \&_cmd_force_shutdown
+,force_shutdown_domain => \&_cmd_force_shutdown
 ,force_reboot   => \&_cmd_force_reboot
 ,shutdown_start => \&_cmd_shutdown_start
         ,rebase => \&_cmd_rebase

lib/Ravada/Request.pm

@@ -71,6 +71,7 @@ our %VALID_ARG = (
                        , check => 2
                        , id_vm => 2 }
     ,force_shutdown_domain => { id_domain => 1, uid => 1, at => 2, id_vm => 2 }
+    ,force_shutdown => { id_domain => 1, uid => 1, at => 2, id_vm => 2 }
     ,reboot_domain => { name => 2, id_domain => 2, uid => 1, timeout => 2, at => 2
                        , id_vm => 2 }
     ,force_reboot_domain => { id_domain => 1, uid => 1, at => 2, id_vm => 2 }

t/mojo/10_login.t

@@ -228,7 +228,7 @@ sub test_login_non_admin($t, $base, $clone){
         for ( 1 .. 10 ) {
             my $clone2 = rvd_front->search_domain($clone->name);
             last if $clone2->is_base || !$clone2->list_requests;
-            _wait_request(debug => 1, background => 1, check_error => 1);
+            _wait_request(debug => 0, background => 1, check_error => 1);
             mojo_check_login($t, $USERNAME, $PASSWORD);
         }
         is($clone->is_base,1) or next;
@@ -246,10 +246,9 @@ sub test_login_non_admin($t, $base, $clone){
     login($name, $pass);
     $t->get_ok('/')->status_is(200)->content_like(qr/choose a machine/i);
 
-
     $t->get_ok("/machine/clone/".$clone->id.".html")
     ->status_is(200);
-    wait_request(debug => 1, check_error => 1, background => 1, timeout => 120);
+    wait_request(debug => 0, check_error => 1, background => 1, timeout => 120);
     mojo_check_login($t, $name, $pass);
 
     my $clone_new_name = $base->name."-".$name;
@@ -269,7 +268,7 @@ sub test_login_non_admin($t, $base, $clone){
     for ( 1 .. 60 ) {
         my ($req) = grep { $_->status ne 'done' } $user->list_requests();
         last if !$req;
-        wait_request(debug => 1, check_error => 1, background => 1, timeout => 120);
+        wait_request(debug => 0, check_error => 1, background => 1, timeout => 120);
         delete_request('open_exposed_ports');
     }
     my ($req) = reverse $user->list_requests();
@@ -300,7 +299,7 @@ sub test_list_ldap_attributes($t, $expected_code=200) {
 
 sub test_login_non_admin_req($t, $base, $clone){
     mojo_check_login($t, $USERNAME, $PASSWORD);
-    my $clone2;
+    my $clone2 = $clone;
     for ( 1 .. 3 ) {
         if (!$clone->is_base) {
 
@@ -313,7 +312,7 @@ sub test_login_non_admin_req($t, $base, $clone){
             for ( 1 .. 60 ) {
                 $clone2 = rvd_front->search_domain($clone->name);
                 last if $clone2->is_base || !$clone2->list_requests;
-                _wait_request(debug => 1, background => 1, check_error => 1);
+                _wait_request(debug => 0, background => 1, check_error => 1);
                 mojo_check_login($t, $USERNAME, $PASSWORD);
             }
             last if $clone2->is_base;
@@ -340,7 +339,7 @@ sub test_login_non_admin_req($t, $base, $clone){
         }
     );
 
-    wait_request(debug => 1, check_error => 1, background => 1, timeout => 120);
+    wait_request(debug => 0, check_error => 1, background => 1, timeout => 120);
     mojo_check_login($t, $name, $pass);
 
     my $clone_new = rvd_front->search_domain($clone_new_name);
@@ -358,7 +357,7 @@ sub test_login_non_admin_req($t, $base, $clone){
 
 
     for ( 1 .. 10 ) {
-        wait_request(debug => 1, check_error => 1, background => 1, timeout => 120);
+        wait_request(debug => 0, check_error => 1, background => 1, timeout => 120);
         $clone_new = rvd_front->search_domain($clone_new_name);
         last if $clone_new;
     }
@@ -426,11 +425,11 @@ sub test_copy_without_prepare($clone) {
     is(scalar @clones, $n_clones_clone+$n_clones,"Expecting clones from ".$clone->name) or exit;
 
     mojo_request($t, "spinoff", { id_domain => $clone->id  });
-    wait_request(debug => 1, check_error => 1, background => 1, timeout => 120);
+    wait_request(debug => 0, check_error => 1, background => 1, timeout => 120);
     # is($clone->id_base,0 );
     mojo_check_login($t);
     mojo_request($t, "clone", { id_domain => $clone->id, number => $n_clones });
-    wait_request(debug => 1, check_error => 1, background => 1, timeout => 120);
+    wait_request(debug => 0, check_error => 1, background => 1, timeout => 120);
     is($clone->is_base, 1 );
     my @n_clones_clone_2= $clone->clones();
     is(scalar @n_clones_clone_2, $n_clones_clone+$n_clones*2) or exit;
@@ -569,21 +568,28 @@ sub _add_displays($t, $domain) {
 
 }
 
-sub _clone_and_base($vm_name, $t, $base0) {
+sub _clone_and_base($vm_name, $t) {
     mojo_check_login($t);
-    my $base1 = $base0;
+    my ($base,$base1);
     if ($vm_name eq 'KVM') {
-        my $base = rvd_front->search_domain($BASE_NAME);
+        $base = rvd_front->search_domain($BASE_NAME);
         die "Error: test base $BASE_NAME not found" if !$base;
+    } else {
+        $base = test_create_base($t, $vm_name, new_domain_name());
+    }
+    confess if !defined $base;
+
+    {
         my $name = new_domain_name()."-".$vm_name."-$$";
         mojo_request_url_post($t,"/machine/copy",{id_base => $base->id, new_name => $name, copy_ram => 0.128, copy_number => 1});
 
-        for ( 1 .. 60 ) {
+        for ( 1 .. 90 ) {
             $base1 = rvd_front->search_domain($name);
             last if $base1;
             wait_request();
         }
         ok($base1, "Expecting domain $name created") or exit;
+        mojo_request($t,"spinoff",{id_domain => $base1->id});
     }
 
     mojo_check_login($t);
@@ -667,7 +673,7 @@ sub _download_iso($iso_name) {
     my $req = Ravada::Request->download(id_iso => $id_iso);
     for ( 1 .. 300 ) {
         last if $req->status eq 'done';
-        _wait_request(debug => 1, background => 1, check_error => 1);
+        _wait_request(debug => 0, background => 1, check_error => 1);
     }
     is($req->status,'done');
     is($req->error, '') or exit;
@@ -746,9 +752,9 @@ sub test_new_machine_default($t, $vm_name, $empty_iso_file=undef) {
     for ( 1 .. 10 ) {
         ($data) = grep { $_->{file} =~ /DATA/ } @$disks;
         last if $data;
-        sleep 1;
+        wait_request();
     }
-    ok($data,"Expecting a data disk volume") or exit;
+    ok($data,"Expecting a data disk volume in ".$domain->name) or exit;
 
     my ($iso) = grep { $_->{file} =~ /iso$/ } @$disks;
     ok($iso,"Expecting an ISO cdrom disk volume");
@@ -860,6 +866,7 @@ sub test_create_base($t, $vm_name, $name) {
             ,disk => 1
             ,ram => 1
             ,swap => 1
+            ,start => 0
             ,submit => 1
         }
     )->status_is(302);
@@ -869,7 +876,7 @@ sub test_create_base($t, $vm_name, $name) {
     my @requests = $user->list_requests();
     my ($req_create) = grep { $_->command eq 'create' } @requests;
 
-    _wait_request(debug => 1, background => 1, check_error => 1);
+    _wait_request(debug => 0, background => 1, check_error => 1);
     my $base;
     for ( 1 .. 120 ) {
         $base = rvd_front->search_domain($name);
@@ -952,7 +959,7 @@ sub test_clone_same_name($t, $base) {
 
         wait_request();
         for ( 1 .. 10 ) {
-            wait_request(debug => 1);
+            wait_request(debug => 0);
             @clones2 = $base->clones();
             last if scalar(@clones2)>scalar(@clones);
             sleep 1;
@@ -966,6 +973,7 @@ sub test_clone_same_name($t, $base) {
 
     die Dumper(\@clones2) if !$clone;
 
+    mojo_request($t,"force_shutdown", {id_domain => $clone->{id} });
     mojo_request($t,"prepare_base", {id_domain => $clone->{id} });
     sleep 1;
     wait_request();
@@ -979,7 +987,7 @@ sub test_clone_same_name($t, $base) {
     $t->get_ok("/machine/clone/".$base->id.".html")
     ->status_is(200);
 
-    wait_request();
+    wait_request( debug => 0);
 
     my @clones3;
     for ( 1 .. 20 ) {
@@ -989,7 +997,8 @@ sub test_clone_same_name($t, $base) {
         wait_request( background=>1);
     }
     @clones3 = $base->clones();
-    is(scalar(@clones3) , scalar(@clones2)+1) or exit;
+    is(scalar(@clones3) , scalar(@clones2)+1) or die "Expecting ".(scalar(@clones2)+1)
+        ." clones of ".$base->name;
 
     for my $c ($base->clones) {
         mojo_request($t,"remove_domain", {name => $c->{name} });
@@ -1064,16 +1073,18 @@ for my $vm_name (reverse @{rvd_front->list_vm_types} ) {
     }
     test_admin_can_do_anything($t, $base0);
 
-    my $base2 =test_create_base($t, $vm_name, new_domain_name()."-$vm_name-$$");
-    push @bases,($base2->name);
+    my $base2a =test_create_base($t, $vm_name, new_domain_name()."-$vm_name-$$");
+    push @bases,($base2a->name);
+
+    my $base2 = _clone_and_base($vm_name, $t);
 
     mojo_request($t, "add_hardware", { id_domain => $base0->id, name => 'network' });
     wait_request(debug => 0, check_error => 1, background => 1, timeout => 120);
     mojo_check_login($t, $USERNAME, $PASSWORD);
 
     test_validate_html("/machine/manage/".$base0->id.".html");
 
-    my $base1 = _clone_and_base($vm_name, $t, $base0);
+    my $base1 = _clone_and_base($vm_name, $t);
 
     push @bases,($base1->name);
     is($base1->is_base,1) or next;

t/mojo/20_ws.t

@@ -89,6 +89,9 @@ sub test_bases($t, $bases) {
     my $n_bases = 0;
     my $n_machines = scalar(@$bases);
     for my $base ( @$bases ) {
+
+        mojo_request($t, "force_shutdown", { id_domain => $base->id });
+
         my $url = "/machine/prepare/".$base->id.".json";
         $t->get_ok($url)->status_is(200);
         wait_mojo_request($t, $url);
@@ -159,6 +162,10 @@ sub test_list_machines_non_admin($t, $bases) {
     my @list_machines = list_machines($t);
     is(scalar(@list_machines),0) or die Dumper([map {[$_->{id_base},$_->{name}]} @list_machines]);
 
+    Ravada::Request->force_shutdown(
+        uid => user_admin->id
+        ,id_domain => $clone->{id}
+    );
     my $req = Ravada::Request->prepare_base(
         uid => user_admin->id
         ,id_domain => $clone->{id}

t/request/40_base.t

@@ -172,6 +172,24 @@ sub test_req_create_domain {
     return $name;
 }
 
+sub test_req_prepare_base_active($vm) {
+    my $domain;
+    if ($vm->type ne 'Void') {
+        my $base = import_domain($vm);
+        $domain = $base->clone(user => user_admin, name => new_domain_name);
+    } else {
+        $domain = create_domain($vm);
+    }
+    $domain->start(user_admin);
+    my $req = Ravada::Request->prepare_base(uid => user_admin->id
+        ,id_domain => $domain->id
+    );
+    wait_request(debug => 0);
+    is($domain->is_active,0);
+    is($domain->is_base,1);
+}
+
+
 sub test_req_prepare_base {
     my $vm_name = shift;
     my $name = shift;
@@ -196,6 +214,10 @@ sub test_req_prepare_base {
         ok($req->status);
 
         ok($domain->is_locked,"Domain $name should be locked when preparing base");
+        $req->status('working');
+        ok($domain->is_locked,"Domain $name should be locked when preparing base");
+        $req->status('requested');
+
     }
 
     wait_request(background => 0);
@@ -665,6 +687,8 @@ for my $vm_name ( vm_names ) {
             my $iso = $vm_connected->_search_iso($ID_ISO);
             $vm_connected->_iso_name($iso, undef);
         }
+        test_req_prepare_base_active($vm_connected);
+
         test_domain_name_iso($vm_connected);
         test_swap($vm_name);
 

t/vm/70_clone.t

@@ -159,6 +159,7 @@ sub test_many_clones($vm) {
         ,id_domain => $base->id
     );
     $base->is_public(1);
+    wait_request();
     my $req = Ravada::Request->clone(
         uid => $user->id
         ,id_domain => $base->id