diff --git a/bin/rvd_back.pl b/bin/rvd_back.pl index 9b2414b65..ee92cc9bd 100755 --- a/bin/rvd_back.pl +++ b/bin/rvd_back.pl @@ -141,6 +141,7 @@ sub do_start { my $t0 = time; $ravada->process_requests(); $ravada->process_long_requests(0,$NOFORK) if $NOFORK; + $ravada->enforce_limits(); sleep 1 if time - $t0 <1; } } diff --git a/lib/Ravada.pm b/lib/Ravada.pm index 7e884a8a2..96a424145 100644 --- a/lib/Ravada.pm +++ b/lib/Ravada.pm @@ -269,9 +269,9 @@ sub _update_isos { ,debian_stretch => { name =>'Debian Stretch 64 bits' ,description => 'Debian 9.0 Stretch 64 bits (XFCE desktop)' - ,url => 'http://cdimage.debian.org/cdimage/archive/9.1.0/amd64/iso-cd/' + ,url => 'https://cdimage.debian.org/debian-cd/9.1.0/amd64/iso-cd/' ,file_re => 'debian-9.[\d\.]+-amd64-xfce-CD-1.iso' - ,md5_url => 'http://cdimage.debian.org/cdimage/archive/9.1.0/amd64/iso-cd/MD5SUMS' + ,md5_url => 'https://cdimage.debian.org/debian-cd/9.1.0/amd64/iso-cd/MD5SUMS' ,xml => 'jessie-amd64.xml' ,xml_volume => 'jessie-volume.xml' } @@ -720,9 +720,11 @@ sub _upgrade_tables { $self->_upgrade_table('domains','spice_password','varchar(20) DEFAULT NULL'); $self->_upgrade_table('domains','description','text DEFAULT NULL'); $self->_upgrade_table('domains','run_timeout','int DEFAULT NULL'); + $self->_upgrade_table('domains','start_time','int DEFAULT 0'); $self->_upgrade_table('domains','is_volatile','int NOT NULL DEFAULT 0'); $self->_upgrade_table('domains_network','allowed','int not null default 1'); + } @@ -894,6 +896,7 @@ sub _create_vm { push @vms,($vm) if $vm; } die "No VMs found: $err\n" if $self->warn_error && !@vms; + return \@vms; } @@ -1071,13 +1074,36 @@ List all created domains my @list = $ravada->list_domains(); +This list can be filtered: + + my @active = $ravada->list_domains(active => 1); + my @inactive = $ravada->list_domains(active => 0); + + my @user_domains = $ravada->list_domains(user => $id_user); + + my @user_active = $ravada->list_domains(user => $id_user, active => 1); + =cut sub list_domains { my $self = shift; + my %args = @_; + + my $active = delete $args{active}; + my $user = delete $args{user}; + + die "ERROR: Unknown arguments ".join(",",sort keys %args) + if keys %args; + my @domains; for my $vm ($self->list_vms) { for my $domain ($vm->list_domains) { + next if defined $active && + ( $domain->is_active && !$active + || !$domain->is_active && $active ); + + next if $user && $domain->id_owner != $user->id; + push @domains,($domain); } } @@ -1449,9 +1475,9 @@ sub _execute { eval { $sub->($self,$request) }; my $err = ($@ or ''); - $request->error($err) if $err; $request->status('done') if $request->status() ne 'done' && $request->status !~ /retry/; + $request->error($err) if $err; return $err; } @@ -1850,7 +1876,7 @@ sub _cmd_shutdown { my $user = Ravada::Auth::SQL->search_by_id( $uid); - $domain->shutdown(timeout => $timeout, name => $name, user => $user + $domain->shutdown(timeout => $timeout, user => $user , request => $request); } @@ -1860,11 +1886,11 @@ sub _cmd_force_shutdown { my $request = shift; my $uid = $request->args('uid'); - my $name = $request->args('name'); + my $id_domain = $request->args('id_domain'); my $domain; - $domain = $self->search_domain($name); - die "Unknown domain '$name'\n" if !$domain; + $domain = $self->search_domain_by_id($id_domain); + die "Unknown domain '$id_domain'\n" if !$domain; my $user = Ravada::Auth::SQL->search_by_id( $uid); @@ -2040,6 +2066,56 @@ sub import_domain { return $vm->import_domain($name, $user); } +=head2 enforce_limits + +Check no user has passed the limits and take action. + +Some limits: + +- More than 1 domain running at a time ( older get shut down ) + + +=cut + +sub enforce_limits { + _enforce_limits_active(@_); +} + +sub _enforce_limits_active { + my $self = shift; + my %args = @_; + + my $timeout = (delete $args{timeout} or 10); + + confess "ERROR: Unknown arguments ".join(",",sort keys %args) + if keys %args; + + my %domains; + for my $domain ($self->list_domains( active => 1 )) { + push @{$domains{$domain->id_owner}},$domain; + } + for my $id_user(keys %domains) { + next if scalar @{$domains{$id_user}}<2; + + my @domains_user = sort { $a->start_time <=> $b->start_time } + @{$domains{$id_user}}; + +# my @list = map { $_->name => $_->start_time } @domains_user; + my $last = pop @domains_user; + DOMAIN: for my $domain (@domains_user) { + #TODO check the domain shutdown has been already requested + for my $request ($domain->list_requests) { + next DOMAIN if $request->command =~ /shutdown/; + } + if ($domain->can_hybernate) { + $domain->hybernate($USER_DAEMON); + } else { + $domain->shutdown(timeout => $timeout, user => $USER_DAEMON ); + } + } + } +} + =head2 version Returns the version of the module diff --git a/lib/Ravada/Domain.pm b/lib/Ravada/Domain.pm index a108f2661..302c3c70e 100644 --- a/lib/Ravada/Domain.pm +++ b/lib/Ravada/Domain.pm @@ -153,11 +153,9 @@ before 'resume' => \&_allow_manage; before 'shutdown' => \&_pre_shutdown; after 'shutdown' => \&_post_shutdown; -before 'shutdown_now' => \&_pre_shutdown_now; -after 'shutdown_now' => \&_post_shutdown_now; -before 'force_shutdown' => \&_pre_shutdown_now; -after 'force_shutdown' => \&_post_shutdown_now; +around 'shutdown_now' => \&_around_shutdown_now; +around 'force_shutdown' => \&_around_shutdown_now; before 'remove_base' => \&_pre_remove_base; after 'remove_base' => \&_post_remove_base; @@ -176,10 +174,14 @@ after '_select_domain_db' => \&_post_select_domain_db; sub BUILD { my $self = shift; - $self->_init_connector(); $self->is_known(); } +sub BUILD { + my $self = shift; + $self->_init_connector(); +} + sub _vm_connect { my $self = shift; $self->_vm->connect(); @@ -274,7 +276,7 @@ sub _allow_shutdown { } elsif($user->can_shutdown_all) { return; } else { - $self->_allowed($user); + $self->_allow_manage_args(user => $user); } } @@ -515,6 +517,18 @@ sub is_known { return $self->_select_domain_db(name => $self->name); } +=head2 start_time + +Returns the last time (epoch format in seconds) the +domain was started. + +=cut + +sub start_time { + my $self = shift; + return $self->_data('start_time'); +} + sub _select_domain_db { my $self = shift; my %args = @_; @@ -1080,14 +1094,21 @@ sub _post_pause { sub _pre_shutdown { my $self = shift; + my %arg = @_; + + my $user = delete $arg{user}; + delete $arg{timeout}; + delete $arg{request}; + + confess "Unknown args ".join(",",sort keys %arg) + if keys %arg; $self->_allow_shutdown(@_); $self->_pre_shutdown_domain(); if ($self->is_paused) { - my %args = @_; - $self->resume(user => $args{user}); + $self->resume(user => $user); } } @@ -1110,22 +1131,21 @@ sub _post_shutdown { } my $req = Ravada::Request->force_shutdown_domain( - name => $self->name + id_domain => $self->id , uid => $arg{user}->id , at => time+$timeout ); } } -sub _pre_shutdown_now { - my $self = shift; - return if !$self->is_active; -} - -sub _post_shutdown_now { +sub _around_shutdown_now { + my $orig = shift; my $self = shift; my $user = shift; + if ($self->is_active) { + $self->$orig($user); + } $self->_post_shutdown(user => $user); } @@ -1225,11 +1245,13 @@ sub _post_start { %arg = @_; } - if (scalar @_ % 2) { - $arg{user} = $_[0]; - } else { - %arg = @_; - } + my $sth = $$CONNECTOR->dbh->prepare( + "UPDATE domains set start_time=? " + ." WHERE id=?" + ); + $sth->execute(time, $self->id); + $sth->finish; + $self->_add_iptable(@_); if ($self->run_timeout) { @@ -1629,19 +1651,22 @@ sub remote_ip { =head2 list_requests -Returns a list of pending requests from the domain +Returns a list of pending requests from the domain. It won't show those requests +scheduled for later. =cut sub list_requests { my $self = shift; + my $all = shift; + my $sth = $$CONNECTOR->dbh->prepare( "SELECT * FROM requests WHERE id_domain = ? AND status <> 'done'" ); $sth->execute($self->id); my @list; while ( my $req_data = $sth->fetchrow_hashref ) { - next if $req_data->{at_time} && $req_data->{at_time} - time > 1; + next if !$all && $req_data->{at_time} && $req_data->{at_time} - time > 1; push @list,($req_data); } $sth->finish; @@ -1649,6 +1674,16 @@ sub list_requests { return map { Ravada::Request->open($_->{id}) } @list; } +=head2 list_all_requests + +Returns a list of pending requests from the domain including those scheduled for later + +=cut + +sub list_all_requests { + return list_requests(@_,'all'); +} + =head2 get_driver Returns the driver from a domain diff --git a/lib/Ravada/Domain/KVM.pm b/lib/Ravada/Domain/KVM.pm index f8cdf1047..47e439ab2 100644 --- a/lib/Ravada/Domain/KVM.pm +++ b/lib/Ravada/Domain/KVM.pm @@ -580,7 +580,7 @@ Shuts down uncleanly the domain sub force_shutdown{ my $self = shift; - $self->_do_force_shutdown(); + return $self->_do_force_shutdown() if $self->is_active; } sub _do_force_shutdown { diff --git a/lib/Ravada/Domain/Void.pm b/lib/Ravada/Domain/Void.pm index 1e99cc6b0..3dec17762 100644 --- a/lib/Ravada/Domain/Void.pm +++ b/lib/Ravada/Domain/Void.pm @@ -64,7 +64,6 @@ sub display { sub is_active { my $self = shift; - return ($self->_value('is_active') or 0); } diff --git a/lib/Ravada/Request.pm b/lib/Ravada/Request.pm index 76f7347af..a231f41cc 100644 --- a/lib/Ravada/Request.pm +++ b/lib/Ravada/Request.pm @@ -53,7 +53,7 @@ our %VALID_ARG = ( ,resume_domain => {%$args_manage, remote_ip => 1 } ,remove_domain => $args_manage ,shutdown_domain => { name => 2, id_domain => 2, uid => 1, timeout => 2, at => 2 } - ,force_shutdown_domain => { name => 1, uid => 1, at => 2 } + ,force_shutdown_domain => { id_domain => 1, uid => 1, at => 2 } ,screenshot_domain => { id_domain => 1, filename => 2 } ,start_domain => {%$args_manage, remote_ip => 1 } ,rename_domain => { uid => 1, name => 1, id_domain => 1} @@ -424,8 +424,13 @@ sub _new_request { $args{args}->{uid} = $args{args}->{id_owner} if !exists $args{args}->{uid}; $args{at_time} = $args{args}->{at} if exists $args{args}->{at}; - $args{id_domain} = $args{args}->{id_domain} - if exists $args{args}->{id_domain} && ! $args{id_domain}; + my $id_domain_args = $args{args}->{id_domain}; + + if ($id_domain_args) { + confess "ERROR: Different id_domain: ".Dumper(\%args) + if $args{id_domain} && $args{id_domain} ne $id_domain_args; + $args{id_domain} = $id_domain_args; + } $args{args} = encode_json($args{args}); } _init_connector() if !$CONNECTOR || !$$CONNECTOR; diff --git a/rvd_front.pl b/rvd_front.pl index 47b0c7560..994a47d56 100644 --- a/rvd_front.pl +++ b/rvd_front.pl @@ -1355,7 +1355,7 @@ sub manage_machine { return access_denied($c) if $domain->id_owner != $USER->id && !$USER->is_admin; - Ravada::Request->shutdown_domain(name => $domain->name, uid => $USER->id) if $c->param('shutdown'); + Ravada::Request->shutdown_domain(id_domain => $domain->id, uid => $USER->id) if $c->param('shutdown'); Ravada::Request->start_domain( uid => $USER->id ,name => $domain->name , remote_ip => _remote_ip($c) @@ -1387,7 +1387,7 @@ sub settings_machine { $c->stash(domain => $domain); $c->stash(USER => $USER); - my $req = Ravada::Request->shutdown_domain(name => $domain->name, uid => $USER->id) + my $req = Ravada::Request->shutdown_domain(id_domain => $domain->id, uid => $USER->id) if $c->param('shutdown') && $domain->is_active; $req = Ravada::Request->start_domain( @@ -1484,7 +1484,7 @@ sub shutdown_machine { return login($c) if !_logged_in($c); my ($domain, $type) = _search_requested_machine($c); - my $req = Ravada::Request->shutdown_domain(name => $domain->name, uid => $USER->id); + my $req = Ravada::Request->shutdown_domain(id_domain => $domain->id, uid => $USER->id); return $c->redirect_to('/machines') if $type eq 'html'; return $c->render(json => { req => $req->id }); diff --git a/sql/mysql/domains.sql b/sql/mysql/domains.sql index b475b96d0..8387e6893 100644 --- a/sql/mysql/domains.sql +++ b/sql/mysql/domains.sql @@ -14,6 +14,7 @@ CREATE TABLE `domains` ( `vm` char(120) NOT NULL, `spice_password` char(20) DEFAULT NULL, `description` text, + `start_time` int not null default 0, PRIMARY KEY (`id`), UNIQUE KEY `id_base` (`id_base`,`name`), UNIQUE KEY `name` (`name`) diff --git a/sql/sqlite/domains.sql b/sql/sqlite/domains.sql index 09318ce40..ebd194c32 100644 --- a/sql/sqlite/domains.sql +++ b/sql/sqlite/domains.sql @@ -13,7 +13,8 @@ CREATE TABLE `domains` ( , `id_owner` integer , `vm` char(120) NOT NULL , `spice_password` char(20) DEFAULT NULL -, `description` text DEFAULT NULL +, `description` text +, `start_time` integer not null default 0 , UNIQUE (`id_base`,`name`) , UNIQUE (`name`) ); diff --git a/t/35_request_start.t b/t/35_request_start.t index f82d7c6fe..c64a26903 100644 --- a/t/35_request_start.t +++ b/t/35_request_start.t @@ -111,8 +111,10 @@ sub test_start { ok($req2->status eq 'done',"Expecting request status 'done' , got " .$req2->status); + my $id_domain; { my $domain = $RAVADA->search_domain($name); + $id_domain = $domain->id; $domain->start($USER) if !$domain->is_active(); ok($domain->is_active); @@ -127,7 +129,7 @@ sub test_start { # # stop - my $req3 = Ravada::Request->force_shutdown_domain(name => $name, uid => $USER->id); + my $req3 = Ravada::Request->force_shutdown_domain(id_domain => $id_domain, uid => $USER->id); $RAVADA->process_requests(); wait_request($req3); ok($req3->status eq 'done',"[$vm_name] expecting request done , got " diff --git a/t/front/30_show_domain.t b/t/front/30_show_domain.t index 7188fafc0..b3377bfb3 100644 --- a/t/front/30_show_domain.t +++ b/t/front/30_show_domain.t @@ -115,7 +115,7 @@ sub test_shutdown_domain { ok($domain_f->is_active); - eval { $domain_f->shutdown( force => 1) }; + eval { $domain_f->shutdown( force => 1, user => user_admin) }; ok($@,"[$vm_name] Shutdown should be denied from front "); ok($domain_f->is_active,"[$vm_name] Domain should be active"); @@ -126,8 +126,8 @@ sub test_shutdown_domain { ok($@,"[$vm_name] Shutdown should be denied from front "); } - eval { $domain_b->shutdown(user => $USER,force => 1) }; - ok(!$@,$@); + eval { $domain_b->force_shutdown($USER) }; + is($@,''); ok(!$domain_f->is_active);# && !$domain_f->is_active); diff --git a/t/vm/20_base.t b/t/vm/20_base.t index 81c38ab12..9edc3782b 100644 --- a/t/vm/20_base.t +++ b/t/vm/20_base.t @@ -419,6 +419,93 @@ sub test_private_base { ok(!$clone2,"Expecting no clone"); } +sub test_domain_limit { + my $vm_name = shift; + + for my $domain ( rvd_back->list_domains()) { + $domain->shutdown_now(user_admin); + } + my $domain = create_domain($vm_name, $USER); + ok($domain,"Expecting a new domain created") or exit; + $domain->shutdown_now($USER) if $domain->is_active; + + is(rvd_back->list_domains(user => $USER, active => 1),0 + ,Dumper(rvd_back->list_domains())) or exit; + + $domain->start($USER); + is($domain->is_active,1); + + ok($domain->start_time <= time,"Expecting start time <= ".time + ." got ".time); + + sleep 1; + is(rvd_back->list_domains(user => $USER, active => 1),1); + + my $domain2 = create_domain($vm_name, $USER); + $domain2->shutdown_now($USER) if $domain2->is_active; + is(rvd_back->list_domains(user => $USER, active => 1),1); + + $domain2->start($USER); + rvd_back->enforce_limits(timeout => 2); + sleep 2; + rvd_back->_process_requests_dont_fork(); + my @list = rvd_back->list_domains(user => $USER, active => 1); + is(scalar @list,1) or die Dumper(\@list); + is($list[0]->name, $domain2->name) if $list[0]; +} + +sub test_domain_limit_already_requested { + my $vm_name = shift; + + for my $domain ( rvd_back->list_domains()) { + $domain->shutdown_now(user_admin); + } + my $domain = create_domain($vm_name, $USER); + ok($domain,"Expecting a new domain created") or return; + $domain->shutdown_now($USER) if $domain->is_active; + + is(rvd_back->list_domains(user => $USER, active => 1),0 + ,Dumper(rvd_back->list_domains())) or return; + + $domain->start($USER); + is($domain->is_active,1); + + ok($domain->start_time <= time,"Expecting start time <= ".time + ." got ".time); + + sleep 1; + is(rvd_back->list_domains(user => $USER, active => 1),1); + + my $domain2 = create_domain($vm_name, $USER); + $domain2->shutdown_now($USER) if $domain2->is_active; + is(rvd_back->list_domains(user => $USER, active => 1),1); + + $domain2->start($USER); + my @list_requests = $domain->list_requests; + is(scalar @list_requests,0,"Expecting 0 requests ".Dumper(\@list_requests)); + + rvd_back->enforce_limits(timeout => 2); + + if (!$domain->can_hybernate) { + @list_requests = $domain->list_all_requests(); + is(scalar @list_requests,1,"Expecting 1 request ".Dumper(\@list_requests)); + rvd_back->enforce_limits(timeout => 2); + @list_requests = $domain->list_all_requests(); + + is(scalar @list_requests,1,"Expecting 1 request ".Dumper(\@list_requests)); + + sleep 3; + + rvd_back->_process_requests_dont_fork(); + } + @list_requests = $domain->list_requests; + is(scalar @list_requests,0,"Expecting 0 request ".Dumper(\@list_requests)) or exit; + + my @list = rvd_back->list_domains(user => $USER, active => 1); + is(scalar @list,1) or die Dumper(\@list); + is($list[0]->name, $domain2->name) if $list[0]; +} + #######################################################################33 @@ -450,6 +537,8 @@ for my $vm_name ('Void','KVM') { use_ok($CLASS); + test_domain_limit_already_requested($vm_name); + my $domain = test_create_domain($vm_name); test_prepare_base($vm_name, $domain); test_prepare_base_active($vm_name); @@ -459,6 +548,8 @@ for my $vm_name ('Void','KVM') { test_private_base($vm_name); test_spinned_off_base($vm_name); + test_domain_limit($vm_name); + } } diff --git a/t/vm/70_clone.t b/t/vm/70_clone.t index b99402a61..a5f1eadab 100644 --- a/t/vm/70_clone.t +++ b/t/vm/70_clone.t @@ -71,7 +71,8 @@ sub test_clone { # diag("[$vm_name] Cloning from base ".$base->name." to $name_clone"); $base->is_public(1); eval { $clone1 = $base->clone(name => $name_clone, user => $USER) }; - ok(!$@,"Expecting error='', got='".($@ or '')."'"); + ok(!$@,"Expecting error='', got='".($@ or '')."'") + or die Dumper($base->list_requests); ok($clone1,"Expecting new cloned domain from ".$base->name) or return; is($clone1->description,undef); @@ -92,7 +93,7 @@ sub test_clone { sub test_mess_with_bases { my ($vm_name, $base, $clones) = @_; for my $clone (@$clones) { - $clone->shutdown(user => $USER, timeout => 1) if $clone->is_active; + $clone->force_shutdown($USER) if $clone->is_active; ok($clone->id_base,"Expecting clone has id_base , got " .($clone->id_base or '')); $clone->prepare_base($USER); @@ -104,14 +105,13 @@ sub test_mess_with_bases { ok(!$@,"Expecting error: '' , got: ".($@ or '')) or exit; ok($clone->is_active); - $clone->shutdown(user => $USER, timeout => 1) if $clone->is_active; + $clone->force_shutdown($USER) if $clone->is_active; $clone->remove_base($USER); eval { $clone->start($USER); }; ok(!$@,"[$vm_name] Expecting error: '' , got '".($@ or '')."'"); ok($clone->is_active); - $clone->shutdown(user => $USER, timeout => 1); - + $clone->force_shutdown($USER); } }