diff --git a/lib/Ravada.pm b/lib/Ravada.pm index a08b0f23f..449eb0d6e 100644 --- a/lib/Ravada.pm +++ b/lib/Ravada.pm @@ -1713,6 +1713,16 @@ sub _cmd_open_iptables { ); } +sub _cmd_clone($self, $request) { + my $domain = Ravada::Domain->open($request->args('id_domain')); + + $domain->clone( + name => $request->args('name') + ,user => Ravada::Auth::SQL->search_by_id($request->args('uid')) + ); + +} + sub _cmd_start { my $self = shift; my $request = shift; @@ -1925,7 +1935,8 @@ sub _req_method { my %methods = ( - start => \&_cmd_start + clone => \&_cmd_clone + ,start => \&_cmd_start ,pause => \&_cmd_pause ,create => \&_cmd_create ,remove => \&_cmd_remove diff --git a/lib/Ravada/Domain.pm b/lib/Ravada/Domain.pm index b0ab8346a..583fd9cd6 100644 --- a/lib/Ravada/Domain.pm +++ b/lib/Ravada/Domain.pm @@ -492,7 +492,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}); } diff --git a/lib/Ravada/Request.pm b/lib/Ravada/Request.pm index a129cb5c6..ac69ac92e 100644 --- a/lib/Ravada/Request.pm +++ b/lib/Ravada/Request.pm @@ -61,6 +61,7 @@ our %VALID_ARG = ( ,hybernate=> {uid => 1, id_domain => 1} ,download => {uid => 2, id_iso => 1, id_vm => 2, delay => 2} ,refresh_storage => { id_vm => 2 } + ,clone => { uid => 1, id_domain => 1, name => 1 } ); our %CMD_SEND_MESSAGE = map { $_ => 1 } @@ -246,6 +247,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 +834,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; diff --git a/rvd_front.pl b/rvd_front.pl index 7e64215ad..fa601a89f 100644 --- a/rvd_front.pl +++ b/rvd_front.pl @@ -1621,24 +1621,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 || $base->is_locked) { - 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; } diff --git a/t/vm/c10_copy.t b/t/vm/c10_copy.t index 724eca8ef..3a91af513 100644 --- a/t/vm/c10_copy.t +++ b/t/vm/c10_copy.t @@ -88,21 +88,23 @@ sub test_copy_request { my $clone = $base->clone( name => $name_clone - ,user => user_admin + ,user => user_admin ); my $name_copy = new_domain_name(); my $req; - eval { $req = Ravada::Request->copy( + eval { $req = Ravada::Request->clone( id_domain => $clone->id , 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");