Skip to content

Commit

Permalink
[UPC#61] isolate VM connections so get garbage collected
Browse files Browse the repository at this point in the history
  • Loading branch information
frankiejol committed Nov 24, 2016
1 parent 6c96d6e commit cad5dda
Show file tree
Hide file tree
Showing 2 changed files with 98 additions and 68 deletions.
16 changes: 5 additions & 11 deletions t/lib/Test/Ravada.pm
Original file line number Diff line number Diff line change
Expand Up @@ -43,32 +43,27 @@ sub rvd_back {
init($connector,$config) if $connector;

my $rvd_back;
eval { $rvd_back = Ravada->new(
return Ravada->new(
connector => $CONNECTOR
, config => ( $CONFIG or $DEFAULT_CONFIG)
);
};
die $@ if $@;
return $rvd_back;
);
}

sub rvd_front {
my $rvd_front;

eval { $rvd_front = Ravada::Front->new(
return Ravada::Front->new(
connector => $CONNECTOR
, config => ( $CONFIG or $DEFAULT_CONFIG)
);
};
die $@ if $@;
return $rvd_front;
);
}

sub init {
($CONNECTOR,$CONFIG) = @_;

confess "Missing connector : init(\$connector,\$config)" if !$CONNECTOR;

$Ravada::CONNECTOR = $CONNECTOR if !$Ravada::CONNECTOR;
Ravada::Auth::SQL::_init_connector($CONNECTOR);
$USER_ADMIN = create_user('admin','admin',1);

Expand All @@ -93,7 +88,6 @@ sub _remove_old_domains_vm {
my @domains;
eval { @domains = $vm->list_domains() };


for my $dom_name ( sort { $b cmp $a } @domains) {
next if $dom_name !~ /^$base_name/i;

Expand Down
150 changes: 93 additions & 57 deletions t/request/40_base.t
Original file line number Diff line number Diff line change
@@ -1,7 +1,7 @@
use warnings;
use strict;

use Carp qw(carp confess);
use Carp qw(carp confess cluck);
use Data::Dumper;
use POSIX qw(WNOHANG);
use Test::More;
Expand Down Expand Up @@ -49,7 +49,6 @@ sub test_req_create_domain_iso {
my $vm_name = shift;

my $name = new_domain_name();
diag("Requesting create domain $name");

$USER->mark_all_messages_read();
test_unread_messages($USER,0, "[$vm_name] create domain $name");
Expand Down Expand Up @@ -133,10 +132,8 @@ sub test_req_create_domain {
,"Status of request is ".$req->status." it should be done");
ok(!$req->error,"Error '".$req->error."' creating domain ".$name);

diag("search domain $name");
my $rvd_front = rvd_front();
my $domain = $rvd_front->search_domain($name);
diag("found domain $name");

ok($domain,"Searching for domain $name") or return;
ok($domain->name eq $name,"Expecting domain name '$name', got ".$domain->name);
Expand All @@ -149,8 +146,6 @@ sub test_req_prepare_base {
my $vm_name = shift;
my $name = shift;

diag("prepare base $name");

my $rvd_back = rvd_back();
my $req;
{
Expand All @@ -172,41 +167,46 @@ sub test_req_prepare_base {
$rvd_back->process_requests();
wait_request($req);
ok(!$req->error,"Expecting error='', got '".($req->error or '')."'");
$rvd_back = undef;

my $vm = rvd_front()->search_vm($vm_name);
my $domain2 = $vm->search_domain($name);
ok($domain2->is_base, "Expecting domain base=1 , got: '".$domain2->is_base."'") or exit;
ok($domain2->is_base, "Expecting domain base=1 , got: '".$domain2->is_base."'");# or exit;

}

sub test_req_create_from_base {
my $vm_name = shift;
my $base_name = shift;

my $clone_name = new_domain_name();
my $id_base;
{
my $rvd_back = rvd_back();
my $vm = $rvd_back->search_vm($vm_name);
my $domain_base = $vm->search_domain($base_name);
$id_base = $domain_base->id
}

diag("create from base");

my $clone_name = new_domain_name();

my $req = Ravada::Request->create_domain(
name => $clone_name
, vm => $vm_name
, id_base => $domain_base->id
, id_owner => $USER->id
);
ok($req->status eq 'requested'
,"Status of request is ".$req->status." it should be requested");

$rvd_back->process_requests();
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 ".$clone_name);

{
my $req = Ravada::Request->create_domain(
name => $clone_name
, vm => $vm_name
, id_base => $id_base
, id_owner => $USER->id
);
ok($req->status eq 'requested'
,"Status of request is ".$req->status." it should be requested");


rvd_back->process_requests();
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 ".$clone_name);

}
my $domain = rvd_front()->search_domain($clone_name);

ok($domain,"Searching for domain $clone_name") or return;
Expand All @@ -228,8 +228,6 @@ sub test_volumes {
my $domain1 = $vm->search_domain($domain1_name);
my $domain2 = $vm->search_domain($domain2_name);

diag("test volumes");

my @volumes1 = $domain1->list_volumes();
my @volumes2 = $domain2->list_volumes();

Expand Down Expand Up @@ -259,30 +257,36 @@ sub check_files_removed {
}


sub test_req_remove_base {
sub test_req_remove_base_fail {
my ($vm_name, $name_base, $name_clone) = @_;

my $rvd_back = rvd_back();
my $vm = $rvd_back->search_vm($vm_name);

my $domain_base = $vm->search_domain($name_base);
my $domain_clone= $vm->search_domain($name_clone);

diag("remove base");

ok($domain_base->is_base,"[$vm_name] expecting domain ".$domain_base->id
." is base , got ".$domain_base->is_base) or return;

my @files_base = $domain_base->list_files_base();
ok(scalar @files_base,"Expecting files base, got none") or return;

my @files_base;
my $req;

my $req = Ravada::Request->remove_base(id_domain => $domain_base->id
, uid => $USER->id
);
{
my $rvd_back = rvd_back();
my $vm = $rvd_back->search_vm($vm_name);

my $domain_base = $vm->search_domain($name_base);
my $domain_clone= $vm->search_domain($name_clone);

ok($domain_base->is_base,"[$vm_name] expecting domain ".$domain_base->id
." is base , got ".$domain_base->is_base) or return;

@files_base = $domain_base->list_files_base();
ok(scalar @files_base,"Expecting files base, got none") or return;

$domain_base->_vm->disconnect();
$domain_clone->_vm->disconnect();

$req = Ravada::Request->remove_base(
domain => $domain_base
, uid => $USER->id
);
}

ok($req->status eq 'requested');
$rvd_back->process_requests();
ok($req->status eq 'requested' || $req->status eq 'done');
rvd_back->process_requests();
wait_request($req);

ok($req->status eq 'done', "Expected req->status 'done', got "
Expand All @@ -292,22 +296,50 @@ sub test_req_remove_base {
.", got : '".$req->error."'");

check_files_exist(@files_base);
$domain_clone->remove($USER);
check_files_exist(@files_base);

$req->status('requested');
}

$rvd_back->process_requests();
wait_request($req);
sub test_req_remove_base {
my ($vm_name, $name_base, $name_clone) = @_;

my @files_base;
my $req;

{
my $rvd_back = rvd_back();
my $vm = $rvd_back->search_vm($vm_name);

my $domain_base = $vm->search_domain($name_base);
my $domain_clone= $vm->search_domain($name_clone);
@files_base = $domain_base->list_files_base();

$domain_clone->remove($USER);
check_files_exist(@files_base);
ok(!$domain_clone->is_base());

$domain_base->_vm->disconnect();
$domain_clone->_vm->disconnect();
$req = Ravada::Request->remove_base(
domain => $domain_base
, uid => $USER->id
);
}

{
my $rvd_back = rvd_back();
rvd_back->process_requests();
wait_request($req);
}
ok($req->status eq 'done', "[$vm_name] Expected req->status 'done', got "
."'".$req->status."'");

ok(!$req->error, "Expected error ''"
.", got : '".$req->error."'");

ok(!$domain_base->is_base());
ok(!$domain_clone->is_base());
{
my $domain_base = rvd_front->search_vm('KVM')->search_domain($name_base);
ok(!$domain_base->is_base());
}
check_files_removed(@files_base);
}

Expand All @@ -318,10 +350,12 @@ my $rvd_back = rvd_back();
ok($rvd_back,"Launch Ravada");# or exit;
}

ok($Ravada::CONNECTOR,"Expecting conector, got ".($Ravada::CONNECTOR or '<unde>'));

remove_old_domains();
remove_old_disks();

for my $vm_name ( qw(KVM Void)) {
for my $vm_name ( qw(KVM)) {
my $vm_connected;
eval {
my $rvd_back = rvd_back();
Expand All @@ -347,6 +381,7 @@ for my $vm_name ( qw(KVM Void)) {

test_volumes($vm_name,$base_name, $clone_name);

test_req_remove_base_fail($vm_name, $base_name, $clone_name);
test_req_remove_base($vm_name, $base_name, $clone_name);

};
Expand All @@ -356,3 +391,4 @@ remove_old_domains();
remove_old_disks();

done_testing();

0 comments on commit cad5dda

Please sign in to comment.