Fix raw volumes upgrade (#1387)

fix(volumes): convert to qcow2 old raw bases

* test(volumes): upgrade old raw volumes

close issue #1385

lib/Ravada.pm

@@ -2909,7 +2909,8 @@ sub _can_fork {
 
     for my $pid (keys %reqs) {
         my $id_req = $reqs{$pid};
-        my $request = Ravada::Request->open($id_req);
+        my $request;
+        $request = Ravada::Request->open($id_req)   if defined $id_req;
         delete $reqs{$pid} if !$request || $request->status eq 'done';
     }
     my $n_pids = scalar(keys %reqs);

lib/Ravada/Domain.pm

@@ -2844,7 +2844,7 @@ sub open_exposed_ports($self) {
     return if !@ports;
 
     if ( ! $self->ip ) {
-        die "Error: No ip in domain. Retry.\n";
+        die "Error: No ip in domain ".$self->name.". Retry.\n";
     }
 
     for my $expose ( @ports ) {

lib/Ravada/Domain/KVM.pm

@@ -376,8 +376,10 @@ sub _disk_device($self, $with_info=undef, $attribute=undef, $value=undef) {
         $info->{n_order} = $n_order++;
         $info->{boot} = $boot_node->getAttribute('order') if $boot_node;
         $info->{file} = $file if defined $file;
-        for my $attr  ($driver_node->attributes()) {
-            $info->{"driver_".$attr->name} = $attr->getValue();
+        if ($driver_node) {
+            for my $attr  ($driver_node->attributes()) {
+                $info->{"driver_".$attr->name} = $attr->getValue();
+            }
         }
         $info->{backing} = $backing_node->toString()
         if $backing_node && $backing_node->attributes();
@@ -972,6 +974,7 @@ sub add_volume {
     my $boot = (delete $args{boot} or undef);
     my $device = (delete $args{device} or 'disk');
     my $type = delete $args{type};
+    my $format = delete $args{format};
     my %valid_arg = map { $_ => 1 } ( qw( driver name size vm xml swap target file allocation));
 
     for my $arg_name (keys %args) {
@@ -1001,6 +1004,7 @@ sub add_volume {
         ,swap => ($args{swap} or 0)
         ,size => ($args{size} or undef)
         ,type => $type
+        ,format => $format
         ,allocation => ($args{allocation} or undef)
         ,target => $target_dev
     )   if !$path;
@@ -1009,12 +1013,12 @@ sub add_volume {
 # TODO check if <target dev="/dev/vda" bus='virtio'/> widhout dev works it out
 # change dev=vd*  , slot=*
 #
-    my $driver_type = 'qcow2';
+    my $driver_type = ( $format or 'qcow2');
     my $cache = 'default';
 
     if ( $args{swap} || $device eq 'cdrom' ) {
         $cache = 'none';
-        $driver_type = 'raw';
+        $driver_type = 'raw'    if !defined $format;
     }
 
     if ( !defined $bus ) {

lib/Ravada/Domain/Void.pm

@@ -374,7 +374,8 @@ sub add_volume {
 }
 
 sub _create_volume($self, $file, $format, $data=undef) {
-    if ($format =~ /iso|void/) {
+    if ($format =~ /iso|raw|void/) {
+        $data->{format} = $format;
         $self->_vm->write_file($file, Dump($data)),
     } elsif ($format eq 'qcow2') {
         my @cmd = ('qemu-img','create','-f','qcow2', $file, $data->{capacity});

lib/Ravada/VM/KVM.pm

@@ -715,6 +715,7 @@ sub create_volume {
     my $size        = delete $args{size};
     $size = int($size) if defined $size;
     my $type        =(delete $args{type} or 'sys');
+    my $format      =(delete $args{format} or 'qcow2');
     my $swap        =(delete $args{swap} or 0);
     my $target      = delete $args{target};
     my $capacity    = delete $args{capacity};
@@ -750,13 +751,16 @@ sub create_volume {
         target => $target
         , type => $type
         , name => $name
+        , format => $format
         , storage => $storage_pool
     );
 
     confess if $img_file =~ /\d-vd[a-z]\./;
     my ($volume_name) = $img_file =~m{.*/(.*)};
     $doc->findnodes('/volume/name/text()')->[0]->setData($volume_name);
     $doc->findnodes('/volume/key/text()')->[0]->setData($img_file);
+    my ($format_doc) = $doc->findnodes('/volume/target/format');
+    $format_doc->setAttribute(type => $format);
     $doc->findnodes('/volume/target/path/text()')->[0]->setData(
                         $img_file);
 
@@ -782,9 +786,11 @@ sub _volume_path {
     my $storage  = delete $args{storage} or confess "ERROR: Missing storage";
     my $filename = $args{name}  or confess "ERROR: Missing name";
     my $target = delete $args{target};
+    my $format = delete $args{format};
 
     my $dir_img = $self->_storage_path($storage);
     my $suffix = "qcow2";
+    $suffix = 'img' if $format && $format eq 'raw';
     $type = ''  if $type eq 'sys';
     $type = uc($type)."."   if $type;
     return "$dir_img/$filename.$type$suffix";

lib/Ravada/Volume.pm

@@ -70,23 +70,44 @@ has 'clone_base_after_prepare' => (
     ,default => sub { 1 }
 );
 
-sub _type ($file) {
+sub _type_from_file($file, $vm) {
+    return 'ISO'    if $file =~ /\.iso$/i;
+    return 'Void'   if $file =~ /void$/i;
+
+    my ($out, $err) = $vm->run_command("file",$file);
+    return 'QCOW2'  if $out =~ /QEMU QCOW/;
+    return 'RAW';
+}
+
+sub _type_from_extension($file) {
     my ($ext) = $file =~ m{.*\.(.*)};
     confess if !defined $ext;
     confess if $ext =~ /-/;
     my %type = (
         void => 'Void'
         ,img => 'QCOW2'
+        ,iso => 'ISO'
     );
 
     return $type{$ext} if exists $type{$ext};
     return uc($ext);
 }
 
+sub _type($file,$vm = undef) {
+    return _type_from_file($file,$vm)   if $vm;
+    return _type_from_extension($file);
+}
+
 sub BUILD($self, $arg) {
     my $class;
-    if (exists $arg->{file} && $arg->{file}) {
-        $class = "Ravada::Volume::"._type($arg->{file});
+    if (ref($self) && ref($self) =~ /^Ravada::Volume::/) {
+        $class=ref($self);
+    } elsif (exists $arg->{file} && $arg->{file}) {
+        my $vm;
+        $vm = $arg->{vm}            if exists $arg->{vm} && $arg->{vm};
+        $vm = $arg->{domain}->_vm   if exists $arg->{domain} && $arg->{domain};
+        $class = "Ravada::Volume::"._type($arg->{file}, $vm);
+
     } elsif (exists $arg->{info}) {
         if (exists $arg->{info}->{device} && $arg->{info}->{device} eq 'cdrom') {
             $class = "Ravada::Volume::ISO";

lib/Ravada/Volume/Class.pm

@@ -22,6 +22,7 @@ sub _around_prepare_base($orig, $self) {
 
     my $storage_pool = ($self->vm->base_storage_pool or $self->vm->default_storage_pool_name);
     $self->vm->_check_free_disk($self->capacity, $storage_pool);
+
     my $base_file = $orig->($self);
     confess if !$base_file;
 
@@ -79,7 +80,7 @@ sub _around_clone($orig, $self, %args) {
         if !$self->domain || $self->domain->id != $id_domain_file;
     }
 
-    return Ravada::Volume->new(
+    return $self->new(
         file => $orig->($self, $file_clone)
         ,vm => $self->vm
     );

lib/Ravada/Volume/QCOW2.pm

@@ -26,6 +26,7 @@ sub prepare_base($self) {
     confess $base_img if $base_img !~ /\.ro/;
 
     confess "Error: '$base_img' already exists" if -e $base_img;
+    confess if $file_img =~ /\.iso/i;
 
     my @cmd = _cmd_convert($file_img,$base_img);
 
@@ -58,6 +59,24 @@ sub prepare_base($self) {
 
 }
 
+sub _convert_to_qcow($self) {
+    my ($out, $err) = $self->vm->run_command("file",$self->file);
+    return if $out =~ /QEMU QCOW/;
+    warn "converting to qcow $out";
+
+    my $tmp = $self->file.".tmp";
+    ($out, $err) = $self->vm->run_command(_cmd_convert($self->file, $tmp));
+    confess $err if $err;
+
+    my @cmd = ("cp",$self->file,$self->file.".".time().".backup");
+    ($out, $err) = $self->vm->run_command(@cmd);
+    confess "@cmd $err" if $err;
+
+    @cmd = ("cp",$tmp,$self->file);
+    ($out, $err) = $self->vm->run_command(@cmd);
+    confess "@cmd $err" if $err;
+}
+
 sub clone($self, $file_clone) {
     my $n = 10;
     for (;;) {
@@ -66,10 +85,13 @@ sub clone($self, $file_clone) {
         sleep 1;
         die "Error: ".$self->file." looks active" if $n-- <0;
     }
+    confess if $self->file =~ /ISO/i;
+    confess if $file_clone =~ /ISO/i;
+
+    $self->_convert_to_qcow();
     my @cmd = ($QEMU_IMG,'create'
         ,'-F','qcow2'
         ,'-f','qcow2'
-        ,'-F','qcow2'
         ,"-b", $self->file
         ,$file_clone
     );

t/mojo/20_ws.t

@@ -1,6 +1,7 @@
 use warnings;
 use strict;
 
+use Carp qw(confess);
 use Data::Dumper;
 use Mojo::JSON 'decode_json';
 use Test::More;
@@ -40,9 +41,10 @@ sub _init_mojo_client {
 =cut
 
 sub list_machines_user($t, $headers={}){
+    $Ravada::WebSocket::DEBUG = 1;
     $t->websocket_ok("/ws/subscribe" => $headers)->send_ok("list_machines_user")->message_ok->finish_ok;
 
-    return if !$t->message || !$t->message->[1];
+    confess if !$t->message || !$t->message->[1];
 
     my $name = base_domain_name();
     my @machines = grep { $_->{name} =~ /^$name/ } @{decode_json($t->message->[1])};

t/nodes/10_basic.t

@@ -1034,7 +1034,7 @@ sub test_fill_memory($vm, $node, $migrate) {
     my $node_free_memory = $node->free_memory;
 
     my $memory = $master_free_memory/3;
-    if ($migrate && $node_free_memory < $master_free_memory ) {
+    if ( $node_free_memory < $master_free_memory ) {
         $memory = $node_free_memory/3;
     }
 

t/vm/45_vol_swap.t

@@ -8,10 +8,96 @@ use Test::More;
 use lib 't/lib';
 use Test::Ravada;
 
+no warnings "experimental::signatures";
+use feature qw(signatures);
+
 init();
 
 ####################################################################
 
+sub _downgrade_base($base) {
+    for my $file ($base->list_files_base) {
+        next if $file !~ /SWAP|TMP/;
+        unlink $file or die "$! $file";
+        $base->_vm->storage_pool->refresh();
+
+        my ($volume_name)= $file =~ m{.*/(.*)};
+
+        confess "Error_ no volumename from $file" if !$volume_name;
+        my $file_xml = "etc/xml/alpine381_64-volume.xml";
+        open my $fh,'<', $file_xml or confess "$! $file_xml";
+
+        my $doc_vol = XML::LibXML->load_xml( IO => $fh );
+        $doc_vol->findnodes('/volume/name/text()')->[0]->setData($volume_name);
+        $doc_vol->findnodes('/volume/key/text()')->[0]->setData($volume_name);
+        my ($format_doc) = $doc_vol->findnodes('/volume/target/format');
+        $format_doc->setAttribute(type => 'raw');
+        $doc_vol->findnodes('/volume/target/path/text()')->[0]->setData($file);
+
+        my $vol = $base->_vm->storage_pool->create_volume($doc_vol->toString)
+        or die "volume $file does not exists after creating volume on ".$base->_vm->name
+            ." ".$doc_vol->toString();
+
+    }
+}
+
+sub test_domain_with_swap_raw($vm) {
+    return if $vm->type ne 'KVM';
+    my $domain = create_domain($vm);
+    $domain->add_volume_swap( size => 1000 * 1024, format => 'raw');
+    $domain->add_volume( type => 'swap', size => 1000 * 1024, format => 'raw');
+    my $found = 0;
+    for my $vol ( $domain->list_volumes_info ) {
+        next if $vol->file !~ /(SWAP|TMP)/;
+        delete $vol->{domain};
+        delete $vol->{vm};
+        is($vol->info()->{driver_type},'raw') or die warn Dumper($vol);
+        $found++;
+    }
+    is($found,2) or exit;
+    $domain->prepare_base(user_admin);
+    _downgrade_base($domain);
+
+    #check base swap volumes are raw
+    $found = 0;
+    for my $file ($domain->list_files_base) {
+        next if $file !~ /(SWAP|TMP)/;
+        my ($out, $err) = $vm->run_command("file",$file);
+        unlike($out,qr(QEMU));
+        $found++;
+    }
+    is($found,2) or exit;
+
+    test_clone_raw($domain);
+
+    $domain->remove(user_admin);
+}
+
+sub test_clone_raw($domain ) {
+    my $clone = $domain->clone(name => new_domain_name, user => user_admin);
+    my $found = 0;
+    for my $vol ( $clone->list_volumes_info ) {
+        next if !$vol->file || $vol->file !~ /(SWAP|TMP)/;
+        $found++;
+        delete $vol->{domain};
+        delete $vol->{vm};
+        is($vol->info()->{driver_type},'qcow2') or die warn Dumper($vol);
+        my ($out, $err) = $domain->_vm->run_command("file",$vol->file);
+        like($out,qr(QEMU)) or next;
+        my $backing = $vol->info->{backing};
+        my $doc = XML::LibXML->load_xml( string => $backing );
+        my ($format) = $doc->findnodes('/backingStore/format');
+        ok($format,"Expecing <format.. > in backing: ".$doc->toString) or next;
+        is($format->getAttribute('type'),'qcow2',"Expecting format ".$format->toString)
+            or exit;
+    }
+    is($found,2) or exit;
+
+    $clone->start(user_admin);
+    is($clone->is_active,1);
+    $clone->remove(user_admin);
+}
+
 sub test_domain_with_swap {
     my $vm_name = shift;
 
@@ -72,6 +158,7 @@ for my $vm_name ( vm_names() ) {
         diag($msg)      if !$vm;
         skip $msg,10    if !$vm;
 
+        test_domain_with_swap_raw($vm);
         test_domain_with_swap($vm_name);
     }
 }