fix(backend): change hardware when running in node (#1467)

issue #1440

lib/Ravada/Domain.pm

@@ -206,13 +206,9 @@ around 'is_hibernated' => \&_around_is_hibernated;
 
 around 'autostart' => \&_around_autostart;
 
-before 'set_controller' => \&_pre_change_hardware;
-before 'remove_controller' => \&_pre_change_hardware;
-before 'change_hardware' => \&_pre_change_hardware;
-
-after 'set_controller' => \&_post_change_hardware;
-after 'remove_controller' => \&_post_change_hardware;
-after 'change_hardware' => \&_post_change_hardware;
+around 'set_controller' => \&_around_change_hardware;
+around 'remove_controller' => \&_around_change_hardware;
+around 'change_hardware' => \&_around_change_hardware;
 
 around 'name' => \&_around_name;
 
@@ -4673,12 +4669,30 @@ sub _post_change_hardware($self, $hardware, $index, $data=undef) {
     }
     $self->info(Ravada::Utils::user_daemon) if $self->is_known();
 
-    $self->_remove_domain_cascade(Ravada::Utils::user_daemon,1)
-    if $self->is_known() && !$self->is_base;
-
     $self->needs_restart(1) if $self->is_known && $self->_data('status') eq 'active';
 }
 
+sub _around_change_hardware($orig, $self, @args) {
+
+    my $vm_orig = $self->_vm;
+
+    $self->$orig(@args);
+    my %changed = ( $self->_vm->id => 1 );
+    for my $instance ( $self->list_instances ) {
+        next if $changed{$instance->{id_vm}}++;
+
+        if ($self->_vm->id != $instance->{id_vm}) {
+            my $vm = Ravada::VM->open($instance->{id_vm});
+            $self->_set_vm($vm, 1);
+        }
+
+        $self->$orig(@args);
+    }
+    $self->_set_vm($vm_orig, 1) if $vm_orig->id != $self->_vm->id;
+    $self->_post_change_hardware(@args);
+
+}
+
 =head2 Access restrictions
 
 These methods implement access restrictions to clone a domain

lib/Ravada/Domain/KVM.pm

@@ -547,7 +547,7 @@ sub _set_volumes_backing_store($self) {
 
         }
     }
-    $self->_post_change_hardware($doc);
+    $self->reload_config($doc);
 }
 
 
@@ -617,7 +617,7 @@ sub _detect_disks_driver($self) {
         $driver->setAttribute(type => $format) if defined $format;
     }
 
-    $self->_post_change_hardware($doc);
+    $self->reload_config($doc);
 }
 
 sub post_resume_aux($self, %args) {
@@ -2010,8 +2010,7 @@ sub _remove_device($self, $index, $device, $attribute_name=undef, $attribute_val
         if( $ind++==$index ){
             $devices->removeChild($controller);
             $self->_vm->connect if !$self->_vm->vm;
-            my $new_domain = $self->_vm->vm->define_domain($doc->toString);
-            $self->domain($new_domain);
+            $self->reload_config($doc);
             return;
         }
     }
@@ -2218,7 +2217,7 @@ sub _change_hardware_disk_file($self, $index, $file) {
         $disk->removeChild($source);
     }
 
-    $self->_post_change_hardware($doc);
+    $self->reload_config($doc);
 }
 
 sub _search_device_xml($self, $doc, $device, $index) {
@@ -2249,7 +2248,7 @@ sub _change_hardware_disk_bus($self, $index, $bus) {
     }
     confess "Error: disk $index not found in ".$self->name if !$changed;
 
-    $self->_post_change_hardware($doc);
+    $self->reload_config($doc);
 }
 
 
@@ -2266,7 +2265,7 @@ sub _change_hardware_vcpus($self, $index, $data) {
     my $doc = XML::LibXML->load_xml(string => $self->xml_description);
     my ($vcpus) = ($doc->findnodes('/domain/vcpu/text()'));
     $vcpus->setData($n_virt_cpu);
-    $self->_post_change_hardware($doc);
+    $self->reload_config($doc);
 
 }
 
@@ -2331,12 +2330,12 @@ sub _change_hardware_network($self, $index, $data) {
 
     die "Error: interface $index not found in ".$self->name if !$changed;
 
-    $self->_post_change_hardware($doc);
+    $self->reload_config($doc);
 }
 
 
 
-sub _post_change_hardware($self, $doc) {
+sub reload_config($self, $doc) {
     my $new_domain = $self->_vm->vm->define_domain($doc->toString);
     $self->domain($new_domain);
     $self->info(Ravada::Utils::user_daemon);
@@ -2449,7 +2448,7 @@ sub _remove_backingstore($self, $file) {
         my ($backingstore) = $disk->findnodes('backingStore');
         $disk->removeChild($backingstore) if $backingstore;
     }
-    $self->_post_change_hardware($doc);
+    $self->reload_config($doc);
 }
 
 1;

t/nodes/10_basic.t

@@ -1170,9 +1170,63 @@ sub test_migrate_req($vm, $node) {
     is($domain3->_data('id_vm'), $node->id);
     is($domain3->_vm->id, $node->id);
 
+    test_change_hardware($vm, $node, $domain);
+
     $domain->remove(user_admin);
 }
 
+sub _migrate($domain, $node,$active) {
+    return if $domain->_data('id_vm') == $node->id
+    && $domain->is_active() == $active;
+
+    my $req = Ravada::Request->migrate(
+        id_domain => $domain->id
+        , id_node => $node->id
+        , uid => user_admin->id
+        , start => $active
+        , shutdown => 1
+        , shutdown_timeout => 10
+        , remote_ip => '1.2.2.34'
+        , retry => 10
+    );
+    for ( 1 .. 30 ) {
+        wait_request( debug => 0, check_error => 0);
+        last if $req->status eq 'done';
+        sleep 1;
+    }
+
+    my $domain2 = Ravada::Domain->open($domain->id);
+    die "Error: domain ".$domain2->name." should be in node ".$node->name
+    .". It is in ".$domain2->_vm->name
+    if $node->id != $domain2->_vm->id;
+
+    die "Error: domain ".$domain2->name." should be active=$active, got ".$domain2->is_active
+    if $domain2->is_active != $active;
+}
+
+sub test_change_hardware($vm, $node, $domain, $active = 0) {
+    _migrate($domain, $node, $active);
+
+    my $mem = $domain->info(user_admin)->{memory};
+
+    my $new_mem = int($mem*0.9)-1;
+
+    my $req1 = Ravada::Request->change_hardware(
+        uid => user_admin->id
+        ,id_domain => $domain->id
+        ,hardware => 'memory'
+        ,data => { memory => $new_mem }
+    );
+
+    wait_request(debug => 1);
+    is($req1->status, 'done');
+    is($req1->error, '');
+
+    my $domain2 = Ravada::Domain->open($domain->id);
+    is($domain2->_data('id_vm'), $domain->_data('id_vm')) or exit;
+
+}
+
 sub _get_backing_files($volume0) {
     my @bf;
     my $volume = $volume0;

t/nodes/60_hardware.t

@@ -29,7 +29,7 @@ sub test_graphics($vm, $node) {
             next if $domain->get_driver($driver_name)
                 && $domain->get_driver($driver_name) eq $option->{value};
 
-            diag("Testing $driver_name $option->{value} in ".$vm->type);
+                #diag("Testing $driver_name $option->{value} in ".$vm->type);
 
             test_driver_clone($vm, $node, $domain, $driver_name, $option);
 
@@ -79,7 +79,7 @@ sub test_driver_migrate($vm, $node, $domain, $driver_name) {
         next if defined $domain->get_driver($driver_name)
         && $domain->get_driver($driver_name) eq $option->{value};
 
-        diag("Testing $driver_name $option->{value} then migrate");
+        # diag("Testing $driver_name $option->{value} then migrate");
         my $clone = $domain->clone(name => new_domain_name, user => user_admin);
         my $req = Ravada::Request->set_driver(uid => user_admin->id
             , id_domain => $clone->id
@@ -120,7 +120,7 @@ sub test_drivers_type($type, $vm, $node) {
     for my $option (@options) {
         die "No value for driver ".Dumper($option)  if !$option->{value};
 
-        diag("Testing $type $option->{value}");
+        # diag("Testing $type $option->{value}");
 
         eval { $domain->set_driver($type => $option->{value}) };
         ok(!$@,"Expecting no error, got : ".($@ or ''));
@@ -160,7 +160,6 @@ sub test_change_hardware($vm, @nodes) {
     diag("[".$vm->type."] testing remove with ".scalar(@nodes)." node ".join(",",map { $_->name } @nodes));
     my $domain = create_domain($vm);
     my $clone = $domain->clone(name => new_domain_name, user => user_admin);
-    my @volumes = $clone->list_volumes();
 
     for my $node (@nodes) {
         for ( 1 .. 10 ) {
@@ -177,24 +176,46 @@ sub test_change_hardware($vm, @nodes) {
         ok($clone2);
     }
 
-    my $info = $domain->info(user_admin);
-    my ($hardware) = grep { !/disk|volume/ } keys %{$info->{hardware}};
-    $clone->remove_controller($hardware,0);
+    my $n_instances = $domain->list_instances();
+    my $info = $clone->info(user_admin);
+    my %devices;
+    for my $hardware ( sort keys %{$info->{hardware}} ) {
+        $devices{$hardware} = scalar(@{$info->{hardware}->{$hardware}});
+    }
+    for my $hardware ( sort keys %{$info->{hardware}} ) {
 
-    my $sth = connector->dbh->prepare("SELECT count(*) FROM domain_instances "
-        ."WHERE id_domain = ".$clone->id );
-    $sth->execute();
-    my ($count) = $sth->fetchrow;
-    is($count,1,"Expecting other instances removed when hardware changed") or exit;
+        #TODO disk volumes in Void
+        next if $vm->type eq 'Void' && $hardware =~ /disk|volume/;
 
-    for my $node (@nodes) {
-        my $clone2 = $node->search_domain($clone->name);
-        ok(!$clone2,"Expecting no clone ".$clone->name." in remote node ".$node->name) or exit;
-    }
+        # diag("Testing remove $hardware");
+
+        my $current_vm = $clone->_vm;
+        $clone->remove_controller($hardware,0);
+        is (scalar($clone->list_instances()), $n_instances);
+
+        my $n_expected = scalar(@{$info->{hardware}->{$hardware}})-1;
+        die "Warning: no $hardware devices in ".$clone->name if $n_expected<0;
 
-    is($clone->_vm->is_local,1) or exit;
-    for (@volumes) {
-        ok(-e $_,$_) or exit;
+        $n_expected = 0 if $n_expected<0;
+
+        for my $node ($vm, @nodes) {
+            my $clone2 = $node->search_domain($clone->name);
+            my $info2 = $clone2->info(user_admin);
+            my $devices2 = $info2->{hardware}->{$hardware};
+            is( scalar(@$devices2),$n_expected
+                , $clone2->name.": Expecting 1 $hardware device less in instance in node ".$node->name)
+                or exit;
+        }
+
+        is($clone->_vm->id, $current_vm->id) or exit;
+
+        my $clone3 = Ravada::Domain->open($clone->id);
+        my $info3 = $clone3->info(user_admin);
+        $devices{$hardware}--;
+        for my $item (keys %devices) {
+            is(scalar(@{$info3->{hardware}->{$item}}), $devices{$item},$item)
+                    or exit;
+        }
     }
     $clone->remove(user_admin);
     $domain->remove(user_admin);

t/vm/40_volumes.t

@@ -559,7 +559,7 @@ sub _set_driver_raw($domain) {
         my ($driver) = $disk->findnodes('driver');
         $driver->setAttribute(type => 'raw');
     }
-    $domain->_post_change_hardware($doc);
+    $domain->reload_config($doc);
 }
 
 sub test_driver_qcow($domain) {
@@ -652,7 +652,7 @@ sub _create_domain_no_backing_store($vm) {
     my $standalone = create_domain($vm);
     $standalone->add_volume(type => 'TMP' , format => 'raw' ,size => 1024 * 10);
     my $doc = _remove_backing_store($standalone->domain->get_xml_description);
-    $standalone->_post_change_hardware($doc);
+    $standalone->reload_config($doc);
     _check_no_backing_store($standalone->domain->get_xml_description, $standalone->name);
 
     # base XML has no backingStore entries
@@ -674,7 +674,7 @@ sub _create_domain_no_backing_store($vm) {
     # clone has a <backingStore/>
     my $clone = $base->clone(name => new_domain_name, user => user_admin);
     my $clone_doc = _empty_backing_store($clone->domain->get_xml_description);
-    $clone->_post_change_hardware($clone_doc);
+    $clone->reload_config($clone_doc);
     _check_empty_backing_store($clone_doc->toString, $clone->name );
 
     my $removed_base = create_domain($vm);