Merge branch 'master' into develop

t/vm/r20_rebase.t

@@ -161,7 +161,81 @@ sub test_rebase_with_vols($vm, $swap0, $data0, $with_cd0, $swap1, $data1, $with_
     _remove_domains($base, $base2);
 }
 
-=pod
+sub _remove_domains(@bases) {
+    for my $base (@bases) {
+        for my $clone ($base->clones) {
+            my $d_clone = Ravada::Domain->open($clone->{id});
+            $d_clone->remove(user_admin);
+        }
+        $base->remove(user_admin);
+    }
+}
+
+sub _key_for($a) {
+    my($key) = $a =~ /\.([A-Z]+)\.\w+$/;
+    $key = 'SYS' if !defined $key;
+    return $key;
+}
+sub test_match_vols($vols_before, $vols_after) {
+    return if scalar(@$vols_before) != scalar (@$vols_after);
+    my %vols_before = map { _key_for($_) => $_ } @$vols_before;
+    my %vols_after  = map { _key_for($_) => $_ } @$vols_after;
+
+    for my $key (keys %vols_before, keys %vols_after) {
+        is($vols_before{$key}, $vols_after{$key}, $key) or die Dumper($vols_before, $vols_after);
+    }
+}
+
+sub test_rebase($vm, $swap, $data, $with_cd) {
+    #diag("sw: $swap , da: $data , cd: $with_cd");
+    my $base = create_domain($vm);
+    $base->add_volume(type => 'swap', size=>$VOL_SIZE)    if $swap0;
+    $base->add_volume(type => 'data', size=>$VOL_SIZE)    if $data0;
+    $base->prepare_base(user => user_admin, with_cd => $with_cd0);
+
+    my $clone1 = $base->clone( name => new_domain_name, user => user_admin);
+
+    my @volumes_before = $clone1->list_volumes();
+    _mangle_vol($vm,@volumes_before);
+
+    my %backing_file = map { $_->file => ($_->backing_file or undef) }
+        grep { $_->file } $clone1->list_volumes_info;
+
+    my $base2 = create_domain($vm);
+    $base2->add_volume(type => 'swap', size=>$VOL_SIZE)    if $swap1;
+    $base2->add_volume(type => 'data', size=>$VOL_SIZE)    if $data1;
+    $base2->prepare_base(user => user_admin, with_cd => $with_cd1);
+
+    my @reqs;
+    eval { @reqs = $clone1->rebase(user_admin, $base2) };
+    if (!$same_outline) {
+        like($@,qr/outline different/i) or exit;
+        _remove_domains($base, $base2);
+        return;
+    } else {
+        is($@, '') or exit;
+    }
+    my @volumes_after = $clone1->list_volumes();
+    ok(scalar @volumes_after >= scalar @volumes_before,Dumper(\@volumes_after,\@volumes_before))
+        or exit;
+
+    test_match_vols(\@volumes_before, \@volumes_after);
+
+    for my $vol ($clone1->list_volumes_info) {
+        my $file = $vol->file or next;
+        _test_volume_contents($vm,$file);
+
+        my $bf2 = $base2->name;
+        if ( $file !~ /\.iso$/ ) {
+            like ($vol->backing_file, qr($bf2), $vol->file) or exit;
+            isnt($vol->backing_file, $backing_file{$vol->file}) if $backing_file{$file};
+        } else {
+            is($vol->backing_file, $backing_file{$vol->file}) if $backing_file{$file};
+        }
+        # we may check inside eventually but it is costly
+    }
+    _remove_domains($base, $base2);
+}
 
 sub _test_volume_contents($vm, $file) {
     if ($file =~ /\.iso$/) {
@@ -189,7 +263,33 @@ sub _test_volume_contents($vm, $file) {
     }
 }
 
-=cut
+sub test_volume_contents2($vm, $file, $name, $expected=1) {
+    if ($file =~ /\.void$/) {
+        my $data = LoadFile($file);
+        if ($file =~ /\.DATA\./) {
+            if ($expected) {
+                ok(exists $data->{$name}, "Expecting $name in ".Dumper($file,$data)) or confess;
+            } else {
+                ok(!exists $data->{$name}, "Expecting no $name in ".Dumper($file,$data)) or confess;
+            }
+        }
+    } elsif ($file =~ /\.qcow2$/) {
+        if ($file =~ /\.DATA\./) {
+            test_file_exists2($vm, $file, $name, $expected);
+        }
+    } elsif ($file =~ /\.iso$/) {
+        my $file_type = `file $file`;
+        chomp $file_type;
+        if ($file_type =~ /ASCII/) {
+            my $data = LoadFile($file);
+            ok($data->{iso},Dumper($file,$data)) or confess;
+        } else {
+            like($file_type , qr/DOS\/MBR/);
+        }
+    } else {
+        confess "I don't know how to check vol contents of '$file'";
+    }
+}
 
 sub _remove_domains(@bases) {
     for my $base (@bases) {
@@ -201,8 +301,6 @@ sub _remove_domains(@bases) {
     }
 }
 
-=pod
-
 sub _mangle_vol($vm,@vol) {
     for my $file (@vol) {
         if ($file =~ /\.void$/) {
@@ -219,31 +317,45 @@ sub _mangle_vol($vm,@vol) {
     }
 }
 
-sub _retry_command($vm,$cmd,$re_err=undef) {
-    my ($out,$err);
-    for ( 1 .. 10) {
-        ($out,$err) = $vm->run_command(@$cmd);
-        return if !$err;
-        return if $re_err && $err && $err =~ $re_err;
-        sleep 1;
-        diag("@$cmd $err");
+sub _mangle_vol2($vm,$name,@vol) {
+    for my $file (@vol) {
+
+        if ($file =~ /\.void$/) {
+            my $data = Load($vm->read_file($file));
+            $data->{$name} = "c" x 20;
+            $vm->write_file($file, Dump($data));
+
+        } elsif ($file =~ /\.qcow2$/) {
+            _mount_qcow($vm, $file);
+            open my $out,">","/mnt/test_rvd/$name";
+            print $out ("c" x 20)."\n";
+            close $out;
+            _umount_qcow();
+        }
     }
-    die join(" ",@$cmd)." : $? $err" if $?;
 }
 
+
 sub _mount_qcow($vm, $vol) {
     my ($in,$out, $err);
-    _retry_command($vm,["/sbin/modprobe","nbd", "max_part=63"])
-        if !$MOD_NBD++;
-
-    _retry_command($vm, ["/bin/umount", $DEV_NBD],qr(not mounted));
-    _retry_command($vm, [$QEMU_NBD,"-d", $DEV_NBD]);
+    if (!$MOD_NBD++) {
+        my @cmd =("/sbin/modprobe","nbd", "max_part=63");
+        run3(\@cmd, \$in, \$out, \$err);
+        die join(" ",@cmd)." : $? $err" if $?;
+    }
+    for ( 1 .. 10 ) {
+        ($out,$err) = $vm->run_command($QEMU_NBD,"-d", $DEV_NBD);
+        last if !$err;
+        sleep 1;
+        diag($err);
+    }
+    confess "qemu-nbd -d $DEV_NBD\n?:$?\n$out\n$err" if $? || $err;
     for ( 1 .. 10 ) {
         ($out, $err) = $vm->run_command($QEMU_NBD,"-c",$DEV_NBD, $vol);
         last if !$err || $err !~ /(NBD socket|Unexpected end)/;
-        diag("$_ $err");
-        ($out, $err) = $vm->run_command($QEMU_NBD,"-d",$DEV_NBD);
         sleep 1;
+        diag("$_ $err");
+        ($out,$err) = $vm->run_command($QEMU_NBD,"-d", $DEV_NBD);
     }
     confess "qemu-nbd -c $DEV_NBD $vol\n?:$?\n$out\n$err" if $? || $err;
     _create_part($DEV_NBD);
@@ -256,7 +368,6 @@ sub _mount_qcow($vm, $vol) {
 
 sub _create_part($dev) {
     my @cmd = ("/sbin/fdisk","-l",$dev);
-    warn "@cmd";
     my ($in,$out, $err);
     for my $retry ( 1 .. 10 ) {
         run3(\@cmd, \$in, \$out, \$err);
@@ -301,13 +412,20 @@ sub test_file_exists($vm, $vol, $expected=1) {
     return 1 if !$ok && !$expected;
     return 0;
 }
+sub test_file_exists2($vm, $vol,$name, $expected=1) {
+    _mount_qcow($vm,$vol);
+    my $ok = -e $MNT_RVD."/".base_domain_name.".txt";
+    _umount_qcow();
+    return 1 if $ok && $expected;
+    return 1 if !$ok && !$expected;
+    return 0;
+}
+
 
 sub test_file_not_exists($vm, $vol) {
     return test_file_exists($vm,$vol, 0);
 }
 
-=cut
-
 sub _key_for($a) {
     my($key) = $a =~ /\.([A-Z]+)\.\w+$/;
     $key = 'SYS' if !defined $key;
@@ -331,6 +449,10 @@ sub test_rebase($vm, $swap, $data, $with_cd) {
     $base->add_volume(type => 'data', size=>$VOL_SIZE)    if $data;
     $base->prepare_base(user => user_admin, with_cd => $with_cd);
 
+    $base->add_volume(type => 'swap', size=>$VOL_SIZE)    if $swap;
+    $base->add_volume(type => 'data', size=>$VOL_SIZE)    if $data;
+    $base->prepare_base(user => user_admin, with_cd => $with_cd);
+
     my $clone1 = $base->clone( name => new_domain_name, user => user_admin);
     my $clone2 = $base->clone( name => new_domain_name, user => user_admin);