Merge branch 'main' into develop

lib/Ravada.pm

@@ -11,7 +11,7 @@ use DBIx::Connector;
 use File::Copy;
 use Hash::Util qw(lock_hash unlock_hash);
 use IPC::Run3 qw(run3);
-use JSON::XS;
+use Mojo::JSON qw( encode_json decode_json );
 use Moose;
 use POSIX qw(WNOHANG);
 use Proc::PID::File;
@@ -1447,17 +1447,18 @@ sub _add_grants($self) {
 
 sub _add_grant($self, $grant, $allowed, $description, $is_int = 0, $default_admin=1) {
     my $sth = $CONNECTOR->dbh->prepare(
-        "SELECT id, description FROM grant_types WHERE name=?"
+        "SELECT id, description,is_int FROM grant_types WHERE name=?"
     );
     $sth->execute($grant);
-    my ($id, $current_description) = $sth->fetchrow();
+    my ($id, $current_description, $current_int) = $sth->fetchrow();
     $sth->finish;
+    $current_int = 0 if !$current_int;
 
-    if ($id && $current_description ne $description) {
+    if ($id && ( $current_description ne $description || $current_int != $is_int) ) {
         my $sth = $CONNECTOR->dbh->prepare(
-            "UPDATE grant_types SET description = ? WHERE id = ?;"
+            "UPDATE grant_types SET description = ?,is_int=? WHERE id = ?;"
         );
-        $sth->execute($description, $id);
+        $sth->execute($description, $is_int, $id);
         $sth->finish;
     }
     return if $id;
@@ -3538,10 +3539,32 @@ sub _set_domain_changed($self, $request) {
     }
     return if !defined $id_domain;
 
+    my $sth_date = $CONNECTOR->dbh->prepare("SELECT date_changed FROM domains WHERE id=?");
+    $sth_date->execute($id_domain);
+    my ($date) = $sth_date->fetchrow();
+
     my $sth = $CONNECTOR->dbh->prepare("UPDATE domains set date_changed=CURRENT_TIMESTAMP"
         ." WHERE id=? ");
     $sth->execute($id_domain);
 
+    $sth_date->execute($id_domain);
+    my ($date2) = $sth_date->fetchrow();
+
+    if (defined $date && defined $date2 && $date2 eq $date) {
+        my ($n) = $date2 =~ /.*(\d\d)$/;
+        if (!defined $n) {
+            sleep 1;
+            $sth->execute($id_domain);
+        } else {
+            $n++;
+            $n=00 if $n>59;
+            $n = "0$n" if length($n)<2;
+            $date2 =~ s/(.*)(\d\d)$/$1$n/;
+            my $sth2 = $CONNECTOR->dbh->prepare("UPDATE domains set date_changed=?"
+                ." WHERE id=? ");
+            $sth2->execute($date2,$id_domain);
+        }
+    }
 }
 
 sub _cmd_manage_pools($self, $request) {
@@ -4420,8 +4443,8 @@ sub _cmd_set_driver {
 
 sub _cmd_refresh_storage($self, $request=undef) {
 
-    if ($request && ( my $id_recent = $request->done_recently(60))) {
-        die "Command ".$request->command." run recently by $id_recent.\n";
+    if ($request && ( my $recent = $request->done_recently(60))) {
+        die "Command ".$request->command." run recently by ".$recent->id."\n";
     }
     my $vm;
     if ($request && $request->defined_arg('id_vm')) {
@@ -4495,7 +4518,7 @@ sub _cmd_refresh_machine($self, $request) {
     $domain->client_status(1) if $is_active;
 
     Ravada::Request->refresh_machine_ports(id_domain => $domain->id, uid => $user->id
-        ,timeout => 60, retry => 20)
+        ,timeout => 60, retry => 10)
     if $is_active && $domain->ip;
 }
 
@@ -4535,8 +4558,8 @@ sub _cmd_domain_autostart($self, $request ) {
 
 sub _cmd_refresh_vms($self, $request=undef) {
 
-    if ($request && !$request->defined_arg('_force') && (my $id_recent = $request->done_recently(30))) {
-        die "Command ".$request->command." run recently by $id_recent.\n";
+    if ($request && !$request->defined_arg('_force') && (my $recent = $request->done_recently(30))) {
+        die "Command ".$request->command." run recently by ".$recent->id."\n";
     }
 
     $self->_refresh_disabled_nodes( $request );
@@ -5102,21 +5125,57 @@ sub _cmd_cleanup($self, $request) {
             $self->_clean_requests($cmd, $request,'done');
     }
 }
+sub _verify_connection($self, $domain) {
+    for ( 1 .. 60 ) {
+        my $status = $domain->client_status(1);
+        if ( $status && $status ne 'disconnected' ) {
+            return 1;
+        }
+    }
+    return 0;
+}
+
+sub _domain_just_started($self, $domain) {
+    my $sth = $CONNECTOR->dbh->prepare(
+       "SELECT id,command,args "
+        ." FROM requests "
+        ." WHERE start_time>? "
+        ." OR status <> 'done' "
+        ." OR start_time IS NULL "
+    );
+    my $start_time = time - 300;
+    $sth->execute($start_time);
+    while ( my ($id, $command, $args) = $sth->fetchrow ) {
+        next if $command !~ /create|clone|start|open/i;
+        my $args_h = decode_json($args);
+        return 1 if exists $args_h->{id_domain} && defined $args_h->{id_domain}
+        && $args_h->{id_domain} == $domain->id;
+        return 1 if exists $args_h->{name} && defined $args_h->{name}
+        && $args_h->{name} eq $domain->name;
+    }
+    return 0;
+}
 
 sub _shutdown_disconnected($self) {
     for my $dom ( $self->list_domains_data(status => 'active') ) {
         next if !$dom->{shutdown_disconnected};
         my $domain = Ravada::Domain->open($dom->{id}) or next;
         my $is_active = $domain->is_active;
-        my ($req_shutdown) = grep { $_->command eq 'shutdown' } $domain->list_requests(1);
+        my ($req_shutdown) = grep { $_->command eq 'shutdown'
+            && $_->defined_arg('check')
+            && $_->defined_arg('check') eq 'disconnected'
+        } $domain->list_requests(1);
+
         if ($is_active && $domain->client_status eq 'disconnected') {
+            next if $self->_domain_just_started($domain) || $self->_verify_connection($domain);
             next if $req_shutdown;
             Ravada::Request->shutdown_domain(
                 uid => Ravada::Utils::user_daemon->id
                 ,id_domain => $domain->id
                 ,at => time + 120
+                ,check => 'disconnected'
             );
-        } else {
+        } elsif ($req_shutdown) {
             $req_shutdown->status('done','Canceled') if $req_shutdown;
         }
     }
@@ -5362,8 +5421,8 @@ sub _user_is_admin($self, $id_user) {
 
 sub _enforce_limits_active($self, $request) {
     confess if !$request;
-    if (my $id_recent = $request->done_recently(30)) {
-        die "Command ".$request->command." run recently by $id_recent.\n";
+    if (my $recent = $request->done_recently(30)) {
+        die "Command ".$request->command." run recently by ".$recent->id."\n";
     }
     my $timeout = ($request->defined_arg('timeout') or 10);
     my $start_limit_default = $self->setting('/backend/start_limit');
@@ -5462,6 +5521,8 @@ sub _clean_volatile_machines($self, %args) {
 }
 
 sub _cmd_post_login($self, $request) {
+    my $user = Ravada::Auth::SQL->new(name => $request->args('user'));
+    $user->unshown_messages();
     $self->_post_login_locale($request);
 }
 
@@ -5503,7 +5564,8 @@ sub _cmd_open_exposed_ports($self, $request) {
     Ravada::Request->refresh_machine_ports(
         uid => $request->args('uid'),
         ,id_domain => $domain->id
-        ,retry => 100
+        ,retry => 20
+        ,timeout => 180
     );
 
 }

lib/Ravada/Auth/LDAP.pm

@@ -275,7 +275,7 @@ sub search_user {
     my $escape_username = 1;
     $escape_username = delete $args{escape_username} if exists $args{escape_username};
     my $filter_orig = delete $args{filter};
-    my $sizelimit = (delete $args{sizelimit} or 100);
+    my $sizelimit = (delete $args{sizelimit} or $$CONFIG->{ldap}->{size_limit} or 1000);
     my $timelimit = (delete $args{timelimit} or 60);
 
     confess "ERROR: Unknown fields ".Dumper(\%args) if keys %args;
@@ -419,7 +419,7 @@ sub search_group {
     my $mesg = $ldap ->search (
         filter => $filter
          ,base => $base
-         ,sizelimit => 100
+         ,sizelimit => ($$CONFIG->{ldap}->{size_limit} or 1000)
     );
     warn "LDAP retry ".$mesg->code." ".$mesg->error." [filter: $filter , base: $base]" if $retry > 1;
     if ($mesg->code == 4 ) {
@@ -463,10 +463,12 @@ sub search_group {
 sub search_group_members($cn, $retry = 0) {
     my $base = "ou=groups,"._dc_base();
     my $ldap = _init_ldap_admin();
+    my $sizelimit = ($$CONFIG->{ldap}->{size_limit} or 1000);
+
     my $mesg = $ldap ->search (
         filter => "memberuid=$cn"
          ,base => $base
-         ,sizelimit => 100
+         ,sizelimit => $sizelimit
     );
     if ( ($mesg->code == 1 || $mesg->code == 81) && $retry <3 ) {
         $LDAP_ADMIN = undef;
@@ -479,7 +481,7 @@ sub search_group_members($cn, $retry = 0) {
     $mesg = $ldap ->search (
         filter => "member=cn=$cn,"._dc_base()
          ,base => $base
-         ,sizelimit => 100
+         ,sizelimit => $sizelimit
     );
     my @entries2 = map { $_->get_value('cn') } $mesg->entries();
 

lib/Ravada/Auth/SQL.pm

@@ -953,7 +953,12 @@ sub list_all_permissions($self) {
         lock_hash(%$row);
         push @list,($row);
     }
-    return @list;
+    my @list2 = sort {
+        return -1 if $a->{name} eq 'start_many' && $b->{name} eq 'start_limit';
+        return +1 if $b->{name} eq 'start_many' && $a->{name} eq 'start_limit';
+        $a->{name} cmp $b->{name};
+    } @list;
+    return @list2;
 }
 
 sub grant_type($self, $permission) {

lib/Ravada/Domain.pm

@@ -2374,6 +2374,7 @@ sub is_locked {
         ."   AND command <> 'refresh_machine'"
         ."   AND command <> 'refresh_machine_ports'"
         ."   AND command <> 'screenshot'"
+        ."   AND command <> 'add_hardware'"
     );
     $sth->execute($self->id);
     my ($id, $at_time) = $sth->fetchrow;
@@ -2839,7 +2840,17 @@ sub _pre_shutdown {
 
     my $user = delete $arg{user};
     delete $arg{timeout};
-    delete $arg{request};
+    my $request = delete $arg{request};
+
+    if ($request && $request->defined_arg('check')) {
+        my $check = $request->defined_arg('check');
+        if ($check eq 'disconnected') {
+            die "Virtual machine reconnected"
+            if $self->client_status ne 'disconnected';
+        } elsif ($check) {
+            confess "Error: unknown shutdown check '$check'";
+        }
+    }
 
     confess "Unknown args ".join(",",sort keys %arg)
         if keys %arg;
@@ -3953,7 +3964,7 @@ sub _open_port($self, $user, $remote_ip, $local_ip, $local_port, $jump = 'ACCEPT
                         ,$local_ip, 'filter', $IPTABLES_CHAIN, $jump,
                         ,{'protocol' => 'tcp', 's_port' => 0, 'd_port' => $local_port});
 
-    $self->_vm->iptables(
+    $self->_vm->iptables_unique(
                 A => $IPTABLES_CHAIN
                 ,m => 'tcp'
                 ,p => 'tcp'

lib/Ravada/Request.pm

@@ -65,6 +65,7 @@ our %VALID_ARG = (
     ,remove_domain => $args_manage
     ,restore_domain => { id_domain => 1, uid => 1 }
     ,shutdown_domain => { name => 2, id_domain => 2, uid => 1, timeout => 2, at => 2
+                       , check => 2
                        , id_vm => 2 }
     ,force_shutdown_domain => { id_domain => 1, uid => 1, at => 2, id_vm => 2 }
     ,reboot_domain => { name => 2, id_domain => 2, uid => 1, timeout => 2, at => 2
@@ -103,7 +104,7 @@ our %VALID_ARG = (
     ,change_hardware => {uid => 1, id_domain => 1, hardware => 1, index => 2, data => 1 }
     ,enforce_limits => { timeout => 2, _force => 2 }
     ,refresh_machine => { id_domain => 1, uid => 1 }
-    ,refresh_machine_ports => { id_domain => 1, uid => 1 }
+    ,refresh_machine_ports => { id_domain => 1, uid => 1, timeout => 2 }
     ,rebase => { uid => 1, id_base => 1, id_domain => 1 }
     ,set_time => { uid => 1, id_domain => 1 }
     ,rsync_back => { uid => 1, id_domain => 1, id_node => 1 }
@@ -155,6 +156,8 @@ qw(
     remove_base_vm
     rsync_back
     cleanup
+    refresh_machine_ports
+    set_time
 );
 
 our $TIMEOUT_SHUTDOWN = 120;
@@ -194,14 +197,14 @@ our %COMMAND = (
         limit => 50
         ,priority => 4
         ,commands => ['shutdown','shutdown_now', 'manage_pools','enforce_limits', 'set_time'
-            ,'remove_domain'
+            ,'remove_domain','refresh_machine_ports'
         ]
     }
 
     ,important=> {
         limit => 20
         ,priority => 1
-        ,commands => ['clone','start','start_clones','shutdown_clones','create','open_iptables','list_network_interfaces','list_isos','ping_backend','refresh_machine']
+        ,commands => ['clone','start','start_clones','shutdown_clones','create','open_iptables','list_network_interfaces','list_isos','ping_backend','refresh_machine','open_exposed_ports']
     }
 );
 lock_hash %COMMAND;
@@ -816,10 +819,14 @@ sub _send_message {
 
     if (!$uid) {
         my $user = $self->defined_arg('user');
-        $uid = $user->id if $user;
+        if ( $user ) {
+            my $sth = $$CONNECTOR->dbh->prepare("SELECT id FROM users where name=?");
+            $sth->execute($user);
+            ($uid) = $sth->fetchrow;
+        }
     }
 
-    return if !$uid;
+    return if !$uid || $uid == Ravada::Utils::user_daemon->id;
 
     my $domain_name = $self->defined_arg('name');
     if (!$domain_name) {

lib/Ravada/VM.pm

@@ -827,7 +827,7 @@ sub _check_require_base {
         if keys %args;
 
     my $base = Ravada::Domain->open($id_base);
-    my %ignore_requests = map { $_ => 1 } qw(clone refresh_machine set_base_vm start_clones shutdown_clones shutdown force_shutdown);
+    my %ignore_requests = map { $_ => 1 } qw(clone refresh_machine set_base_vm start_clones shutdown_clones shutdown force_shutdown refresh_machine_ports);
     my @requests;
     for my $req ( $base->list_requests ) {
         push @requests,($req) if !$ignore_requests{$req->command};

lib/Ravada/Volume/QCOW2.pm

@@ -26,7 +26,7 @@ sub prepare_base($self) {
     confess $base_img if $base_img !~ /\.ro/;
 
     confess "Error: '$base_img' already exists" if -e $base_img;
-    confess if $file_img =~ /\.iso/i;
+    confess if $file_img =~ /\.iso$/i;
 
     my @cmd = _cmd_convert($file_img,$base_img);
 

t/35_request_start.t

@@ -101,6 +101,7 @@ sub test_start {
     {
         my $domain = $vm->search_domain($name);
         ok(!$domain->is_active,"Domain $name should be inactive") or return;
+        is(rvd_back->_domain_just_started($domain),0);
     }
     my $req2 = Ravada::Request->start_domain(name => $name, uid => $USER->id
         ,remote_ip => $remote_ip
@@ -123,6 +124,7 @@ sub test_start {
         my $domain2 = $vm->search_domain($name);
         ok($domain2->is_active);
         is($domain2->is_volatile,0);
+        is(rvd_back->_domain_just_started($domain),1);
     }
 
     $req2 = undef;

t/lib/Test/Ravada.pm

@@ -711,7 +711,7 @@ sub mojo_login( $t, $user, $pass ) {
     $t->ua->get($URL_LOGOUT);
 
     $t->post_ok('/login' => form => {login => $user, password => $pass});
-    like($t->tx->res->code(),qr/^(200|302)$/);
+    like($t->tx->res->code(),qr/^(200|302)$/) or die $t->tx->res->body;
     #    ->status_is(302);
 $MOJO_USER = $user;
     $MOJO_PASSWORD = $pass;
@@ -1324,6 +1324,7 @@ sub _clean_remote_nodes {
 sub clean_remote_node {
     my $node = shift;
 
+    start_node($node) if !$node->is_local();
     _remove_old_domains_vm($node);
     wait_request(debug => 0);
     _remove_old_disks($node);

t/vm/92_ports.t

@@ -138,21 +138,29 @@ sub test_start_after_hibernate($domain
     my $internal_net = $internal_ip;
     $internal_net =~ s{(.*)\.\d+$}{$1.0/24};
 
-    $domain->start(user => user_admin, remote_ip => $remote_ip);
+    my ($in,$out,$err);
+    run3(['iptables','-t','nat','-L','PREROUTING','-n'],\($in, $out, $err));
+    my @out = split /\n/,$out;
+    run3(['iptables','-L','FORWARD','-n'],\($in, $out, $err));
+    @out = split /\n/,$out;
+    Ravada::Request->start_domain(
+        uid => user_admin->id
+        ,id_domain => $domain->id
+        ,remote_ip => $remote_ip
+    );
 
     delete_request('enforce_limits');
-    wait_request(debug => 0);
+    wait_request(debug => 0, skip => 'enforce_limits');
 
-    my ($in,$out,$err);
     run3(['iptables','-t','nat','-L','PREROUTING','-n'],\($in, $out, $err));
     die $err if $err;
-    my @out = split /\n/,$out;
+    @out = split /\n/,$out;
     is(grep(/^DNAT.*$local_ip.*dpt:$public_port to:$internal_ip:$internal_port/,@out),1);
 
     run3(['iptables','-L','FORWARD','-n'],\($in, $out, $err));
     die $err if $err;
     @out = split /\n/,$out;
-    is(grep(m{^ACCEPT.*$internal_net\s+state NEW},@out),1) or die $out;
+    is(grep(m{^ACCEPT.*$internal_net\s+state NEW},@out),1) or die $domain->name."\n".$out;
 
     run3(['iptables','-L','FORWARD','-n'],\($in, $out, $err));
     die $err if $err;

templates/bootstrap/authors.html.ep

@@ -10,7 +10,7 @@
 <li>Dayyan O'Brien</li>
 <li>Dito Baskoro</li>
 <li>Eneko Romo</li>
-<li>Ergün Elvan Bilsel</li>
+<li>ergün elvan bilsel</li>
 <li>Fernando Verdugo</li>
 <li>Francesc Guasch</li>
 <li>Gabriel Silva</li>
@@ -28,9 +28,11 @@
 <li>Meike Hankewicz</li>
 <li>Nelo Tovar</li>
 <li>Pascal Scholz</li>
+<li>Paula Paez</li>
 <li>Raghav Mittal</li>
 <li>Robert-André Mauchin</li>
 <li>Roger Ferre</li>
+<li>Roberto P. Rubio</li>
 <li>Sandra Marsà</li>
 <li>Sanjiv Lobo</li>
 <li>Shobhit Srivastava</li>

templates/main/vm_ports.html.ep

@@ -38,9 +38,9 @@
     <div class="row" ng-repeat="port in showmachine.ports" style="margin-top: 10px">
          <div class="col-lg-2 mt-2">
             {{port.internal_port}}
-            <span ng-show="showmachine.is_active && !port.is_up"
+            <span ng-show="showmachine.is_active && !port.is_active"
                 class="badge badge-danger">down</span>
-            <span ng-show="showmachine.is_active && port.is_up"
+            <span ng-show="showmachine.is_active && port.is_active"
                 class="badge badge-info">up</span>
          </div>
         <div class="col-lg-2 mt-2">