Unverified Commit 1543657c authored by Francesc Guasch's avatar Francesc Guasch Committed by GitHub
Browse files

fix(backend): delete volatile VM files on shutdown

* [#629] [test] volatiles are removed from front

* [#629] [test] check volumes are removed

* [#629] check volumes are removed after shutdown

* [#629] force volume removal after shutdown of volatile

* [#629] test XML in extra data is there

* [#629] Allow forced virtual machine open

It will open even if there is no real virtual machine
in the VM

* [#629] store extra information of the virtual machine

Each different VM can have extra fields only for its kind

* fix: clean iptables even if domain removed

[#629]

* fix: remove domain even it is not known

[#629]

* wip(backend): remove disks from volatile clones

issue #629 wip

* feat(backup): clean temporary machines volumes

issue #629

* test(volatile): check volatile volumes are removed

* fix(downloads): retry if download failed

* fix(volatile): clean requests on machine remove

issue #629
parent 3f70450b
......@@ -789,7 +789,6 @@ sub _create_table {
$sth->finish;
return if keys %$info;
warn "INFO: creating table $table\n";
my $file_sql = "$DIR_SQL/$table.sql";
open my $in,'<',$file_sql or die "$! $file_sql";
my $sql = join " ",<$in>;
......@@ -2156,10 +2155,10 @@ sub _cmd_set_driver {
$domain->set_driver_id($request->args('id_option'));
}
sub _cmd_refresh_storage($self, $request) {
sub _cmd_refresh_storage($self, $request=undef) {
my $vm;
if ($request->defined_arg('id_vm')) {
if ($request && $request->defined_arg('id_vm')) {
$vm = Ravada::VM->open($request->defined_arg('id_vm'));
} else {
$vm = $self->search_vm('KVM');
......@@ -2268,9 +2267,10 @@ sub _refresh_volatile_domains($self) {
);
$sth->execute();
while ( my ($id_domain, $name, $id_vm) = $sth->fetchrow ) {
my $domain = Ravada::Domain->open($id_domain);
if ( !$domain || $domain->status eq 'down') {
$domain->remove($USER_DAEMON) if $domain;
my $domain = Ravada::Domain->open(id => $id_domain, _force => 1);
if ( !$domain || $domain->status eq 'down' || !$domain->is_active) {
$domain->_post_shutdown(user => $USER_DAEMON);
$domain->remove($USER_DAEMON);
my $sth_del = $CONNECTOR->dbh->prepare("DELETE FROM domains WHERE id=?");
$sth_del->execute($id_domain);
$sth_del->finish;
......
......@@ -188,6 +188,10 @@ around 'autostart' => \&_around_autostart;
sub BUILD {
my $self = shift;
my $args = shift;
$self->{_name} = $args->{name} if exists $args->{name};
$self->_init_connector();
$self->is_known();
......@@ -478,7 +482,7 @@ sub _allowed {
sub _around_display($orig,$self,$user) {
$self->_allowed($user);
my $display = $self->$orig($user);
$self->_data(display => $display);
$self->_data(display => $display) if !$self->readonly;
return $display;
}
......@@ -504,18 +508,27 @@ Returns the id of the domain
my $id = $domain->id();
=cut
sub id {
return $_[0]->_data('id');
sub id($self) {
return $self->{_id} if exists $self->{_id};
my $id = $_[0]->_data('id');
$self->{_id} = $id;
return $id;
}
##################################################################################
sub _data($self, $field, $value=undef) {
sub _data($self, $field, $value=undef, $table='domains') {
_init_connector();
my $data = "_data";
my $field_id = 'id';
if ($table ne 'domains' ) {
$data = "_data_$table";
$field_id = 'id_domain';
}
if (defined $value) {
confess "Domain ".$self->name." is not in the DB"
if !$self->is_known();
......@@ -524,19 +537,29 @@ sub _data($self, $field, $value=undef) {
if $field !~ /^[a-z]+[a-z0-9_]*$/;
my $sth = $$CONNECTOR->dbh->prepare(
"UPDATE domains set $field=? WHERE id=?"
"UPDATE $table set $field=? WHERE $field_id=?"
);
$sth->execute($value, $self->id);
$sth->finish;
$self->{_data}->{$field} = $value;
$self->{$data}->{$field} = $value;
$self->_propagate_data($field,$value) if $PROPAGATE_FIELD{$field};
}
return $self->{_data}->{$field} if exists $self->{_data}->{$field};
$self->{_data} = $self->_select_domain_db( name => $self->name);
return $self->{$data}->{$field} if exists $self->{$data}->{$field};
confess "No DB info for domain ".$self->name if !$self->{_data};
confess "No field $field in domains" if !exists$self->{_data}->{$field};
my @field_select = ( name => $self->name );
@field_select = ( id_domain => $self->id ) if $table ne 'domains';
$self->{$data} = $self->_select_domain_db( _table => $table, @field_select );
return $self->{_data}->{$field};
confess "No DB info for domain @field_select in $table ".$self->name
if ! exists $self->{$data};
confess "No field $field in $data @field_select ".Dumper($self->{$data})
if !exists $self->{$data}->{$field};
return $self->{$data}->{$field};
}
sub _data_extra($self, $field, $value=undef) {
return $self->_data($field, $value, "domains_".lc($self->type));
}
=head2 open
......@@ -549,9 +572,22 @@ Returns: Domain object read only
=cut
sub open($class, $id) {
confess "Missing id" if !defined $id;
sub open($class, @args) {
my ($id) = @args;
my $readonly = 0;
my $id_vm;
my $force;
if (scalar @args > 1) {
my %args = @args;
$id = delete $args{id} or confess "ERROR: Missing field id";
$readonly = delete $args{readonly} if exists $args{readonly};
$id_vm = delete $args{id_vm};
$force = delete $args{_force};
confess "ERROR: Unknown fields ".join(",", sort keys %args)
if keys %args;
}
confess "Undefined id" if !defined $id;
my $self = {};
if (ref($class)) {
......@@ -573,7 +609,8 @@ sub open($class, $id) {
@ro = (readonly => 1 ) if $>;
my $vm = $vm0->new( @ro );
return $vm->search_domain($row->{name});
my $domain = $vm->search_domain($row->{name}, $force);
return $domain;
}
=head2 is_known
......@@ -584,7 +621,7 @@ Returns if the domain is known in Ravada.
sub is_known {
my $self = shift;
return $self->_select_domain_db(name => $self->name);
return ( $self->_select_domain_db(name => $self->name) or 0);
}
=head2 start_time
......@@ -614,15 +651,18 @@ sub _select_domain_db {
%args = ( name => $self->name );
}
}
my $table = ( delete $args{_table} or 'domains');
my $sth = $$CONNECTOR->dbh->prepare(
"SELECT * FROM domains WHERE ".join(",",map { "$_=?" } sort keys %args )
"SELECT * FROM $table WHERE ".join(",",map { "$_=?" } sort keys %args )
);
$sth->execute(map { $args{$_} } sort keys %args);
my $row = $sth->fetchrow_hashref;
$sth->finish;
$self->{_data} = $row;
my $data = "_data";
$data = "_data_$table" if $table ne 'domains';
$self->{$data} = $row;
return $row if $row->{id};
}
......@@ -771,6 +811,12 @@ sub _insert_db {
);
$sth->execute($self->internal_id, $self->id);
$sth->finish;
$sth = $$CONNECTOR->dbh->prepare("INSERT INTO domains_".lc($self->type)
." ( id_domain ) VALUES (?) ");
$sth->execute($self->id);
$sth->finish;
}
=head2 pre_remove
......@@ -787,20 +833,25 @@ sub pre_remove { }
sub _pre_remove_domain($self, $user=undef) {
eval { $self->id };
$self->pre_remove();
$self->_allow_remove($user);
$self->is_volatile() if $self->is_known || $self->domain;
$self->list_disks() if $self->is_known || $self->domain;
$self->pre_remove();
$self->_remove_iptables() if $self->is_known();
}
sub _after_remove_domain {
my $self = shift;
my ($user, $cascade) = @_;
$self->_remove_iptables(user => $user);
if ($self->is_base) {
$self->_do_remove_base(@_);
$self->_remove_files_base();
}
return if !$self->{_data};
$self->_finish_requests_db();
$self->_remove_base_db();
$self->_remove_domain_db();
}
......@@ -808,12 +859,33 @@ sub _after_remove_domain {
sub _remove_domain_db {
my $self = shift;
return if !$self->is_known();
$self->_select_domain_db or return;
my $id = $self->id;
my $type = $self->type;
my $sth = $$CONNECTOR->dbh->prepare("DELETE FROM domains "
." WHERE id=?");
$sth->execute($self->id);
$sth->execute($id);
$sth->finish;
$sth = $$CONNECTOR->dbh->prepare("DELETE FROM domains_".lc($type)
." WHERE id=?");
$sth->execute($id);
$sth->finish;
}
sub _finish_requests_db {
my $self = shift;
$self->_select_domain_db or return;
my $id = $self->id;
my $type = $self->type;
my $sth = $$CONNECTOR->dbh->prepare("UPDATE requests "
." SET status='done' "
." WHERE id_domain=? AND status == 'requested' ");
$sth->execute($id);
$sth->finish;
}
......@@ -1193,6 +1265,7 @@ sub _pre_shutdown {
if ($self->is_paused) {
$self->resume(user => $user);
}
$self->list_disks;
}
sub _post_shutdown {
......@@ -1204,7 +1277,6 @@ sub _post_shutdown {
$self->_remove_iptables(%arg);
$self->_data(status => 'shutdown')
if $self->is_known && !$self->is_volatile && !$self->is_active;
$self->_remove_temporary_machine(@_);
if ($self->is_known && $self->id_base) {
for ( 1 .. 5 ) {
last if !$self->is_active;
......@@ -1226,6 +1298,7 @@ sub _post_shutdown {
, at => time+$timeout
);
}
$self->_remove_temporary_machine(@_);
}
sub _around_is_active($orig, $self) {
......@@ -1249,6 +1322,7 @@ sub _around_shutdown_now {
my $self = shift;
my $user = shift;
$self->list_disks;
if ($self->is_active) {
$self->$orig($user);
}
......@@ -1325,7 +1399,8 @@ sub _remove_iptables {
sub _remove_temporary_machine {
my $self = shift;
return if !$self->is_known || !$self->is_volatile;
return if !$self->is_volatile;
my %args = @_;
my $user = delete $args{user} or confess "ERROR: Missing user";
......@@ -1333,16 +1408,11 @@ sub _remove_temporary_machine {
my $req= $args{request};
$req->status(
"removing"
,"Removing domain ".$self->name." after shutdown"
." because user "
.$user->name." is temporary")
,"Removing volatile machine ".$self->name)
if $req;
if ($self->is_removed) {
$self->_after_remove_domain();
} else {
$self->remove($user);
}
$self->remove($user);
}
sub _post_resume {
......@@ -1633,7 +1703,21 @@ Returns if the domain is volatile, so it will be removed on shutdown
=cut
sub is_volatile($self, $value=undef) {
return $self->_set_data('is_volatile', $value);
return $self->{_is_volatile} if exists $self->{_is_volatile} && !defined $value;
my $is_volatile = 0;
if ($self->is_known) {
$is_volatile = $self->_data('is_volatile', $value);
} elsif ($self->domain) {
$is_volatile = $self->is_persistent();
}
$self->{_is_volatile} = $is_volatile;
return $is_volatile;
}
sub is_persistent($self) {
return !$self->{_is_volatile} if exists $self->{_is_volatile};
return 0;
}
=head2 run_timeout
......@@ -1907,6 +1991,13 @@ Returns the virtual machine type as a string.
sub type {
my $self = shift;
if (!$self->is_known) {
my ($type) = ref($self) =~ /.*::([a-zA-Z][a-zA-Z0-9]*)/;
confess "Unknown type from ".ref($self) if !$type;
return $type;
}
confess "Unknown vm ".Dumper($self->{_data})
if !$self->_data('vm');
return $self->_data('vm');
}
......
......@@ -27,7 +27,7 @@ with 'Ravada::Domain';
has 'domain' => (
is => 'rw'
,isa => 'Sys::Virt::Domain'
,required => 1
,required => 0
);
has '_vm' => (
......@@ -73,8 +73,14 @@ Returns the name of the domain
sub name {
my $self = shift;
$self->{_name} = $self->domain->get_name if !$self->{_name};
return $self->{_name};
return $self->{_name} if $self->{_name};
return $self->{_data}->{name} if $self->{_data};
$self->{_name} = $self->domain->get_name if $self->domain;
return $self->{_name} if $self->{_name};
confess "ERROR: Unknown domain name";
}
=head2 list_disks
......@@ -89,7 +95,7 @@ sub list_disks {
my $self = shift;
my @disks = ();
my $doc = XML::LibXML->load_xml(string => $self->domain->get_xml_description);
my $doc = XML::LibXML->load_xml(string => $self->xml_description);
for my $disk ($doc->findnodes('/domain/devices/disk')) {
next if $disk->getAttribute('device') ne 'disk';
......@@ -104,6 +110,22 @@ sub list_disks {
return @disks;
}
sub xml_description($self) {
return $self->_data_extra('xml') if !$self->domain && $self->is_known;
confess "ERROR: KVM domain not available" if !$self->domain;
my $xml;
eval {
$xml = $self->domain->get_xml_description();
$self->_data_extra('xml', $xml) if $self->is_known;
};
confess $@ if $@ && $@ !~ /libvirt error code: 42/;
if ( $@ ) {
return $self->_data_extra('xml');
}
return $xml;
}
=head2 remove_disks
Remove the volume files of the domain
......@@ -115,13 +137,6 @@ sub remove_disks {
my $removed = 0;
return if !$self->is_known();
my $id;
eval { $id = $self->id };
return if $@ && $@ =~ /No DB info/i;
die $@ if $@;
$self->_vm->connect();
for my $file ($self->list_disks) {
if (! -e $file ) {
......@@ -136,7 +151,7 @@ sub remove_disks {
$removed++;
}
return if $self->is_removed;
warn "WARNING: No disk files removed for ".$self->domain->get_name."\n"
.Dumper([$self->list_disks])
if !$removed && $0 !~ /\.t$/;
......@@ -153,6 +168,7 @@ Cleanup operations executed before removing this domain
sub pre_remove_domain {
my $self = shift;
$self->xml_description();
$self->domain->managed_save_remove() if $self->domain->has_managed_save_image;
}
......@@ -182,12 +198,18 @@ sub remove {
my $self = shift;
my $user = shift;
if ($self->domain->is_active) {
if (!$self->is_removed ) {
$self->list_disks();
}
if (!$self->is_removed && $self->domain && $self->domain->is_active) {
$self->_do_force_shutdown();
}
eval { $self->domain->undefine() if $self->domain && !$self->is_removed };
die $@ if $@ && $@ !~ /libvirt error code: 42/;
eval { $self->remove_disks(); };
eval { $self->remove_disks() if $self->is_known };
die $@ if $@ && $@ !~ /libvirt error code: 42/;
# warn "WARNING: Problem removing disks for ".$self->name." : $@" if $@ && $0 !~ /\.t$/;
......@@ -200,8 +222,9 @@ sub remove {
$self->_post_remove_base_domain() if $self->is_base();
eval { $self->domain->undefine() };
eval { $self->domain->undefine() if $self->domain };
die $@ if $@ && $@ !~ /libvirt error code: 42/;
}
......@@ -233,7 +256,7 @@ sub _disk_device {
my $with_target = shift;
my $doc = XML::LibXML->load_xml(string => $self->domain->get_xml_description)
my $doc = XML::LibXML->load_xml(string => $self->xml_description)
or die "ERROR: $!\n";
my @img;
......@@ -268,8 +291,7 @@ sub _disk_device {
sub _disk_devices_xml {
my $self = shift;
my $doc = XML::LibXML->load_xml(string => $self->domain
->get_xml_description)
my $doc = XML::LibXML->load_xml(string => $self->xml_description)
or die "ERROR: $!\n";
my @devices;
......@@ -471,7 +493,7 @@ Returns the display URI
sub display {
my $self = shift;
my $xml = XML::LibXML->load_xml(string => $self->domain->get_xml_description);
my $xml = XML::LibXML->load_xml(string => $self->xml_description);
my ($graph) = $xml->findnodes('/domain/devices/graphics')
or die "ERROR: I can't find graphic";
......@@ -498,6 +520,16 @@ sub is_active {
return ( $self->domain->is_active or 0);
}
=head2 is_persistent
Returns wether the domain has a persistent configuration file
=cut
sub is_persistent($self) {
return $self->domain->is_persistent;
}
=head2 start
Starts the domain
......@@ -1606,11 +1638,14 @@ In KVM it removes saved images.
sub pre_remove {
my $self = shift;
$self->domain->managed_save_remove if $self->domain->has_managed_save_image;
return if $self->is_removed;
$self->domain->managed_save_remove
if $self->domain && $self->domain->has_managed_save_image;
}
sub is_removed($self) {
my $is_removed = 0;
return 1 if !$self->domain;
eval { $self->domain->get_xml_description};
return 1 if $@ && $@ =~ /libvirt error code: 42/;
die $@ if $@;
......
......@@ -247,6 +247,14 @@ sub search_domain_by_id {
return $self->search_domain($name);
}
sub _domain_in_db($self, $name) {
my $sth = $$CONNECTOR->dbh->prepare("SELECT id FROM domains WHERE name=?");
$sth->execute($name);
my ($id) =$sth->fetchrow;
return $id;
}
=head2 ip
Returns the external IP this for this VM
......
......@@ -427,23 +427,28 @@ Returns true or false if domain exists.
=cut
sub search_domain {
my $self = shift;
my $name = shift or confess "Missing name";
sub search_domain($self, $name, $force=undef) {
$self->connect();
my @all_domains;
eval { @all_domains = $self->vm->list_all_domains() };
confess $@ if $@;
for my $dom (@all_domains) {
next if $dom->get_name ne $name;
my $dom;
eval { $dom = $self->vm->get_domain_by_name($name); };
if (!$dom) {
return if !$force;
return if !$self->_domain_in_db($name);
}
my $domain;
my @domain = ( );
@domain = ( domain => $dom ) if $dom;
eval {
$domain = Ravada::Domain::KVM->new(
domain => $dom
@domain
,name => $name
,readonly => $self->readonly
,_vm => $self
);
......@@ -452,11 +457,10 @@ sub search_domain {
if ($domain) {
return $domain;
}
}
return;
}
=head2 list_domains
Returns a list of the created domains
......@@ -652,6 +656,7 @@ sub _domain_create_from_iso {
$domain->_insert_db(name=> $args{name}, id_owner => $args{id_owner});
$domain->_set_spice_password($spice_password)
if $spice_password;
$domain->xml_description();
return $domain;
}
......@@ -829,6 +834,7 @@ sub _domain_create_from_base {
= $self->_domain_create_common($xml,%args, is_volatile => $base->volatile_clones);
$domain->_insert_db(name=> $args{name}, id_base => $base->id, id_owner => $args{id_owner});
$domain->_set_spice_password($spice_password);
$domain->xml_description();
return $domain;
}
......@@ -1179,9 +1185,9 @@ sub _match_file($self, $url, $file_re) {
my $res;
for ( 1 .. 10 ) {
eval { $res = $self->_web_user_agent->get($url)->res(); };
last if !$@;
last if !$@ && $res && defined $res->code;
next if $@ && $@ =~ /timeout/i;