Fix prepare base (#1144)

* test(backend): check prepare fails
* fix(backend): prepare base recover when fails

issue #1143

lib/Ravada/Domain.pm

@@ -513,7 +513,7 @@ sub _around_add_volume {
         ($name) = $file =~ m{.*/(.*)} if !$name && $file;
         $name = $self->name if !$name;
 
-        $name .= "-".Ravada::Utils::random_name(4)."-$args{target}";
+        $name .= "-".$args{target}."-".Ravada::Utils::random_name(4);
         $args{name} = $name;
     }
 
@@ -607,6 +607,13 @@ sub _around_prepare_base($orig, $self, $user, $request = undef) {
 
 sub prepare_base($self) {
     my @base_img;
+    for my $volume ($self->list_volumes_info(device => 'disk')) {
+        confess "Undefined info->target ".Dumper($volume)
+            if !$volume->info->{target};
+        my $base_file = $volume->base_filename;
+        die "Error: file '$base_file' already exists" if $self->_vm->file_exists($base_file);
+    }
+
     for my $volume ($self->list_volumes_info(device => 'disk')) {
         confess "Undefined info->target ".Dumper($volume)
             if !$volume->info->{target};
@@ -2149,7 +2156,6 @@ sub add_volume_swap {
     my $self = shift;
     my %arg = @_;
 
-    $arg{name} = $self->name if !$arg{name};
     $self->add_volume(%arg, swap => 1);
 }
 

lib/Ravada/VM/KVM.pm

@@ -741,7 +741,7 @@ sub _volume_path {
 
     my $dir_img = $self->_storage_path($storage);
     my $suffix = "qcow2";
-    $suffix = ".SWAP.qcow2"   if $swap;
+    $suffix = "SWAP.qcow2"   if $swap;
     return "$dir_img/$filename.$suffix";
 }
 

t/lib/Test/Ravada.pm

@@ -144,6 +144,7 @@ sub create_domain {
     my $vm_name = shift;
     my $user = (shift or $USER_ADMIN);
     my $id_iso = (shift or 'Alpine');
+    my $swap = (shift or undef);
 
     $vm_name = 'KVM' if $vm_name eq 'qemu';
 
@@ -174,6 +175,7 @@ sub create_domain {
     return $domain if $domain;
 
     my %arg_create = (id_iso => $id_iso);
+    $arg_create{swap} = 1024 * 1024 if $swap;
 
     eval { $domain = $vm->create_domain(name => $name
                     , id_owner => $user->id
@@ -1054,7 +1056,7 @@ sub start_node($node) {
     $domain->start(user => user_admin, remote_ip => '127.0.0.1')  if !$domain->is_active;
 
     for ( 1 .. 60 ) {
-        last if $node->ping ;
+        last if $node->ping;
         sleep 1;
         diag("Waiting for ping node ".$node->name." ".$node->ip." $_") if !($_ % 10);
     }
@@ -1282,7 +1284,6 @@ sub _do_remote_node($vm_name, $remote_config) {
     push @NODES,($node) if !grep { $_->name eq $node->name } @NODES;
     ok($node) or return;
 
-
     is($node->type,$vm->type) or return;
 
     is($node->host,$remote_config->{host});

t/request/30_hardware.t

@@ -113,7 +113,7 @@ sub test_add_hardware_request($vm, $domain, $hardware, $data={}) {
     my $new_hardware = $info->{hardware}->{$hardware}->[$numero-1];
     if ( $hardware eq 'disk' && $new_hardware->{name} !~ /\.iso$/ ) {
         my $name = $domain->name;
-        like($new_hardware->{name}, qr/$name-\w{4}-vd[a-z]\.\w+$/) or die Dumper($data);
+        like($new_hardware->{name}, qr/$name-vd[a-z]-\w{4}\.\w+$/) or die Dumper($data);
     } elsif($hardware eq 'disk') {
         like($new_hardware->{file},qr(\.iso$)) or die Dumper($info->{hardware}->{$hardware});
     }

t/vm/20_base.t

@@ -7,7 +7,8 @@ use Test::More;
 use lib 't/lib';
 use Test::Ravada;
 
-use_ok('Ravada');
+no warnings "experimental::signatures";
+use feature qw(signatures);
 
 my $FILE_CONFIG = 't/etc/ravada.conf';
 
@@ -607,6 +608,47 @@ sub test_domain_limit_already_requested {
     $user->remove();
 }
 
+sub test_prepare_fail($vm) {
+    my $domain = create_domain($vm,undef,undef,1);
+    my @volumes = $domain->list_volumes_info();
+    is(scalar @volumes,3);
+    for (@volumes) {
+        next if $_->file =~ /\.iso$/;
+        like($_->file,qr(-vd[a-c]-)) or exit;
+    }
+    for my $vol ( @volumes ) {
+        next if $vol->file =~ /\.iso$/;
+        my $base_file = $vol->base_filename();
+        open my $out , '>',$base_file;
+        close $out;
+    }
+    eval {
+        $domain->prepare_base(user_admin);
+    };
+    like($@,qr/already exists/);
+    is($domain->is_base,0) or exit;
+    for my $vol ( @volumes ) {
+        eval { $vol->backing_file };
+        like($@,qr/./);
+    }
+
+    # Now we only have the second file already there
+    my $base_file = $volumes[0]->base_filename();
+    unlink $base_file;
+
+    eval {
+        $domain->prepare_base(user_admin);
+    };
+    like($@,qr/already exists/);
+    for my $vol ( @volumes ) {
+        eval { $vol->backing_file };
+        like($@,qr/./, "Expecting ".$vol->file." not prepared") or exit;
+    }
+
+
+    $domain->remove(user_admin);
+}
+
 #######################################################################33
 
 
@@ -638,6 +680,8 @@ for my $vm_name ('KVM', 'Void') {
 
         use_ok($CLASS);
 
+        test_prepare_fail($vm);
+
         test_domain_limit_already_requested($vm_name);
 
         my $domain = test_create_domain($vm_name);

t/vm/40_volumes.t

@@ -372,6 +372,7 @@ sub test_domain_swap {
         if ( $file =~ /SWAP/) {
             $found_swap++;
             my $size = -s $file;
+            $min_size = $size if $size > $min_size;
             for ( 'a' .. 'z' ) {
                 open my $out, ">>",$file or die "$! $file";
                 print $out "$_: ".('a' x 256)."\n";