Commit 8c7680dd authored by Francesc Guasch's avatar Francesc Guasch
Browse files

Merge branch 'master' of https://github.com/UPC/ravada

parents 93325365 ec68c9da
......@@ -878,6 +878,7 @@ sub _add_indexes_generic($self) {
my %index = (
requests => [
"index(status,at_time)"
,"index(id,date_changed,status,at_time)"
,"index(date_changed)"
,"index(start_time,command,status,pid)"
]
......@@ -887,6 +888,9 @@ sub _add_indexes_generic($self) {
,iptables => [
"index(id_domain,time_deleted,time_req)"
]
,messages => [
"index(id_request,date_send)"
]
);
for my $table ( keys %index ) {
my $known = $self->_get_indexes($table);
......@@ -1687,18 +1691,13 @@ sub create_domain {
my $user = Ravada::Auth::SQL->search_by_id($id_owner);
$request->status("creating machine") if $request;
if ( $base && $base->is_base ) {
if ( $base && $base->is_base && $base->volatile_clones || $user->is_temporary ) {
$request->status("balancing") if $request;
$vm = $vm->balance_vm($base) or die "Error: No free nodes available.";
$request->status("creating machine on ".$vm->name) if $request;
}
confess "No vm found, request = ".Dumper(request => $request) if !$vm;
carp "WARNING: no VM defined, we will use ".$vm->name
if !$vm_name && !$id_base;
confess "I can't find any vm ".Dumper($self->vm) if !$vm;
confess "Error: missing vm " if !$vm;
my $domain;
eval { $domain = $vm->create_domain(%args)};
......@@ -2689,7 +2688,7 @@ sub _can_fork {
delete $reqs{$pid} if !$request || $request->status eq 'done';
}
my $n_pids = scalar(keys %reqs);
return 1 if $n_pids <= $req->requests_limit();
return 1 if $n_pids < $req->requests_limit();
my $msg = $req->command
." waiting for processes to finish"
......@@ -3590,9 +3589,12 @@ sub _cmd_cleanup($self, $request) {
$self->_clean_volatile_machines( request => $request);
$self->_clean_temporary_users( );
$self->_clean_requests('cleanup', $request);
$self->_clean_requests('cleanup', $request,'done');
$self->_clean_requests('enforce_limits', $request,'done');
$self->_clean_requests('refresh_vms', $request,'done');
for my $cmd ( qw(cleanup enforce_limits refresh_vms
manage_pools refresh_machine screenshot
open_iptables ping_backend
)) {
$self->_clean_requests($cmd, $request,'done');
}
}
sub _req_method {
......
......@@ -293,6 +293,7 @@ sub _vm_disconnect {
}
sub _around_start($orig, $self, @arg) {
$self->_start_preconditions(@arg);
my %arg;
......@@ -305,25 +306,51 @@ sub _around_start($orig, $self, @arg) {
my $listen_ip = delete $arg{listen_ip};
my $remote_ip = $arg{remote_ip};
if (!defined $listen_ip) {
my $display_ip;
if ($remote_ip) {
my $set_password = 0;
my $network = Ravada::Network->new(address => $remote_ip);
$set_password = 1 if $network->requires_password();
$display_ip = $self->_listen_ip($remote_ip);
$arg{set_password} = $set_password;
} else {
$display_ip = $self->_listen_ip();
for (;;) {
eval { $self->_start_checks(@arg) };
if ($@ && $@ =~/base file not found/ && !$self->_vm->is_local) {
$self->_request_set_base();
next;
}
if (!defined $listen_ip) {
my $display_ip;
if ($remote_ip) {
my $set_password = 0;
my $network = Ravada::Network->new(address => $remote_ip);
$set_password = 1 if $network->requires_password();
$display_ip = $self->_listen_ip($remote_ip);
$arg{set_password} = $set_password;
} else {
$display_ip = $self->_listen_ip();
}
$arg{listen_ip} = $display_ip;
}
$arg{listen_ip} = $display_ip;
eval { $self->$orig(%arg) };
last if !$@;
warn $@ if $@;
if ($@ && $self->id_base && !$self->_vm->is_local && $self->_vm->enabled) {
$self->_request_set_base();
next;
}
die $@;
}
my $ret = $self->$orig(%arg);
$self->_post_start(%arg);
}
sub _request_set_base($self) {
my $base = Ravada::Domain->open($self->id_base);
$base->_set_base_vm_db($self->_vm->id,0);
Ravada::Request->set_base_vm(
uid => Ravada::Utils::user_daemon->id
,id_domain => $base->id
,id_vm => $self->_vm->id
,at => time + int(rand(10))
);
my $vm_local = $self->_vm->new( host => 'localhost' );
$self->_set_vm($vm_local, 1);
}
sub _start_preconditions{
my ($self) = @_;
......@@ -348,9 +375,18 @@ sub _start_preconditions{
_allow_manage(@_);
}
#_check_used_memory(@_);
$self->status('starting');
}
sub _start_checks($self, @args) {
return if $self->_search_already_started('fast');
$self->status('starting');
my ($id_vm, $request);
if (!scalar(@args) % 2) {
my %args = @args;
$id_vm = delete $args{id_vm};
$request = delete $args{request} if exists $args{request};
}
# if it is a clone ( it is not a base )
if ($self->id_base) {
# $self->_set_last_vm(1)
......@@ -358,6 +394,7 @@ sub _start_preconditions{
my $vm_local = $self->_vm->new( host => 'localhost' );
$self->_set_vm($vm_local, 1);
}
$self->_check_tmp_volumes();
my $vm;
if ($id_vm) {
$vm = Ravada::VM->open($id_vm);
......@@ -377,7 +414,6 @@ sub _start_preconditions{
my $vm_local = $self->_vm->new( host => 'localhost' );
$self->_set_vm($vm_local, 1);
}
$self->status('starting');
$self->_check_free_vm_memory();
#TODO: remove them and make it more general now we have nodes
#$self->_check_cpu_usage($request);
......@@ -441,10 +477,25 @@ sub _balance_vm($self) {
my $base;
$base = Ravada::Domain->open($self->id_base) if $self->id_base;
my $vm_free = $self->_vm->balance_vm($base);
return if !$vm_free;
my $vm_free;
for (;;) {
$vm_free = $self->_vm->balance_vm($base);
return if !$vm_free;
$self->migrate($vm_free) if $vm_free->id != $self->_vm->id;
last if $vm_free->id == $self->_vm->id;
eval { $self->migrate($vm_free) };
last if !$@;
if ($@ && $@ =~ /file not found/i) {
$base->_set_base_vm_db($vm_free->id,0);
Ravada::Request->set_base_vm(
uid => Ravada::Utils::user_daemon->id
,id_domain => $base->id
,id_vm => $vm_free->id
);
next;
}
die $@;
}
return $vm_free->id;
}
......@@ -494,6 +545,8 @@ sub _allow_remove($self, $user) {
return if !$self->is_known(); # already removed
confess "Error: arg user is not Ravada::Auth object" if !ref($user);
die "ERROR: remove not allowed for user ".$user->name
unless $user->can_remove_machine($self);
......@@ -657,7 +710,8 @@ sub prepare_base($self, $with_cd) {
for my $volume ($self->list_volumes_info()) {
my $base_file = $volume->base_filename;
next if !$base_file || $base_file =~ /\.iso$/;
die "Error: file '$base_file' already exists" if $self->_vm->file_exists($base_file);
confess "Error: file '$base_file' already exists in ".$self->_vm->name
if $self->_vm->file_exists($base_file);
}
for my $volume ($self->list_volumes_info()) {
......@@ -812,12 +866,43 @@ sub _check_free_vm_memory {
return if $vm_free_mem > $self->_vm->min_free_memory;
my $msg = "Error: No free memory. Only "._gb($vm_free_mem)." out of "
my $msg = "Error: No free memory in ".$self->_vm->name.". Only "._gb($vm_free_mem)." out of "
._gb($self->_vm->min_free_memory)." GB required.\n";
die $msg;
}
sub _check_tmp_volumes($self) {
confess "Error: only clones temporary volumes can be checked."
if !$self->id_base;
for my $vol ( $self->list_volumes_info) {
next unless $vol->file && $vol->file =~ /\.(TMP|SWAP)\./;
next if $self->_vm->file_exists($vol->file);
my $base = Ravada::Domain->open($self->id_base);
if (! $self->is_local) {
Ravada::Request->set_base_vm(
id_domain => $base->id
,id_vm => $self->_vm->id
,uid => Ravada::Utils::user_daemon->id
);
confess "Error: base file not found in node ".$self->_vm->name." ".$vol->file;
}
my @volumes = $base->list_files_base_target;
my ($file_base) = grep { $_->[1] eq $vol->info->{target} } @volumes;
if (!$file_base) {
warn "Error: I can't find base volume for target ".$vol->info->{target}
.Dumper(\@volumes);
}
my $vol_base = Ravada::Volume->new( file => $file_base->[0]
, vm => $self->_vm
);
$vol_base->clone(file => $vol->file);
warn "cloned ".$self->name." ".$self->_vm->name." ".$vol_base->vm->name." "
.$vol->info->{target};
}
}
sub _check_cpu_usage($self, $request=undef){
return if ref($self) =~ /Void/i;
......@@ -1909,18 +1994,54 @@ sub remove_base($self, $user) {
return $self->_do_remove_base($user);
}
sub _do_remove_base($self, $user) {
if ($self->is_base) {
for my $vm ( $self->list_vms ) {
$self->remove_base_vm(vm => $vm, user => $user) if !$vm->is_local;
}
sub _cascade_remove_base_in_nodes($self) {
my $req_nodes;
for my $vm ( $self->list_vms ) {
next if $vm->is_local;
my @after;
push @after,(after_request => $req_nodes->id) if $req_nodes;
$req_nodes = Ravada::Request->remove_base_vm(
id_vm => $vm->id
,id_domain => $self->id
,uid => Ravada::Utils::user_daemon->id
,@after
);
}
$self->is_base(0);
if ( $req_nodes ) {
my $vm_local = $self->_vm->new( host => 'localhost' );
Ravada::Request->remove_base_vm(
id_vm => $vm_local->id
,id_domain => $self->id
,uid => Ravada::Utils::user_daemon->id
,after_request => $req_nodes->id
);
$self->is_base(0);
}
return $req_nodes;
}
sub _do_remove_base($self, $user) {
return
if $self->is_base && $self->is_local
&& $self->_cascade_remove_base_in_nodes ();
$self->is_base(0) if $self->is_local;
my $vm_local = $self->_vm->new( host => 'localhost' );
for my $vol ($self->list_volumes_info) {
next if !$vol->file || $vol->file =~ /\.iso$/;
my $backing_file = $vol->backing_file;
next if !$backing_file;
# confess "Error: no backing file for ".$vol->file if !$backing_file;
if (!$self->is_local) {
my ($dir) = $backing_file =~ m{(.*/)};
if ( $self->_vm->shared_storage($vm_local, $dir) ) {
next;
}
$self->_vm->remove_file($vol->file);
$self->_vm->remove_file($backing_file);
$self->_vm->refresh_storage_pools();
return ;
}
$vol->block_commit();
unlink $vol->file or die "$! ".$vol->file;
my @stat = stat($backing_file);
......@@ -1958,20 +2079,10 @@ sub _pre_remove_base {
sub _post_remove_base {
my $self = shift;
return if !$self->_vm->is_local;
$self->_remove_base_db(@_);
$self->_post_remove_base_domain();
$self->_remove_all_bases();
}
sub _remove_all_bases($self) {
my $sth = $$CONNECTOR->dbh->prepare("SELECT id_vm FROM bases_vm "
." WHERE id_domain=? AND enabled=1"
);
$sth->execute($self->id);
while ( my ($id_vm) = $sth->fetchrow ) {
$self->remove_base_vm( id_vm => $id_vm );
}
}
sub _post_spinoff($self) {
......@@ -3681,19 +3792,12 @@ sub _pre_migrate($self, $node, $request = undef) {
my $base = Ravada::Domain->open($self->id_base);
confess "ERROR: base id ".$self->id_base." not found." if !$base;
die "ERROR: Base ".$base->name." files not migrated to ".$node->name
confess "ERROR: Base ".$base->name." files not migrated to ".$node->name
if !$base->base_in_vm($node->id);
for my $file ( $base->list_files_base ) {
my ($name) = $file =~ m{.*/(.*)};
my $vol_path = $node->search_volume_path($name);
die "ERROR: $file not found in ".$node->host
if !$vol_path;
die "ERROR: $name found at $vol_path instead $file"
if $vol_path ne $file;
next if $node->file_exists($file);
confess "ERROR: file not found $file in ".$node->host;
}
$self->_set_base_vm_db($node->id,0);
......@@ -3782,13 +3886,9 @@ sub set_base_vm($self, %args) {
$value = 1 if !defined $value;
if ($vm->is_local) {
$self->_set_vm($vm,1);
$self->_set_vm($vm,1); # force set vm on domain
if (!$value) {
$request->status("working","Removing base") if $request;
for my $vm_node ( $self->list_vms ) {
$self->set_base_vm(vm => $vm_node, user => $user, value => 0
, request => $request) if !$vm_node->is_local;
}
$self->_set_base_vm_db($vm->id, $value);
$self->remove_base($user);
} else {
......@@ -3800,20 +3900,8 @@ sub set_base_vm($self, %args) {
if $request;
$self->migrate($vm, $request);
} else {
if ($vm->is_active) {
my $vm_local = $self->_vm->new( host => 'localhost' );
for my $file ($self->list_files_base()) {
my ($path) = $file =~ m{(.*/)};
next if $vm_local->shared_storage($vm, $path);
confess "Error: file has non-valid characters" if $file =~ /[*;&'" ]/;
my ($out, $err);
eval { ($out, $err) = $vm->remove_file($file)
if $vm->file_exists($file);
};
$err = $@ if !$err && $@;
warn $err if $err;
}
}
$self->_set_vm($vm,1); # force set vm on domain
$self->_do_remove_base($user);
}
if (!$vm->is_local) {
......@@ -3843,6 +3931,7 @@ sub remove_base_vm($self, %args) {
confess "ERROR: Unknown arguments ".join(',',sort keys %args).", valid are user and vm."
if keys %args;
warn $vm->name;
return $self->set_base_vm(vm => $vm, user => $user, value => 0);
}
......@@ -3883,7 +3972,7 @@ Returns a list for virtual machine managers where this domain is base
sub list_vms($self) {
confess "Domain is not base" if !$self->is_base;
my $sth = $$CONNECTOR->dbh->prepare("SELECT id_vm FROM bases_vm WHERE id_domain=?");
my $sth = $$CONNECTOR->dbh->prepare("SELECT id_vm FROM bases_vm WHERE id_domain=? AND enabled = 1");
$sth->execute($self->id);
my @vms;
while (my $id_vm = $sth->fetchrow) {
......
......@@ -662,9 +662,12 @@ sub start {
}
return if !$error || $error =~ /already running/i;
if ($error =~ /libvirt error code: 38,/) {
warn "Error starting ".$self->name." on ".$self->_vm->name;
if (!$self->_vm->is_local) {
warn "Disabling node ".$self->_vm->name();
$self->_vm->enabled(0);
if ($error !~ /backing file/) {
warn "Disabling node ".$self->_vm->name();
$self->_vm->enabled(0);
}
}
die $error;
} elsif ( $error =~ /libvirt error code: 9, .*already defined with uuid/) {
......
......@@ -129,11 +129,16 @@ our %CMD_SEND_MESSAGE = map { $_ => 1 }
change_owner
add_hardware remove_hardware set_driver change_hardware
expose remove_expose
set_base_vm
rebase rebase_volumes
shutdown_node start_node
);
our %CMD_NO_DUPLICATE = map { $_ => 1 }
qw(
set_base_vm
remove_base_vm
);
our $TIMEOUT_SHUTDOWN = 120;
our $CONNECTOR;
......@@ -151,8 +156,9 @@ our %COMMAND = (
,disk => {
limit => 1
,commands => ['prepare_base','remove_base','set_base_vm','rebase_volumes'
, 'remove_base_vm'
, 'screenshot'
, 'manage_pools']
]
,priority => 6
}
,important=> {
......@@ -163,7 +169,7 @@ our %COMMAND = (
,secondary => {
limit => 50
,priority => 2
,commands => ['shutdown','shutdown_now']
,commands => ['shutdown','shutdown_now', 'manage_pools']
}
);
lock_hash %COMMAND;
......@@ -491,19 +497,30 @@ sub new_request($self, $command, @args) {
);
}
sub _duplicated_request($command, $args) {
return if !$args;
my $args_d = decode_json($args);
sub _duplicated_request($self=undef, $command=undef, $args=undef) {
my $args_d;
if ($self) {
confess "Error: do not supply args if you supply request" if $args;
confess "Error: do not supply command if you supply request" if $command;
$args_d = $self->args;
$command = $self->command;
} else {
$args_d = decode_json($args);
}
delete $args_d->{uid};
delete $args_d->{at};
my $sth = $$CONNECTOR->dbh->prepare(
"SELECT id,args FROM requests WHERE status='requested'"
." AND command=?"
);
$sth->execute($command);
while (my ($id,$args_found) = $sth->fetchrow) {
next if $self && $self->id == $id;
my $args_found_d = decode_json($args_found);
delete $args_found_d->{uid};
delete $args_found_d->{at};
next if join(".",sort keys %$args_d) ne join(".",sort keys %$args_found_d);
my $args_d_s = join(".",map { $args_d->{$_} } sort keys %$args_d);
......@@ -555,8 +572,9 @@ sub _new_request {
}
_init_connector() if !$CONNECTOR || !$$CONNECTOR;
if ($args{command} =~ /^(clone|manage_pools|list_isos)$/
|| $CMD_NO_DUPLICATE{$args{command}}
|| ($no_duplicate && $args{command} =~ /^(screenshot)$/)) {
if ( _duplicated_request($args{command}, $args{args})
if ( _duplicated_request(undef, $args{command}, $args{args})
|| ( $args{command} ne 'clone' && done_recently(undef, 60, $args{command}))) {
# warn "Warning: duplicated request for $args{command} $args{args}";
return;
......@@ -1193,13 +1211,18 @@ sub _requested($command, %fields) {
}
sub stop($self) {
my $stale = '';
my $run_time = '';
if ($self->start_time) {
$run_time = time - $self->start_time;
$stale = ", stale for $run_time seconds.";
}
warn "Killing ".$self->command
." , pid: ".$self->pid
.", stale for ".(time - $self->start_time)." seconds\n";
my $ok = kill (15,$self->pid);
$self->status('done',"Killed start process after "
.(time - $self->start_time)." seconds\n");
." , pid: ".( $self->pid or '<UNDEF>')
.$stale
."\n";
kill (15,$self->pid) if $self->pid;
$self->status('done',"Killed start process after $run_time seconds.");
}
sub priority($self) {
......
......@@ -626,7 +626,8 @@ sub _interface_ip($self, $remote_ip=undef) {
my %route;
my ($default_gw , $default_ip);
my $remote_ip_addr = NetAddr::IP->new($remote_ip);
my $remote_ip_addr = NetAddr::IP->new($remote_ip)
or confess "I can't find netaddr for $remote_ip";
for my $line ( split( /\n/, $out ) ) {
if ( $line =~ m{^default via ([\d\.]+)} ) {
......@@ -638,7 +639,8 @@ sub _interface_ip($self, $remote_ip=undef) {
return $ip if $remote_ip && $remote_ip eq $ip;
my $netaddr = NetAddr::IP->new($network);
my $netaddr = NetAddr::IP->new($network)
or confess "I can't find netaddr for $network";
return $ip if $remote_ip_addr->within($netaddr);
$default_ip = $ip if !defined $default_ip && $ip !~ /^127\./;
......@@ -930,7 +932,7 @@ Returns the minimun free memory necessary to start a new virtual machine
sub min_free_memory {
my $self = shift;
return $self->_data('min_free_memory');
return ($self->_data('min_free_memory') or $Ravada::Domain::MIN_FREE_MEMORY);
}
=head2 max_load
......@@ -985,6 +987,27 @@ sub is_local($self) {
return 0;
}
=head2 is_locked
This node has requests running or waiting to be run
=cut
sub is_locked($self) {
my $sth = $$CONNECTOR->dbh->prepare("SELECT id, at_time, args FROM requests "
." WHERE status <> 'done' "
);
$sth->execute;
my ($id, $at, $args);
$sth->bind_columns(\($id, $at, $args));
while ( $sth->fetch ) {
next if defined $at && $at < time + 2;
next if !$args;
my $args_d = decode_json($args);
return 1 if exists $args_d->{id_vm} && $args_d->{id_vm} == $self->id
}
return 0;
}
=head2 list_nodes
......@@ -1279,10 +1302,12 @@ sub file_exists( $self, $file ) {
my $ssh = ($self->{_ssh} or $self->_connect_ssh());
die "Error: no ssh connection to ".$self->name if ! $ssh;
my $io = IO::Scalar->new();
my $ok = $ssh->scp_get($file, $io);
confess "Error: dangerous filename '$file'"
if $file =~ /[`|"(\\\[]/;
my ($out, $err) = $self->run_command("/bin/ls -1 $file");
return $ok;
return 1 if !$err;