[#441] copy clones

lib/Ravada.pm

@@ -1923,7 +1923,8 @@ sub _req_method {
 
     my %methods = (
 
-          start => \&_cmd_start
+          clone => \&_cmd_clone
+         ,start => \&_cmd_start
          ,pause => \&_cmd_pause
         ,create => \&_cmd_create
         ,remove => \&_cmd_remove

lib/Ravada/Domain.pm

@@ -474,7 +474,9 @@ sub open($class, $id) {
     my $vm_class = "Ravada::VM::".$row->{vm};
     bless $vm0, $vm_class;
 
-    my $vm = $vm0->new( readonly => 1);
+    my @ro = ();
+    @ro = (readonly => 1 ) if $>;
+    my $vm = $vm0->new( @ro );
 
     return $vm->search_domain($row->{name});
 }

lib/Ravada/Request.pm

@@ -251,6 +251,7 @@ sub resume_domain {
 
 sub _check_args {
     my $sub = shift;
+    confess "Odd number of elements ".Dumper(\@_)   if scalar(@_) % 2;
     my $args = { @_ };
 
     my $valid_args = $VALID_ARG{$sub};
@@ -832,6 +833,32 @@ sub refresh_storage {
 
 }
 
+=head2 clone
+
+Copies a virtual machine
+
+    my $req = Ravada::Request->clone(
+             ,uid => $user->id
+        id_domain => $domain->id
+    );
+
+=cut
+
+sub clone {
+    my $proto = shift;
+    my $class = ref($proto) || $proto;
+
+    my $args = _check_args('clone', @_ );
+
+    my $self = {};
+    bless($self,$class);
+
+    return _new_request($self
+        , command => 'clone'
+        , args =>$args
+    );
+}
+
 sub AUTOLOAD {
     my $self = shift;
 

rvd_front.pl

@@ -1548,24 +1548,13 @@ sub copy_machine {
     my $name = $c->req->param($param_name) if $param_name;
     $name = $base->name."-".$USER->name if !$name;
 
-    if (!$base->is_base) {
-        my $req = Ravada::Request->prepare_base(
-            id_domain => $id_base
-            ,uid => $USER->id
-        );
-        return $c->render("Problem preparing base for domain ".$base->name)
-            if !$req;
-
-        sleep 1;
-
-    }
     my @create_args =( memory => $ram ) if $ram;
     push @create_args , ( disk => $disk ) if $disk;
-    my $req2 = Ravada::Request->create_domain(
-             name => $name
-        , id_base => $id_base
-       , id_owner => $USER->id
-        ,@create_args
+    my $req2 = Ravada::Request->clone(
+              uid => $USER->id
+            ,name => $name
+       , id_domain => $base->id
+       ,@create_args
     );
     $c->redirect_to("/admin/machines");#    if !@error;
 }

t/vm/c10_copy.t

@@ -99,19 +99,19 @@ sub test_copy_request {
     my $name_copy = new_domain_name();
     my $mem_copy = ($mem_clone * 1.5);
     my $req;
-
-    my $clone_mem = int ( $memory * 1.5);
     eval { $req = Ravada::Request->clone(
             id_domain => $clone->id
               ,memory => $mem_copy
                , name => $name_copy
+                , uid => user_admin->id
         );
     };
     is($@,'') or return;
     is($req->status(),'requested');
     rvd_back->_process_all_requests_dont_fork();
 
-    ok($req->status(),'done');
+    is($req->status(),'done');
+    is($req->error,'');
 
     my $copy = rvd_back->search_domain($name_copy);
     ok($copy,"[$vm_name] Expecting domain $name_copy");