Skip to content
GitLab
Commit 4b75c5bb authored by Francesc Guasch's avatar Francesc Guasch
Browse files

Fork before executing requests

parent b6070c40
Hide whitespace changes
Inline Side-by-side
lib/Ravada.pm
View file @ 4b75c5bb
......@@ -36,7 +36,7 @@ our $FILE_CONFIG = "/etc/ravada.conf";
our $CONNECTOR;
our $CONFIG = {};
our $DEBUG;
our $CAN_FORK = 0;
our $CAN_FORK = 1;
has 'vm' => (
......@@ -113,6 +113,7 @@ sub _create_vm_kvm {
eval { $vm_kvm = Ravada::VM::KVM->new( connector => ( $self->connector or $CONNECTOR )) };
my $err_kvm = $@;
return (undef, $err_kvm) if !$vm_kvm;
return ($vm_kvm,$err_kvm);
my ($internal_vm , $storage);
eval {
......@@ -131,6 +132,7 @@ sub _refresh_vm_kvm {
sleep 1;
my @vms;
eval { @vms = $self->vm };
warn $@ if $@;
return if $@ && $@ =~ /No VMs found/i;
die $@ if $@;
......@@ -498,7 +500,6 @@ sub process_requests {
my $self = shift;
my $debug = shift;
my $dont_fork = shift;
$dont_fork = 1 if !$CAN_FORK;
$self->_wait_pids_nohang();
$self->_check_vms();
......@@ -515,23 +516,18 @@ sub process_requests {
my ($n_retry) = $req->status() =~ /retry (\d+)/;
$n_retry = 0 if !$n_retry;
$req->status('working');
eval { $self->_execute($req, $dont_fork) };
my $err = $@;
$req->error($err or '');
if ($err =~ /libvirt error code: 38/) {
my $err = $self->_execute($req, $dont_fork);
$req->error($err) if $err;
if ($err && $err =~ /libvirt error code: 38/) {
if ( $n_retry < 3) {
warn $req->id." ".$req->command." to retry" if $DEBUG;
$req->status("retry ".++$n_retry)
}
$self->_refresh_vm_kvm();
} else {
$req->status('done');
}
warn "req ".$req->id." , command: ".$req->command." , status: ".$req->status()
." , error: '".($req->error or 'NONE')."'"
if $DEBUG || $debug;
$self->_refresh_vm_kvm() if $req->command =~ /create|remove/i;
}
$sth->finish;
}
......@@ -566,11 +562,34 @@ sub _execute {
my $sub = $self->_req_method($request->command);
die "Unknown command ".$request->command
if !$sub;
confess "Unknown command ".$request->command
if !$sub;
return $sub->($self,$request, $dont_fork);
if ($dont_fork || !$CAN_FORK ) {
eval { $sub->($self,$request) };
my $err = ($@ or '');
$request->error($err);
$request->status('done');
return $err;
}
my $pid = fork();
die "I can't fork" if !defined $pid;
if ($pid == 0) {
$request->status("forked $$");
eval {
$request->status("calling ".$request->command);
$sub->($self,$request);
};
my $err = ( $@ or '');
$request->error($err);
$request->status('done');
exit;
}
$self->_add_pid($pid, $request->id);
$self->_refresh_vm_kvm();
return '';
}
sub _cmd_domdisplay {
......@@ -591,7 +610,7 @@ sub _cmd_domdisplay {
}
sub _do_cmd_create{
sub _cmd_create{
my $self = shift;
my $request = shift;
......@@ -611,8 +630,20 @@ sub _wait_pids_nohang {
my $kid = waitpid(-1 , WNOHANG);
return if !$kid || $kid == -1;
warn "Kid $kid finished" if $DEBUG;
$self->_set_req_done($kid);
delete $self->{pids}->{$kid};
}
sub _set_req_done {
my $self = shift;
my $pid = shift;
my $id_request = $self->{pids}->{$pid};
return if !$id_request;
my $req = Ravada::Request->open($id_request);
$req->status('done') if $req->status =~ /working/i;
}
sub _wait_pids {
......@@ -626,8 +657,10 @@ sub _wait_pids {
# warn "Checking for pid '$pid' created at ".localtime($self->{pids}->{$pid});
my $kid = waitpid($pid,0);
# warn "Found $kid";
$self->_set_req_done($pid);
delete $self->{pids}->{$kid};
return if $kid == $pid;
}
}
......@@ -635,39 +668,12 @@ sub _wait_pids {
sub _add_pid {
my $self = shift;
my $pid = shift;
my $id_req = shift;
$self->{pids}->{$pid} = time;
}
sub _cmd_create {
my $self = shift;
my $request = shift;
my $dont_fork = shift;
return $self->_do_cmd_create($request)
if $dont_fork;
$self->_wait_pids($request);
$request->status('forking');
my $pid = fork();
if (!defined $pid) {
$request->status('done');
$request->error("I can't fork");
return;
}
if ($pid == 0 ) {
$self->_do_cmd_create($request);
exit;
}
$self->_add_pid($pid);
return;
$self->{pids}->{$pid} = $id_req;
}
sub _do_cmd_remove {
sub _cmd_remove {
my $self = shift;
my $request = shift;
......@@ -679,32 +685,6 @@ sub _do_cmd_remove {
}
sub _cmd_remove {
my $self = shift;
my $request = shift;
my $dont_fork = shift;
return $self->_do_cmd_remove($request)
if $dont_fork || !$CAN_FORK;
$self->_wait_pids($request);
$request->status('forking');
my $pid = fork();
if (!defined $pid) {
$request->status('done');
$request->error("I can't fork");
return;
}
if ($pid == 0 ) {
$self->_do_cmd_remove($request);
exit;
}
$self->_add_pid($pid);
return;
}
sub _cmd_pause {
my $self = shift;
my $request = shift;
......@@ -746,8 +726,9 @@ sub _cmd_start {
my $self = shift;
my $request = shift;
$request->status('working');
$request->status("working $$");
my $name = $request->args('name');
my $domain = $self->search_domain($name);
die "Unknown domain '$name'" if !$domain;
......
lib/Ravada/Domain.pm
View file @ 4b75c5bb
......@@ -426,7 +426,7 @@ sub clones {
return @clones;
}
=head2
=head2 list_files_base
Returns a list of the filenames of this base-type domain
......
lib/Ravada/Request.pm
View file @ 4b75c5bb
......@@ -288,26 +288,6 @@ sub prepare_base {
}
=head2 list_vm_types
Returns a list of VM types
my $req = Ravada::Request->list_vm_types();
my $types = $req->result;
=cut
sub list_vm_types {
my $proto = shift;
my $class=ref($proto) || $proto;
my $self = {};
bless ($self, $class);
return $self->_new_request( command => 'list_vm_types' );
}
=head2 ping_backend
Returns wether the backend is alive or not
......@@ -357,9 +337,10 @@ sub _new_request {
delete $args{name};
}
if ( ref $args{args} ) {
$args{args}->{uid} = $args{args}->{id_owner}
if !exists $args{args}->{uid};
$args{args} = encode_json($args{args});
}
_init_connector() if !$CONNECTOR || !$$CONNECTOR;
my $sth = $$CONNECTOR->dbh->prepare(
......@@ -448,7 +429,7 @@ sub _send_message {
my $uid;
eval { $uid = $self->args('id_owner') };
eval { $uid = $self->args('uid') };
eval { $uid = $self->args('uid') } if !$uid;
return if !$uid;
my $domain_name;
......@@ -472,7 +453,7 @@ sub _remove_unnecessary_messages {
my $uid;
eval { $uid = $self->args('id_owner') };
eval { $uid = $self->args('uid') };
eval { $uid = $self->args('uid') } if !$uid;
return if !$uid;
my $sth = $$CONNECTOR->dbh->prepare(
......
lib/Ravada/VM/KVM.pm
View file @ 4b75c5bb
......@@ -25,7 +25,7 @@ with 'Ravada::VM';
has vm => (
isa => 'Sys::Virt'
,is => 'ro'
,is => 'rw'
,builder => 'connect'
,lazy => 1
);
......@@ -81,9 +81,14 @@ sub connect {
,readonly => $self->mode
);
}
$vm->register_close_callback(\&_reconnect);
return $vm;
}
sub _reconnect {
warn "Disconnected";
}
sub _load_storage_pool {
my $self = shift;
......@@ -163,13 +168,17 @@ sub search_domain {
my $self = shift;
my $name = shift or confess "Missing name";
for ($self->vm->list_all_domains()) {
next if $_->get_name ne $name;
my @all_domains;
eval { @all_domains = $self->vm->list_all_domains() };
die $@ if $@;
for my $dom (@all_domains) {
next if $dom->get_name ne $name;
my $domain;
eval {
$domain = Ravada::Domain::KVM->new(
domain => $_
domain => $dom
,storage => $self->storage_pool
,readonly => $self->readonly
);
......@@ -260,6 +269,7 @@ sub search_volume {
my $vol;
eval { $vol = $self->storage_pool->get_volume_by_name($name) };
die $@ if $@;
return $vol;
}
......@@ -292,7 +302,9 @@ sub _domain_create_from_iso {
my $dom = $self->vm->define_domain($xml->toString());
$dom->create if $args{active};
my $domain = Ravada::Domain::KVM->new(domain => $dom , storage => $self->storage_pool);
$domain->_insert_db(name => $args{name}, id_owner => $args{id_owner});
return $domain;
}
......
t/30_request.t
View file @ 4b75c5bb
......@@ -56,18 +56,6 @@ sub test_remove_domain {
}
sub wait_request {
my $req = shift;
my $status = '';
for ( 1 .. 100 ) {
last if $req->status eq 'done';
next if $req->status eq $status;
diag("Request ".$req->command." ".$req->status);
$status=$req->status;
sleep 1;
}
}
sub test_req_create_domain_iso {
my $vm_name = shift;
......@@ -83,6 +71,7 @@ sub test_req_create_domain_iso {
);
ok($req);
ok($req->status);
ok($req->args('id_owner'));
ok(defined $req->args->{name}
......@@ -93,14 +82,15 @@ sub test_req_create_domain_iso {
ok($req->status eq 'requested'
,"Status of request is ".$req->status." it should be requested");
$ravada->_process_requests_dont_fork();
$ravada->process_requests();
wait_request($req);
sleep 1;
$ravada->_wait_pids();
wait_request($req);
ok($req->status eq 'done'
,"Status of request is ".$req->status." it should be done");
ok(!$req->error,"Error ".$req->error." creating domain ".$name);
,"Status of request is ".$req->status." it should be done") or exit;
ok(!$req->error,"Error ".$req->error." creating domain ".$name) or exit;
test_unread_messages($USER,1, "[$vm_name] create domain $name");
my $req2 = Ravada::Request->open($req->id);
......@@ -180,21 +170,6 @@ sub test_req_remove_domain_name {
}
sub test_list_vm_types {
my $vm_name = shift or confess "Missing vm name";
return if $vm_name =~ /Void/i;
my $req = Ravada::Request->list_vm_types();
$ravada->process_requests();
ok($req->status eq 'done'
,"Status of request is ".$req->status." it should be done");
ok(!$req->error,"Error ".($req->error or '')." requesting VM types ");
my $result = $req->result();
ok(ref $result eq 'ARRAY',"Expecting ARRAY , got ".ref($result));
}
sub test_unread_messages {
my ($user, $n_unread, $test) = @_;
confess "Missing test name" if !$test;
......@@ -225,8 +200,6 @@ for my $vm_name ( qw(Void KVM)) {
skip($msg,10) if !$vm;
diag("Testing requests with ".(ref $vm or '<UNDEF>'));
remove_old_domains();
remove_old_disks();
my $domain_iso0 = test_req_create_domain_iso($vm_name);
test_req_remove_domain_obj($vm, $domain_iso0) if $domain_iso0;
......@@ -237,7 +210,6 @@ for my $vm_name ( qw(Void KVM)) {
my $domain_base = test_req_create_base($vm);
test_req_remove_domain_name($vm, $domain_base->name) if $domain_base;
test_list_vm_types($vm_name);
};
}
......
t/35_request_start.t
View file @ 4b75c5bb
use warnings;
use strict;
use Carp qw(confess);
use Data::Dumper;
use Test::More;
use Test::SQL::Data;
......@@ -15,16 +17,17 @@ my $test = Test::SQL::Data->new(config => 't/etc/sql.conf');
my $RAVADA = rvd_back($test->connector, 't/etc/ravada.conf');
my $USER = create_user('foo','bar', 1);
my @ARG_CREATE_DOM;
sub test_request_start {
}
my @ARG_CREATE_DOM = ( id_owner => $USER->id , id_iso => 1 );
sub test_remove_domain {
my $vm_name = shift;
my $name = shift;
my $domain = $name if ref($name);
$domain = $RAVADA->search_domain($name,1);
my $vm = rvd_back->search_vm($vm_name)
or confess "I can't find vm $vm_name";
diag("[$vm_name] removing domain $name");
my $domain = $vm->search_domain($name,1);
my $disks_not_removed = 0;
......@@ -36,26 +39,26 @@ sub test_remove_domain {
};
ok(!$@ , "Error removing domain $name ".ref($domain).": $@") or exit;
ok(! -e $domain->file_base_img ,"Image file was not removed "
. $domain->file_base_img )
if $domain->file_base_img;
for (@disks) {
ok(!-e $_,"Disk $_ should be removed") or $disks_not_removed++;
}
}
$domain = $RAVADA->search_domain($name,1);
ok(!$domain, "I can't remove old domain $name") or exit;
$domain = $vm->search_domain($name,1);
ok(!$domain, "Removing old domain $name") or exit;
ok(!$disks_not_removed,"$disks_not_removed disks not removed from domain $name");
}
sub test_new_domain {
my $vm_name = shift;
my $name = shift;
test_remove_domain($name);
my $vm = rvd_back->search_vm($vm_name);
diag("Creating domain $name");
my $domain = $RAVADA->create_domain(name => $name, @ARG_CREATE_DOM, active => 0);
# test_remove_domain($vm_name, $name);
diag("[$vm_name] Creating domain $name");
my $domain = $vm->create_domain(name => $name, @ARG_CREATE_DOM, active => 0);
ok($domain,"Domain not created");
......@@ -64,39 +67,47 @@ sub test_new_domain {
sub test_start {
my $vm_name = shift;
my $name = new_domain_name();
test_remove_domain($name);
# test_remove_domain($vm_name, $name);
my $vm = rvd_back->search_vm($vm_name);
my $req = Ravada::Request->start_domain(
name => "does not exists"
,uid => $USER->id
);
$RAVADA->_process_requests_dont_fork();
$RAVADA->process_requests();
ok($req->status eq 'done', "Req ".$req->{id}." expecting status done, got ".$req->status);
wait_request($req);
ok($req->status eq 'done', "[$vm_name] Req ".$req->{id}." expecting status done, got ".$req->status);
ok($req->error && $req->error =~ /unknown/i
,"Req ".$req->{id}." expecting unknown domain error , got "
,"[$vm_name] Req ".$req->{id}." expecting unknown domain error , got "
.($req->error or '<NULL>')) or return;
$req = undef;
#####################################################################3
#
# start
test_new_domain($name);
test_new_domain($vm_name, $name);
my $domain = $RAVADA->search_domain($name);
my $domain = $vm->search_domain($name);
ok(!$domain->is_active,"Domain $name should be inactive") or return;
my $req2 = Ravada::Request->start_domain(name => $name, uid => $USER->id);
my $req2 = Ravada::Request->start_domain(name => $name, uid => $USER->id
);
$RAVADA->process_requests();
ok($req2->status eq 'done');
wait_request($req2);
ok($req2->status eq 'done',"Expecting request status 'done' , got "
.$req2->status);
$domain->start($USER) if !$domain->is_active();
ok($domain->is_active);
my $domain2 = $RAVADA->search_domain($name);
my $domain2 = $vm->search_domain($name);
ok($domain2->is_active);
$req2 = undef;
......@@ -107,12 +118,14 @@ sub test_start {
my $req3 = Ravada::Request->shutdown_domain(name => $name, uid => $USER->id);
$RAVADA->process_requests();
ok($req3->status eq 'done');
wait_request($req3);
ok($req3->status eq 'done',"[$vm_name] expecting request done , got "
.$req3->status);
ok(!$req3->error,"Error shutting down domain $name , expecting ''. Got '".$req3->error);
ok(!$domain->is_active, "Domain $name should not be active");
my $domain3 = $RAVADA->search_domain($name);
my $domain3 = $vm->search_domain($name);
ok(!$domain3->is_active,"Domain $name should not be active");
return $domain3;
......@@ -127,28 +140,24 @@ remove_old_disks();
my $vmm;
eval {
$vmm = $RAVADA->search_vm('kvm');
@ARG_CREATE_DOM = ( id_iso => 1, vm => 'kvm', id_owner => $USER->id ) if $vmm;
for my $vm_name (qw(KVM Void)) {
$vmm = $RAVADA->search_vm($vm_name);
if (!$vmm) {
$vmm = $RAVADA->search_vm('lxc');
@ARG_CREATE_DOM = ( id_template => 1, vm => 'LXC', id_owner => $USER->id );
}
SKIP: {
my $msg = "SKIPPED: Virtual manager $vm_name not found";
diag($msg) if !$vmm;
skip($msg,10) if !$vmm;
} if $RAVADA;
diag("Testing VM $vm_name");
my $domain = test_start($vm_name);
SKIP: {
my $msg = "SKIPPED: No virtual managers found";
diag($msg) if !$vmm;
skip($msg,10) if !$vmm;
$domain->shutdown_now($USER) if $domain;
$domain->remove(user_admin()) if $domain;
};
}
remove_old_domains();
remove_old_disks();
my $domain = test_start();
remove_old_domains();
$domain->shutdown_now($USER) if $domain;
$domain->remove(user_admin()) if $domain;
};
remove_old_disks();
done_testing();
t/front/20_create_domain.t
View file @ 4b75c5bb
......@@ -86,7 +86,6 @@ for my $vm_name ('kvm','lxc') {
my $name = new_domain_name();
my $req = $RVD_FRONT->create_domain( name => $name