Merge pull request UPC#490 from UPC/315_active

315 active

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

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

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,26 +1651,39 @@ 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;
     return scalar @list if !wantarray;
     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

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 {

lib/Ravada/Domain/Void.pm

@@ -64,7 +64,6 @@ sub display {
 
 sub is_active {
     my $self = shift;
-
     return ($self->_value('is_active') or 0);
 }
 

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;