Wait for busy Storage Pools (#1260)

refactor(backend): wait when busy storage

* refactor(test): only check downloads when requested
* refactor(test): deal with busy storage
* refactor(backend): deal when domain already removed

lib/Ravada.pm

@@ -64,7 +64,7 @@ our %VALID_CONFIG = (
 
 =head1 NAME
 
-Ravada - Remove Virtual Desktop Manager
+Ravada - Remote Virtual Desktop Manager
 
 =head1 SYNOPSIS
 
@@ -1726,12 +1726,16 @@ sub remove_domain {
     die "Error: user ".$user->name." can't remove domain $id"
         if !$user->can_remove_machine($id);
 
-    my $domain0 = Ravada::Domain->open( $id );
+    my $domain0;
+    eval { $domain0 = Ravada::Domain->open( $id ) };
+    warn $@ if $@;
     $domain0->shutdown_now($user) if $domain0 && $domain0->is_active;
 
     my $vm = Ravada::VM->open(type => $vm_type);
-    my $domain = Ravada::Domain->open(id => $id, _force => 1, id_vm => $vm->id)
-        or do {
+    my $domain;
+    eval { $domain = Ravada::Domain->open(id => $id, _force => 1, id_vm => $vm->id) };
+    warn $@ if $@;
+    if (!$domain) {
             warn "Warning: I can't find domain '$id', maybe already removed.";
             $sth = $CONNECTOR->dbh->prepare("DELETE FROM domains where id=?");
             $sth->execute($id);

lib/Ravada/Domain/KVM.pm

@@ -227,7 +227,7 @@ sub _vol_remove {
 
     my $removed = 0;
     for my $pool ( $self->_vm->vm->list_storage_pools ) {
-        $pool->refresh;
+        _pool_refresh($pool);
         my $vol;
         eval { $vol = $pool->get_volume_by_name($name) };
         if (! $vol ) {
@@ -235,8 +235,13 @@ sub _vol_remove {
                 if $@ !~ /libvirt error code: 50,/i;
             next;
         }
-        $vol->delete();
-        $pool->refresh;
+        for ( ;; ) {
+            eval { $vol->delete() };
+            last if !$@;
+            sleep 1;
+        }
+        eval { $pool->refresh };
+        warn $@ if $@;
     }
     return 1;
 }
@@ -257,7 +262,14 @@ sub remove {
 
     my @volumes;
     if (!$self->is_removed ) {
-        for my $vol ( $self->list_volumes_info ) {
+       my @vols_info;
+       for ( 1 .. 10 ) {
+           eval { @vols_info = $self->list_volumes_info };
+           last if !$@;
+           warn "WARNING: remove, volumes info: $@";
+           sleep 1;
+       }
+       for my $vol ( @vols_info ) {
             push @volumes,($vol->{file})
                 if exists $vol->{file}
                    && exists $vol->{device}
@@ -266,7 +278,8 @@ sub remove {
     }
 
     if (!$self->is_removed && $self->domain && $self->domain->is_active) {
-        $self->_do_force_shutdown();
+        eval { $self->_do_force_shutdown() };
+        warn $@ if $@;
     }
 
     eval { $self->domain->undefine()    if $self->domain && !$self->is_removed };
@@ -369,6 +382,15 @@ sub _disk_device($self, $with_info=undef, $attribute=undef, $value=undef) {
 
 }
 
+sub _pool_refresh($pool) {
+    for ( ;; ) {
+        eval { $pool->refresh };
+        return if !$@;
+        warn "WARNING: on vol remove , pool refresh $@" if $@;
+        sleep 1;
+    }
+}
+
 sub _volume_info($self, $file, $refresh=0) {
     confess "Error: No vm connected" if !$self->_vm->vm;
 
@@ -376,7 +398,7 @@ sub _volume_info($self, $file, $refresh=0) {
 
     my $vol;
     for my $pool ( $self->_vm->vm->list_storage_pools ) {
-        $pool->refresh() if $refresh;
+        _pool_refresh($pool) if $refresh;
         eval { $vol = $pool->get_volume_by_name($name) };
         warn $@ if $@ && $@ !~ /^libvirt error code: 50,/;
         last if $vol;

lib/Ravada/VM/KVM.pm

@@ -120,7 +120,7 @@ sub _connect {
          };
          confess $@ if $@;
     }
-    if ( ! $vm->list_storage_pools && !$_CREATED_DEFAULT_STORAGE{$self->host}) {
+    if ( ! _list_storage_pools($vm) && !$_CREATED_DEFAULT_STORAGE{$self->host}) {
 	    warn "WARNING: No storage pools creating default\n";
     	$self->_create_default_pool($vm);
         $_CREATED_DEFAULT_STORAGE{$self->host}++;
@@ -129,6 +129,17 @@ sub _connect {
     return $vm;
 }
 
+sub _list_storage_pools($vm) {
+   for ( ;; ) {
+       my @pools;
+       eval { @pools = $vm->list_storage_pools };
+       return @pools if !$@;
+       die $@ if $@ && $@ !~ /libvirt error code: 1,/;
+       sleep 1;
+   }
+}
+
+
 sub _check_networks {
     my $self = shift;
     my $vm = shift;
@@ -174,6 +185,16 @@ sub _reconnect($self) {
     return $self->connect();
 }
 
+sub _get_pool_info($pool) {
+   my $info;
+   for (;;) {
+       eval { $info = $pool->get_info() };
+       return $info if $info;
+       die $@ if $@ && $@ !~ /libvirt error code: 1,/;
+       sleep 1;
+   }
+}
+
 sub _load_storage_pool {
     my $self = shift;
 
@@ -187,8 +208,8 @@ sub _load_storage_pool {
             or confess "ERROR: Unknown storage pool: ".$self->default_storage_pool_name);
     }
 
-    for my $pool ($self->vm->list_storage_pools) {
-        my $info = $pool->get_info();
+    for my $pool (_list_storage_pools($self->vm)) {
+        my $info = _get_pool_info($pool);
         next if defined $available
                 && $info->{available} <= $available;
 
@@ -241,9 +262,14 @@ sub search_volume($self,$file,$refresh=0) {
     $name = $file if !defined $name;
 
     my $vol;
-    for my $pool ($self->vm->list_storage_pools) {
+    for my $pool (_list_storage_pools($self->vm)) {
         if ($refresh) {
-            $pool->refresh();
+            for ( 1 .. 10 ) {
+               eval { $pool->refresh() };
+               last if !$@;
+               warn "WARNING: on search volume $@";
+               sleep 1;
+            }
             sleep 1;
         }
         eval { $vol = $pool->get_volume_by_name($name) };
@@ -302,14 +328,24 @@ sub search_volume_re($self,$pattern,$refresh=0) {
     $self->_refresh_storage_pools()    if $refresh;
 
     my @volume;
-    for my $pool ($self->vm->list_storage_pools) {
-        for my $vol ( $pool->list_all_volumes()) {
-            my ($file) = $vol->get_path =~ m{.*/(.*)};
-            next if $file !~ $pattern;
-
-            return $vol if !wantarray;
-            push @volume,($vol);
-        }
+    for my $pool (_list_storage_pools($self->vm)) {
+       my @vols;
+       for ( 1 .. 10) {
+           eval { @vols = $pool->list_all_volumes() };
+           last if !$@ || $@ =~ / no storage pool with matching uuid/;
+           warn "WARNING: on search volume_re: $@";
+           sleep 1;
+       }
+       for my $vol ( @vols ) {
+           my $file;
+           eval { ($file) = $vol->get_path =~ m{.*/(.*)} };
+           confess $@ if $@ && $@ !~ /libvirt error code: 50,/;
+           next if !$file || $file !~ $pattern;
+
+
+           return $vol if !wantarray;
+           push @volume,($vol);
+       }
     }
     if (!scalar @volume && !$refresh && !$self->readonly
             && time - ($self->{_time_refreshed} or 0) > 60) {
@@ -326,7 +362,7 @@ sub refresh_storage_pools($self) {
 }
 
 sub _refresh_storage_pools($self) {
-    for my $pool ($self->vm->list_storage_pools) {
+    for my $pool (_list_storage_pools($self->vm)) {
         for ( 1 .. 10 ) {
             eval { $pool->refresh() };
             last if !$@;
@@ -1554,14 +1590,16 @@ sub _unique_uuid($self, $uuid='1805fb4f-ca45-aaaa-bbbb-94124e760434',@) {
     my @uuids = @_;
     if (!scalar @uuids) {
         for my $dom ($self->vm->list_all_domains) {
-            push @uuids,($dom->get_uuid_string);
+            eval { push @uuids,($dom->get_uuid_string) };
+            confess $@ if $@ && $@ !~ /^libvirt error code: 42,/;
         }
     }
     my ($pre,$first,$last) = $uuid =~ m{^([0-9a0-f]{6})(.*)([0-9a-f]{6})$};
     confess "I can't split model uuid '$uuid'" if !$first;
 
     for my $domain ($self->vm->list_all_domains) {
-        push @uuids,($domain->get_uuid_string);
+        eval { push @uuids,($domain->get_uuid_string) };
+        confess $@ if $@ && $@ !~ /^libvirt error code: 42,/;
     }
 
     for (1..100) {
@@ -1980,7 +2018,9 @@ sub _unique_mac {
     $mac = lc($mac);
 
     for my $dom ($self->vm->list_all_domains) {
-        my $doc = $XML->load_xml(string => $dom->get_xml_description()) or die "ERROR: $!\n";
+        my $doc;
+        eval { $doc = $XML->load_xml(string => $dom->get_xml_description()) } ;
+        next if !$doc;
 
         for my $nic ( $doc->findnodes('/domain/devices/interface/mac')) {
             my $nic_mac = $nic->getAttribute('address');
@@ -2006,8 +2046,10 @@ sub _xml_modify_mac {
     my $doc = shift or confess "Missing XML doc";
     my @old_macs;
 
-   	for my $dom ($self->vm->list_all_domains) {
-        my $doc = $XML->load_xml(string => $dom->get_xml_description()) or die "ERROR: $!\n";
+    for my $dom ($self->vm->list_all_domains) {
+        my $doc;
+        eval { $doc = $XML->load_xml(string => $dom->get_xml_description()) } ;
+        next if !$doc;
 
         for my $nic ( $doc->findnodes('/domain/devices/interface/mac')) {
             my $nic_mac = $nic->getAttribute('address');
@@ -2168,7 +2210,10 @@ Imports a KVM domain in Ravada
 
 sub import_domain($self, $name, $user) {
 
-    my $domain_kvm = $self->vm->get_domain_by_name($name);
+    my $domain_kvm;
+    eval { $domain_kvm = $self->vm->get_domain_by_name($name) };
+    confess $@ if $@;
+
     confess "ERROR: unknown domain $name in KVM" if !$domain_kvm;
 
     my $domain = Ravada::Domain::KVM->new(
@@ -2203,7 +2248,7 @@ sub list_storage_pools($self) {
     return
         map { $_->get_name }
         grep { $_-> is_active }
-        $self->vm->list_storage_pools();
+        _list_storage_pools($self->vm);
 }
 
 sub free_memory($self) {
@@ -2334,7 +2379,13 @@ sub free_disk($self, $pool_name = undef ) {
     } else {
         $pool = $self->storage_pool();
     }
-    my $info = $pool->get_info();
+    my $info;
+    for ( ;; ) {
+        eval { $info = $pool->get_info() };
+        last if !$@;
+        warn "WARNING: free disk $@" if $@;
+        sleep 1;
+    }
     return $info->{available};
 }
 

t/lib/Test/Ravada.pm

@@ -602,7 +602,8 @@ sub mojo_request($t, $req_name, $args) {
 }
 
 sub _activate_storage_pools($vm) {
-    for my $sp ($vm->vm->list_all_storage_pools()) {
+    my @sp = $vm->vm->list_all_storage_pools();
+    for my $sp (@sp) {
         next if $sp->is_active;
         diag("Activating sp ".$sp->get_name." on ".$vm->name);
         $sp->create();
@@ -630,18 +631,28 @@ sub _remove_old_disks_kvm {
 
     ok(!$@,"Expecting error = '' , got '".($@ or '')."'"
         ." after refresh storage pool") or return;
-
-    for my $pool( $vm->vm->list_all_storage_pools ) {
+    my @sp = $vm->vm->list_all_storage_pools();
+    for my $pool( @sp ) {
         next if !$pool->is_active;
-        for my $volume  ( $pool->list_volumes ) {
+        my @volumes;
+        for ( 1 .. 10) {
+            eval { @volumes = $pool->list_volumes };
+            last if !$@;
+            warn $@;
+            sleep 1;
+        }
+        for my $volume  ( @volumes ) {
             next if $volume->get_name !~ /^${name}_\d+.*\.(img|raw|ro\.qcow2|qcow2|void)$/;
-            $volume->delete();
+
+            eval { $volume->delete() };
+            warn $@ if $@;
         }
     }
     eval {
         $vm->storage_pool->refresh();
     };
-    die $@ if $@ && $@ !~ /is not active/;
+    chomp $@ if $@;
+    die $@ if $@ && $@ !~ /is not active|libvirt error code: 1,/;
 }
 sub _remove_old_disks_void($node=undef){
     if (! defined $node || $node->is_local) {
@@ -835,7 +846,8 @@ sub _init_vm_kvm($vm) {
 
 sub _exists_storage_pool {
     my ($vm, $pool_name) = @_;
-    for my $pool ($vm->vm->list_storage_pools) {
+    my @sp = Ravada::VM::_list_storage_pools($vm->vm);
+    for my $pool ( @sp ) {
         return 1 if $pool->get_name eq $pool_name;
     }
     return;
@@ -896,7 +908,7 @@ sub remove_qemu_pools {
     }
 
     my $base = base_pool_name();
-    for my $pool  ( $vm->vm->list_all_storage_pools) {
+    for my $pool  ( Ravada::VM::KVM::_list_storage_pools($vm->vm)) {
         my $name = $pool->get_name;
         next if $name !~ qr/^$base/;
         diag("Removing ".$pool->get_name." storage_pool");

t/request/20_download_local.t

@@ -10,7 +10,12 @@ use Mojo::UserAgent;
 use lib 't/lib';
 use Test::Ravada;
 
-use_ok('Ravada');
+if (! $ENV{TEST_DOWLOAD}) {
+    diag("Skipped: enable setting environment variable TEST_DOWNLOAD");
+    done_testing();
+    exit;
+}
+
 init();
 
 $Ravada::DEBUG=0;