Commit 021b3bd3 authored by Francesc Guasch's avatar Francesc Guasch
Browse files

[#12] Remove base tested only with Void VMs

parent fbe33f31
...@@ -153,7 +153,7 @@ sub _create_vm { ...@@ -153,7 +153,7 @@ sub _create_vm {
my @vms = (); my @vms = ();
my ($vm_kvm, $err_kvm) = $self->_create_vm_kvm(); my ($vm_kvm, $err_kvm) = $self->_create_vm_kvm();
warn $err_kvm if $err_kvm; warn $err_kvm if $err_kvm && $0 !~ /\.t$/;
my $err = $err_kvm; my $err = $err_kvm;
......
...@@ -82,6 +82,8 @@ before 'pause' => \&_allow_manage; ...@@ -82,6 +82,8 @@ before 'pause' => \&_allow_manage;
before 'resume' => \&_allow_manage; before 'resume' => \&_allow_manage;
before 'shutdown' => \&_allow_manage_args; before 'shutdown' => \&_allow_manage_args;
after 'remove_base' => \&_remove_base_db;
sub _allow_manage_args { sub _allow_manage_args {
my $self = shift; my $self = shift;
...@@ -514,4 +516,31 @@ sub _convert_png { ...@@ -514,4 +516,31 @@ sub _convert_png {
chmod 0755,$file_out or die "$! chmod 0755 $file_out"; chmod 0755,$file_out or die "$! chmod 0755 $file_out";
} }
=head2 remove_base
Makes the domain a regular, non-base virtual machine and removes the base files.
=cut
sub remove_base {
my $self = shift;
$self->is_base(0);
for my $file ($self->list_files_base) {
warn $file;
unlink $file or die "$! unlinking $file";
}
}
sub _remove_base_db {
my $self = shift;
my $sth = $$CONNECTOR->dbh->prepare("DELETE FROM file_base_images "
." WHERE id_domain=?");
$sth->execute($self->id);
$sth->finish;
}
1; 1;
...@@ -29,7 +29,7 @@ sub BUILD { ...@@ -29,7 +29,7 @@ sub BUILD {
mkdir $DIR_TMP or die "$! when mkdir $DIR_TMP" mkdir $DIR_TMP or die "$! when mkdir $DIR_TMP"
if ! -e $DIR_TMP; if ! -e $DIR_TMP;
$self->add_volume(name => 'voida' , size => 1, path => "$DIR_TMP/".$self->name.".img") $self->add_volume(name => 'void-diska' , size => 1, path => "$DIR_TMP/".$self->name.".img")
if !$args->{id_base}; if !$args->{id_base};
} }
...@@ -174,6 +174,9 @@ sub add_volume { ...@@ -174,6 +174,9 @@ sub add_volume {
$args{path} = "$DIR_TMP/".$self->name.".$args{name}.img" $args{path} = "$DIR_TMP/".$self->name.".$args{name}.img"
if !$args{path}; if !$args{path};
confess "Volume path must be absolute , it is '$args{path}'"
if $args{path} !~ m{^/};
return if -e $args{path}; return if -e $args{path};
my %valid_arg = map { $_ => 1 } ( qw( name size path vm)); my %valid_arg = map { $_ => 1 } ( qw( name size path vm));
...@@ -192,6 +195,10 @@ sub add_volume { ...@@ -192,6 +195,10 @@ sub add_volume {
$data->{device}->{$args{name}} = \%args; $data->{device}->{$args{name}} = \%args;
DumpFile($self->disk_device, $data); DumpFile($self->disk_device, $data);
open my $out,'>>',$args{path} or die "$! $args{path}";
print $out "";
close $out;
} }
sub list_volumes { sub list_volumes {
...@@ -199,7 +206,11 @@ sub list_volumes { ...@@ -199,7 +206,11 @@ sub list_volumes {
my $data = LoadFile($self->disk_device) if -e $self->disk_device; my $data = LoadFile($self->disk_device) if -e $self->disk_device;
return () if !exists $data->{device}; return () if !exists $data->{device};
return keys %{$data->{device}}; my @vol;
for my $dev (keys %{$data->{device}}) {
push @vol,($data->{device}->{$dev}->{path});
}
return @vol;
} }
sub screenshot {} sub screenshot {}
......
...@@ -32,7 +32,7 @@ sub create_domain { ...@@ -32,7 +32,7 @@ sub create_domain {
my $domain = Ravada::Domain::Void->new(name => $args{name}, domain => $args{name} my $domain = Ravada::Domain::Void->new(name => $args{name}, domain => $args{name}
, id_owner => $args{id_owner} , id_owner => $args{id_owner}
, id_base => ($args{id_base} or undef) , id_base => $args{id_base}
); );
$domain->_insert_db(name => $args{name} , id_owner => $args{id_owner} $domain->_insert_db(name => $args{name} , id_owner => $args{id_owner}
, id_base => ($args{id_base} or undef)); , id_base => ($args{id_base} or undef));
...@@ -43,7 +43,9 @@ sub create_domain { ...@@ -43,7 +43,9 @@ sub create_domain {
confess "I can't find base domain id=$args{id_base}" if !$domain_base; confess "I can't find base domain id=$args{id_base}" if !$domain_base;
for my $file_base ($domain_base->list_files_base) { for my $file_base ($domain_base->list_files_base) {
$domain->add_volume(name => $file_base); my ($dir,$vol_name,$ext) = $file_base =~ m{(.*)/(.*?)(\..*)};
my $new_name = "$vol_name-$args{name}$ext";
$domain->add_volume(name => $new_name, path => "$dir/$new_name");
} }
} }
# $domain->start(); # $domain->start();
......
...@@ -132,7 +132,7 @@ sub _remove_old_disks_void { ...@@ -132,7 +132,7 @@ sub _remove_old_disks_void {
my $dir_img = $Ravada::Domain::Void::DIR_TMP ; my $dir_img = $Ravada::Domain::Void::DIR_TMP ;
opendir my $ls,$dir_img or return; opendir my $ls,$dir_img or return;
while (my $file = readdir $ls ) { while (my $file = readdir $ls ) {
next if $file !~ /^${name}_\d+\.(img|ro\.qcow2|qcow2)$/; next if $file !~ /^${name}_\d/;
my $disk = "$dir_img/$file"; my $disk = "$dir_img/$file";
next if ! -f $disk; next if ! -f $disk;
......
...@@ -59,10 +59,23 @@ sub test_create_domain { ...@@ -59,10 +59,23 @@ sub test_create_domain {
return $domain; return $domain;
} }
sub test_files_base {
my $domain = shift;
my $n_expected = shift;
my @files = $domain->list_files_base();
ok(scalar @files == $n_expected,"Expecting $n_expected files base , got "
.scalar @files);
return;
}
sub test_prepare_base { sub test_prepare_base {
my $vm_name = shift; my $vm_name = shift;
my $domain = shift; my $domain = shift;
test_files_base($domain,0);
eval { $domain->prepare_base( $USER) }; eval { $domain->prepare_base( $USER) };
ok(!$@, $@); ok(!$@, $@);
ok($domain->is_base); ok($domain->is_base);
...@@ -73,6 +86,8 @@ sub test_prepare_base { ...@@ -73,6 +86,8 @@ sub test_prepare_base {
.". Error: ".($@ or '<UNDEF>')); .". Error: ".($@ or '<UNDEF>'));
ok($domain->is_base); ok($domain->is_base);
test_files_base($domain,1);
my @disk = $domain->disk_device(); my @disk = $domain->disk_device();
$domain->shutdown(user => $USER); $domain->shutdown(user => $USER);
...@@ -91,12 +106,13 @@ sub test_prepare_base { ...@@ -91,12 +106,13 @@ sub test_prepare_base {
,vm => $vm_name ,vm => $vm_name
); );
ok($domain_clone); ok($domain_clone);
test_devices_clone($vm_name, $domain_clone);
touch_mtime(@disk); touch_mtime(@disk);
eval { $domain->prepare_base($USER) }; eval { $domain->prepare_base($USER) };
ok($@ && $@ =~ /has \d+ clones/i ok($@ && $@ =~ /has \d+ clones/i
,"[$vm_name] Don't prepare if there are clones ".($@ or '<UNDEF>')); ,"[$vm_name] Don't prepare if there are clones ".($@ or '<UNDEF>'));
ok($domain->is_base); ok($domain->is_base);
test_devices_clone($vm_name, $domain_clone);
$domain_clone->remove($USER); $domain_clone->remove($USER);
...@@ -154,10 +170,34 @@ sub test_devices_clone { ...@@ -154,10 +170,34 @@ sub test_devices_clone {
my $domain = shift; my $domain = shift;
my @volumes = $domain->list_volumes(); my @volumes = $domain->list_volumes();
ok(scalar(@volumes),"[$vm_name] Expecting at least 1 volume cloned " ok(scalar(@volumes),"[$vm_name] domain ".$domain->name
." got ".scalar(@volumes)); ." Expecting at least 1 volume cloned "
." got ".scalar(@volumes)) or exit;
for my $disk (@volumes ) { for my $disk (@volumes ) {
ok(-e $disk,"Checking volume ".Dumper($disk)." exists"); ok(-e $disk,"Checking volume ".Dumper($disk)." exists") or exit;
}
}
sub test_remove_base {
my $vm_name = shift;
my $domain = test_create_domain($vm_name);
ok($domain,"Expecting domain, got NONE") or return;
my @files0 = $domain->list_files_base();
ok(!scalar @files0,"Expecting no files base, got ".Dumper(\@files0)) or return;
$domain->prepare_base($USER);
ok($domain->is_base,"Domain ".$domain->name." should be base") or return;
my @files = $domain->list_files_base();
ok(scalar @files,"Expecting files base, got ".Dumper(\@files)) or return;
$domain->remove_base($USER);
ok(!$domain->is_base,"Domain ".$domain->name." should be base") or return;
for my $file (@files) {
ok(!-e $file,"Expecting file base '$file' removed" );
} }
} }
...@@ -189,6 +229,7 @@ for my $vm_name (@VMS) { ...@@ -189,6 +229,7 @@ for my $vm_name (@VMS) {
my $domain = test_create_domain($vm_name); my $domain = test_create_domain($vm_name);
test_prepare_base($vm_name, $domain); test_prepare_base($vm_name, $domain);
test_prepare_base_active($vm_name); test_prepare_base_active($vm_name);
test_remove_base($vm_name);
} }
} }
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment