[UPC#441] allow change the RAM memory when cloning

lib/Ravada.pm

@@ -1716,9 +1716,14 @@ sub _cmd_open_iptables {
 sub _cmd_clone($self, $request) {
     my $domain = Ravada::Domain->open($request->args('id_domain'));
 
+    my @args = ();
+    push @args, ( memory => $request->args('memory'))
+        if $request->defined_arg('memory');
+
     $domain->clone(
         name => $request->args('name')
         ,user => Ravada::Auth::SQL->search_by_id($request->args('uid'))
+        ,@args
     );
 
 }

lib/Ravada/Domain.pm

@@ -165,6 +165,8 @@ after 'remove_base' => \&_post_remove_base;
 before 'rename' => \&_pre_rename;
 after 'rename' => \&_post_rename;
 
+before 'clone' => \&_pre_clone;
+
 after 'screenshot' => \&_post_screenshot;
 
 after '_select_domain_db' => \&_post_select_domain_db;
@@ -1003,27 +1005,37 @@ sub clone {
 
     my $id_base = $self->id;
 
+    my @args_copy = ();
+    push @args_copy, ( memory => $args{memory} )  if $args{memory};
+
     my $clone = $self->_vm->create_domain(
         name => $name
         ,id_base => $id_base
         ,id_owner => $uid
         ,vm => $self->vm
         ,_vm => $self->_vm
+        ,@args_copy
     );
     return $clone;
 }
 
 sub _copy_clone($self, %args) {
     my $name = delete $args{name} or confess "ERROR: Missing name";
     my $user = delete $args{user} or confess "ERROR: Missing user";
+    my $memory = delete $args{memory};
+
+    confess "ERROR: Unknown arguments ".join(",",sort keys %args)
+        if keys %args;
 
     my $base = Ravada::Domain->open($self->id_base);
 
+    my @copy_arg = ( memory => $memory ) if $memory;
     my $copy = $self->_vm->create_domain(
         name => $name
         ,id_base => $base->id
         ,id_owner => $user->id
         ,_vm => $self->_vm
+        ,@copy_arg
     );
     my @volumes = $self->list_volumes_target;
     my @copy_volumes = $copy->list_volumes_target;
@@ -1674,4 +1686,17 @@ sub type {
     return $type;
 }
 
+sub _pre_clone($self,%args) {
+    my $name = delete $args{name};
+    my $user = delete $args{user};
+    my $memory = delete $args{memory};
+
+    confess "ERROR: Missing clone name "    if !$name;
+    confess "ERROR: Invalid name '$name'"   if $name !~ /^[a-z][a-z0-9_-]+$/;
+
+    confess "ERROR: Missing user owner of new domain"   if !$user;
+
+    confess "ERROR: Unknown arguments ".join(",",sort keys %args)   if keys %args;
+}
+
 1;

lib/Ravada/Request.pm

@@ -61,7 +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 }
+    ,clone => { uid => 1, id_domain => 1, name => 1, memory => 2 }
 );
 
 our %CMD_SEND_MESSAGE = map { $_ => 1 }

lib/Ravada/VM/Void.pm

@@ -74,9 +74,9 @@ sub create_domain {
         );
         $domain->_set_default_drivers();
         $domain->_set_default_info();
-        $domain->set_memory($args{memory}) if $args{memory};
 
     }
+    $domain->set_memory($args{memory}) if $args{memory};
 #    $domain->start();
     return $domain;
 }

t/vm/c10_copy.t

@@ -83,18 +83,27 @@ sub test_copy_request {
     my $vm_name = shift;
 
     my $base = create_domain($vm_name);
+    my $memory = $base->get_info->{memory};
 
     my $name_clone = new_domain_name();
+    my $mem_clone = int($memory * 1.5);
 
     my $clone = $base->clone(
         name => $name_clone
        ,user => user_admin
+       ,memory => $mem_clone
     );
 
+    is($clone->get_info->{memory}, $mem_clone,"[$vm_name] memory");
+
     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
         );
@@ -108,9 +117,43 @@ sub test_copy_request {
 
     my $copy = rvd_back->search_domain($name_copy);
     ok($copy,"[$vm_name] Expecting domain $name_copy");
+    is($copy->get_info->{memory}, $mem_copy);
 
     my $clone2 = rvd_back->search_domain($name_clone);
     is($clone2->is_base,0);
+
+    is($clone2->get_info->{memory}, $mem_clone);
+
+    isnt($clone2->get_info->{memory}, $base->get_info->{memory});
+    isnt($clone2->get_info->{memory}, $copy->get_info->{memory});
+}
+
+sub test_copy_change_ram {
+    my $vm_name = shift;
+
+    my $base = create_domain($vm_name);
+
+    my $name_clone = new_domain_name();
+
+    my $clone = $base->clone(
+        name => $name_clone
+       ,user => user_admin
+    );
+    my $clone_mem = $clone->get_info->{memory};
+
+    my $name_copy = new_domain_name();
+    my $copy = $clone->clone(
+        name => $name_copy
+        ,memory => int($clone_mem * 1.5)
+        ,user => user_admin
+    );
+    is($clone->is_base,0);
+    is($copy->is_base,0);
+
+    is ($copy->get_info->{memory},int($clone_mem * 1.5),"[$vm_name] Expecting memory");
+    $clone->remove(user_admin);
+    $copy->remove(user_admin);
+    $base->remove(user_admin);
 }
 
 ##########################################################################3
@@ -137,6 +180,8 @@ for my $vm_name ('Void', 'KVM') {
         test_copy_clone($vm_name,10);
 
         test_copy_request($vm_name);
+
+        test_copy_change_ram($vm_name);
     }
 
 }