Unverified Commit 98a904da authored by Francesc Guasch's avatar Francesc Guasch Committed by GitHub
Browse files

Feature/1324 backingstore (#1382)

refactor(backend): refresh backing store and driver

* refactor(test); more verbose output
* wip(volumes): get info in shared mode

issue #1324
parent 5ea3e08d
......@@ -722,6 +722,7 @@ sub _around_prepare_base($orig, $self, @args) {
my $vm_local = $self->_vm->new( host => 'localhost' );
$self->_vm($vm_local);
}
$self->pre_prepare_base();
my @base_img = $self->$orig($with_cd);
die "Error: No information files returned from prepare_base"
......@@ -732,6 +733,8 @@ sub _around_prepare_base($orig, $self, @args) {
$self->_post_prepare_base($user, $request);
}
sub pre_prepare_base($self) {}
=head2 prepare_base
Prepares the virtual machine as a base:
......@@ -797,7 +800,6 @@ sub _pre_prepare_base($self, $user, $request = undef ) {
$self->_check_has_clones();
$self->is_base(0);
$self->_post_remove_base();
if ($self->is_active) {
$self->shutdown(user => $user);
for ( 1 .. $TIMEOUT_SHUTDOWN ) {
......@@ -812,6 +814,7 @@ sub _pre_prepare_base($self, $user, $request = undef ) {
sleep 1;
}
}
$self->_post_remove_base();
if (!$self->is_local) {
my $vm_local = Ravada::VM->open( type => $self->vm );
$self->migrate($vm_local);
......
......@@ -304,7 +304,8 @@ sub remove {
# warn "WARNING: Problem removing ".$self->file_base_img." for ".$self->name
# ." , I will try again later : $@" if $@;
$self->_post_remove_base_domain() if $self->is_base();
# do a post remove but pass the remove flag = 1 ( it is 0 by default )
$self->_post_remove_base_domain(1) if $self->is_base();
}
......@@ -349,6 +350,8 @@ sub _disk_device($self, $with_info=undef, $attribute=undef, $value=undef) {
$file = $source_node->getAttribute('file') if $source_node;
my ($target_node) = $disk->findnodes('target');
my ($driver_node) = $disk->findnodes('driver');
my ($backing_node) = $disk->findnodes('backingStore');
my $device = $disk->getAttribute('device');
my $target = $target_node->getAttribute('dev');
my $bus = $target_node->getAttribute('bus');
......@@ -366,10 +369,18 @@ sub _disk_device($self, $with_info=undef, $attribute=undef, $value=undef) {
}
}
$info->{target} = $target;
# we use driver to make it compatible with other hardware but it is more accurate
# to say bus
$info->{driver} = $bus;
$info->{bus} = $bus;
$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();
}
$info->{backing} = $backing_node->toString()
if $backing_node && $backing_node->attributes();
next if defined $attribute
&& (!exists $info->{$attribute}
......@@ -458,99 +469,62 @@ sub disk_device {
}
sub _create_qcow_base {
confess "Deprecated";
my $self = shift;
my @base_img;
for my $vol_data ( $self->list_volumes_info( device => 'disk')) {
my $base_img = $vol_data->prepare_base();
push @base_img,([$base_img,$vol_data->info->{target}]);
}
return @base_img;
sub pre_prepare_base($self) {
$self->_detect_disks_driver();
}
sub _cmd_convert {
my ($base_img, $qcow_img) = @_;
return ('qemu-img','convert',
'-O','qcow2', $base_img
,$qcow_img
);
}
=head2 post_prepare_base
sub _cmd_copy {
my ($base_img, $qcow_img) = @_;
Task to run after preparing a base virtual machine
return ('cp'
,$base_img, $qcow_img
);
}
=cut
=pod
sub _create_swap_base {
sub post_prepare_base {
my $self = shift;
my @swap_img;
my $base_name = $self->name;
for my $base_img ( $self->list_volumes()) {
next unless $base_img =~ 'SWAP';
confess "ERROR: missing $base_img"
if !-e $base_img;
my $swap_img = $base_img;
$swap_img =~ s{\.\w+$}{\.ro.img};
push @swap_img,($swap_img);
$self->_set_volumes_backing_store();
$self->_store_xml();
}
my @cmd = ('qemu-img','convert',
'-O','raw', $base_img
,$swap_img
);
sub _set_volumes_backing_store($self) {
my $doc = XML::LibXML->load_xml(string
=> $self->xml_description(Sys::Virt::Domain::XML_INACTIVE))
or die "ERROR: $!\n";
my ($in, $out, $err);
run3(\@cmd,\$in,\$out,\$err);
warn $out if $out;
warn $err if $err;
my @volumes_info = grep { defined($_) && $_->file } $self->list_volumes_info;
my %vol = map { $_->file => $_ } @volumes_info;
for my $disk ($doc->findnodes('/domain/devices/disk')) {
next if $disk->getAttribute('device') ne 'disk';
for my $source( $disk->findnodes('source')) {
my $file = $source->getAttribute('file');
my $backing_file = $vol{$file}->backing_file();
my $backing_file_format = $vol{$file}->_qemu_info('backing file format');
my ($backing_store) = $disk->findnodes('backingStore');
if ($backing_file) {
$backing_store = $disk->addNewChild(undef,'backingStore') if !$backing_store;
$backing_store->setAttribute('type' => 'file');
my $format = $backing_store->findnodes('format');
$format = $backing_store->addNewChild(undef,'format');
$format->setAttribute('type' => $backing_file_format);
my $source = $backing_store->findnodes('source');
$source = $backing_store->addNewChild(undef,'source');
$source->setAttribute('file' => $backing_file);
} else {
$disk->removeChild($backing_store) if $backing_store;
$backing_store = $disk->addNewChild(undef,'backingStore') if !$backing_store;
}
if (! -e $swap_img) {
warn "ERROR: Output file $swap_img not created at ".join(" ",@cmd)."\n";
exit;
}
chmod 0555,$swap_img;
$self->_prepare_base_db($swap_img);
}
return @swap_img;
$self->_post_change_hardware($doc);
}
=cut
=head2 post_prepare_base
Task to run after preparing a base virtual machine
=cut
sub post_prepare_base {
my $self = shift;
$self->_store_xml();
}
sub _store_xml {
my $self = shift;
sub _store_xml($self) {
my $xml = $self->domain->get_xml_description(Sys::Virt::Domain::XML_INACTIVE);
my $sth = $self->_dbh->prepare(
"INSERT INTO base_xml (id_domain, xml) "
......@@ -577,14 +551,47 @@ sub get_xml_base{
return ($xml or $self->domain->get_xml_description);
}
sub _post_remove_base_domain {
my $self = shift;
sub _post_remove_base_domain($self, $remove=0) {
my $sth = $self->_dbh->prepare(
"DELETE FROM base_xml WHERE id_domain=?"
);
$sth->execute($self->id);
if (!$remove) {
$self->_set_volumes_backing_store();
$self->_detect_disks_driver();
}
}
sub _detect_disks_driver($self) {
my $doc = XML::LibXML->load_xml(string
=> $self->xml_description(Sys::Virt::Domain::XML_INACTIVE))
or die "ERROR: $!\n";
my @img;
my @vols = $self->list_volumes_info();
my $n_order = 0;
for my $disk ($doc->findnodes('/domain/devices/disk')) {
next if $disk->getAttribute('device') ne 'disk';
my ( $driver ) = $disk->findnodes('driver');
my ( $source ) = $disk->findnodes('source');
my $file = $source->getAttribute('file');
next if $file =~ /iso$/;
my ($vol) = grep { defined $_->file && $_->file eq $file } @vols;
my $format = $vol->_qemu_info('file format');
confess "Error: wrong format ".Dumper($format)." for file $file"
unless $format =~ /^\w+$/;
confess "Error: no file format for $file" if !$format;
$driver->setAttribute(type => $format);
}
$self->_post_change_hardware($doc);
}
sub post_resume_aux($self, %args) {
my $set_time = delete $args{set_time};
......@@ -685,7 +692,14 @@ sub start {
my $set_password = delete $arg{set_password};
$self->_set_spice_ip($set_password, $listen_ip);
$self->_check_qcow_format($request);
my $is_active = $self->is_active();
if (!$is_active) {
$self->_check_qcow_format($request);
$self->_set_volumes_backing_store();
$self->_detect_disks_driver();
}
$self->status('starting');
my $error;
......@@ -715,7 +729,6 @@ sub start {
sub _check_qcow_format($self, $request) {
return if $self->is_active;
my $qemu_img = $Ravada::Volume::QCOW2::QEMU_IMG;
for my $vol ( $self->list_volumes_info ) {
next if !$vol->file || $vol->file =~ /iso$/;
next if !$vol->backing_file;
......@@ -725,7 +738,6 @@ sub _check_qcow_format($self, $request) {
$request->status("rebasing","rebasing to release 0.8 "
.$vol->file."\n".$vol->backing_file) if $request;
$vol->rebase($vol->backing_file);
$self->remove_backingstore($vol->file);
}
}
......@@ -2443,7 +2455,7 @@ sub dettach($self, $user) {
}
}
sub remove_backingstore($self, $file) {
sub _remove_backingstore($self, $file) {
my $doc = XML::LibXML->load_xml(string
=> $self->xml_description(Sys::Virt::Domain::XML_INACTIVE))
......
......@@ -461,6 +461,7 @@ sub list_volumes_info($self, $attribute=undef, $value=undef) {
&& (!exists $dev->{$attribute} || $dev->{$attribute} ne $value);
}
$dev->{n_order} = $n_order++;
$dev->{driver_type} = 'void';
my $vol = Ravada::Volume->new(
file => $dev->{file}
,info => $dev
......
......@@ -104,7 +104,7 @@ sub rebase($self, $new_base) {
,'-F','qcow2'
,'-b',$new_base,$self->file);
my ($out, $err) = $self->vm->run_command(@cmd);
die $err if $err;
confess $err if $err;
}
......@@ -149,10 +149,11 @@ sub _qemu_info($self, $field=undef) {
return $self->{_qemu_info}->{$field};
}
my @cmd = ( $QEMU_IMG,'info',$self->file);
return {} if ! $self->vm->file_exists($self->file);
my @cmd = ( $QEMU_IMG,'info',$self->file,'-U');
my ($out, $err) = $self->vm->run_command(@cmd);
die $err if $err;
confess $err if $err;
my %info = (
'backing file'=> undef
......
......@@ -70,7 +70,7 @@ sub test_prepare_base_active {
ok(!$domain->is_paused,"[$vm_name] Domain ".$domain->name." should not be paused") or return;
eval{ $domain->prepare_base( user_admin ) };
ok(!$@,"[$vm_name] Prepare base, expecting error='', got '$@'") or exit;
ok(!$@,"[$vm_name] Prepare base ".$domain->name.", expecting error='', got '$@'") or exit;
ok(!$domain->is_active,"[$vm_name] Domain ".$domain->name." should not be active")
or return;
......
......@@ -62,7 +62,7 @@ sub test_domain_raw {
ok($disk) or return;
my ($driver) = $disk->findnodes('./driver');
is($driver->getAttribute('type'),'raw');
is($driver->getAttribute('type'),'qcow2');
my ($source) = $disk->findnodes('./source');
my $file = $source->getAttribute('file');
......
......@@ -74,6 +74,7 @@ create_domain
mangle_volume
test_volume_contents
test_volume_format
end
);
......@@ -1948,4 +1949,48 @@ sub test_volume_contents($vm, $name, $file, $expected=1) {
}
}
sub _check_file($volume,$expected) {
my ($in, $out, $err);
run3(['file',$volume->file],\$in, \$out, \$err);
like($out,$expected) or confess;
}
sub _check_yaml($filename) {
_check_file($filename,qr(: ASCII text));
}
sub _check_qcow2($filename) {
_check_file($filename,qr(: QEMU QCOW2));
}
sub test_volume_format(@volume) {
for my $volume (@volume) {
next if !$volume->file;
my ($extension) = $volume->file =~ /\.(\w+)$/;
return if $extension eq 'iso';
my %sub = (
qcow2 => \&_check_qcow2
,void => \&_check_yaml
);
is($volume->info->{driver_type}, $extension) or confess Dumper($volume->file, $volume->info);
my $exec = $sub{$extension} or confess "Error: I don't know how to check "
.$volume->file." [$extension]";
$exec->($volume);
next if $extension eq 'void';
if ($volume->backing_file) {
like($volume->info->{backing},qr(backingStore.*type.*file),"Expecting Backing for ".$volume->file." in ".$volume->domain->name)
or confess Dumper($volume->info);
} else {
# backing store info missing or only with <backingStore/>
if (!exists $volume->info->{backing} ) {
ok(1);
} else {
is($volume->info->{backing},'<backingStore/>',"Expecting empty backing for "
.Dumper($volume->domain->name,$volume->info)) or exit;
}
}
}
}
1;
......@@ -208,24 +208,24 @@ for my $vm_name ( vm_names() ) {
}
)->status_is(302);
_wait_request(debug => 0, background => 1);
_wait_request(debug => 1, background => 1, check_error => 1);
my $base = rvd_front->search_domain($name);
ok($base) or next;
ok($base, "Expecting domain $name create") or next;
push @bases,($base->name);
mojo_request($t, "add_hardware", { id_domain => $base->id, name => 'network' });
wait_request(debug => 1, check_error => 1, background => 1, timeout => 120);
$t->get_ok("/machine/prepare/".$base->id.".json")->status_is(200);
_wait_request(debug => 0, background => 1);
_wait_request(debug => 0, background => 1, check_error => 1);
$base = rvd_front->search_domain($name);
is($base->is_base,1);
is(scalar($base->list_ports),0);
$t->get_ok("/machine/clone/".$base->id.".json")->status_is(200);
_wait_request(debug => 0, background => 1);
_wait_request(debug => 0, background => 1, check_error => 1);
my $clone = rvd_front->search_domain($name."-".user_admin->name);
ok($clone,"Expecting clone created");
ok($clone,"Expecting clone created") or next;
if ($clone) {
is($clone->is_volatile,0) or exit;
is(scalar($clone->list_ports),0);
......
use warnings;
use strict;
use Carp qw(confess);
use Carp qw(confess croak);
use Data::Dumper;
use File::Copy;
use Test::More;
......@@ -103,6 +103,27 @@ sub test_add_volume {
or exit;
}
sub test_backing_store($domain) {
my $doc = XML::LibXML->load_xml(string => $domain->get_xml_base);
my$found = 0;
for my $disk ($doc->findnodes('/domain/devices/disk')) {
next if $disk->getAttribute('device') eq 'cdrom';
my $found_bs = 0;
for my $backing_store ($disk->findnodes('backingStore')) {
$found_bs++;
my ($format) = $backing_store->findnodes('format');
ok($format) or die "Expecting format in backing store ".$backing_store->toString();
my ($source) = $backing_store->findnodes('source');
ok($source) or die "Expecting source in backing store ".$backing_store->toString();
}
ok($found_bs) or die "Expecting backingstore ".$disk->toString;
$found++;
}
ok($found) or die "Expecting disks ".$domain->get_xml_base;
}
sub test_prepare_base {
my $vm_name = shift;
my $domain = shift;
......@@ -114,6 +135,7 @@ sub test_prepare_base {
is($@,'');
# diag("[$vm_name] ".Dumper(\@img));
test_backing_store($domain) if $vm_name eq 'KVM';
my @files_base= $domain->list_files_base();
return(scalar @files_base == scalar @volumes
......@@ -258,6 +280,14 @@ sub test_domain_n_volumes {
}
ok($vol->info->{driver}) or exit;
}
test_volume_format(@volumes_clone);
$domain_clone->remove(user_admin);
$domain->remove_base(user_admin);
test_volume_format($domain->list_volumes_info);
$domain->remove(user_admin);
}
sub test_add_volume_path {
......@@ -362,8 +392,11 @@ sub test_domain_swap {
ok($domain_clone->is_active,"Domain ".$domain_clone->name
." should be active");
my $min_size = 197120 if $vm_name eq 'KVM';
my $min_size;
$min_size = 197120 if $vm_name eq 'KVM';
$min_size = 100 if $vm_name eq 'Void';
confess "Error: unknown min_size for $vm_name" if !defined $min_size;
# after start, all the files should be there
my $found_swap = 0;
for my $file ( $domain_clone->list_volumes) {
......@@ -402,6 +435,7 @@ sub test_domain_swap {
}
test_volume_format($domain_clone->list_volumes_info);
}
sub test_too_big($vm) {
......@@ -477,6 +511,196 @@ sub test_search($vm_name) {
ok(scalar @isos,"Expecting isos, got : ".Dumper(\@isos));
}
sub _remove_backing_store($xml) {
my $doc = XML::LibXML->load_xml(string => $xml)
or die "ERROR: $!\n";
my $n_order = 0;
for my $disk ($doc->findnodes('/domain/devices/disk')) {
my ($source_node) = $disk->findnodes('source');
next if !$source_node;
my $file_found = $source_node->getAttribute('file');
next if !$file_found;
my ($backingstore) = $disk->findnodes('backingStore');
$disk->removeChild($backingstore) if $backingstore;
}
return $doc;
}
sub _empty_backing_store($xml) {
my $doc = XML::LibXML->load_xml(string => $xml)
or croak "ERROR: $!\n";
my $n_order = 0;
for my $disk ($doc->findnodes('/domain/devices/disk')) {
my ($source_node) = $disk->findnodes('source');
next if !$source_node;
my ($backingstore) = $disk->findnodes('backingStore');
$disk->removeChild($backingstore) if $backingstore;
$disk->addNewChild(undef,'backingStore');
}
return $doc;
}
sub _set_driver_raw($domain) {
my $doc = XML::LibXML->load_xml(string => $domain->domain->get_xml_description)
or croak "ERROR: $!\n";
for my $disk ($doc->findnodes('/domain/devices/disk')) {
my ($source_node) = $disk->findnodes('source');
next if !$source_node;
my $file_found = $source_node->getAttribute('file');
next if !$file_found;
my ($driver) = $disk->findnodes('driver');
$driver->setAttribute(type => 'raw');
}
$domain->_post_change_hardware($doc);
}
sub test_driver_qcow($domain) {
my $doc = XML::LibXML->load_xml(string => $domain->domain->get_xml_description)
or croak "ERROR: $!\n";
my $found = 0;
for my $disk ($doc->findnodes('/domain/devices/disk')) {
my ($source_node) = $disk->findnodes('source');
next if !$source_node;
my $file_found = $source_node->getAttribute('file');
next if !$file_found || $file_found =~ /iso$/;
my ($driver) = $disk->findnodes('driver');
is($driver->getAttribute('type'),'qcow2',$file_found) or exit;
$found++;
}
ok($found,"Expecting some drivers in ".$domain->name) or exit;
}
sub _check_no_backing_store($xml, $name=undef) {
if ( ref($xml) ) {
$name = $xml->name if !defined $name;
$xml=$xml->domain->get_xml_description();
}
my $doc = XML::LibXML->load_xml(string => $xml)
or croak "ERROR: $!\n";
my @backing_store = $doc->findnodes('/domain/devices/disk/backingStore');
die "Error : ".scalar(@backing_store)." found in $name"
if @backing_store;
return 1 if scalar(@backing_store) == 0;
}
sub _check_empty_backing_store($xml, $name=undef) {
if ( ref($xml) ) {
$name = $xml->name if !defined $name;
$xml=$xml->domain->get_xml_description();
}
my $doc = XML::LibXML->load_xml(string => $xml)