[#315] fixed list requests, added all_requests

lib/Ravada/Domain.pm

@@ -247,6 +247,39 @@ sub _allow_remove {
 
 }
 
+sub _allow_shutdown {
+    my $self = shift;
+    my %args = @_;
+
+    my $user = $args{user} || confess "ERROR: Missing user arg";
+
+    if ( $self->id_base() && $user->can_shutdown_clone()) {
+        my $base = $self->open($self->id_base);
+        return if $base->id_owner == $user->id;
+    } elsif($user->can_shutdown_all) {
+        return;
+    } else {
+        $self->_allow_manage_args(user => $user);
+    }
+}
+
+sub _around_add_volume {
+    my $orig = shift;
+    my $self = shift;
+    confess "ERROR in args ".Dumper(\@_)
+        if scalar @_ % 2;
+    my %args = @_;
+
+    my $path = $args{path};
+    if ( $path ) {
+        my $name = $args{name};
+        if (!$name) {
+            ($args{name}) = $path =~ m{.*/(.*)};
+        }
+    }
+    return $self->$orig(%args);
+}
+
 sub _pre_prepare_base {
     my $self = shift;
     my ($user, $request) = @_;
@@ -1018,7 +1051,7 @@ sub _post_pause {
 sub _pre_shutdown {
     my $self = shift;
 
-    $self->_allow_manage_args(@_);
+    $self->_allow_shutdown(@_);
 
     $self->_pre_shutdown_domain();
 
@@ -1488,18 +1521,22 @@ sub get_driver {}
 
 =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 ne 'done'"
     );
     $sth->execute($self->id);
     my @list;
     while ( my $req_data =  $sth->fetchrow_hashref ) {
+        next if !$all && $req_data->{at_time} && $req_data->{at_time} - time > 1;
         push @list,($req_data);
     }
     $sth->finish;
@@ -1507,6 +1544,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');
+}
+
 sub _dbh {
     my $self = shift;
     _init_connector() if !$CONNECTOR || !$$CONNECTOR;

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
 
 

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);