Refactor nodes (#1190)

refactor(backend): improved remote nodes response

* feature(CLI): run one request
* improve zombie management
* refactor(backend): check status only if requested
* refactor(backend): cache nodes storage
* install: add dependency for IO::Scalar

issue #1188

Makefile.PL

@@ -19,6 +19,7 @@ WriteMakefile(
       ,'XML::LibXML'=> 0
              ,'YAML' => 0
     ,'Image::Magick' => 0
+        ,'IO::Scalar' => 0
       ,'MooseX::Types::NetAddr::IP' => 0
 	,'IO::Interface' => 0
 	,'Sys::Statistics::Linux' => 0

bin/rvd_back.pl

@@ -48,6 +48,7 @@ my $HIBERNATE_DOMAIN;
 my $START_DOMAIN;
 my $SHUTDOWN_DOMAIN;
 my $REBASE;
+my $RUN_REQUEST;
 
 my $IMPORT_DOMAIN_OWNER;
 
@@ -116,6 +117,7 @@ GetOptions (       help => \$help
 ,'import-domain-owner=s' => \$IMPORT_DOMAIN_OWNER
 
     ,'add-locale-repository=s' => \$ADD_LOCALE_REPOSITORY
+    ,'run-request=s' => \$RUN_REQUEST
 ) or exit;
 
 $START = 1 if $DEBUG || $FILE_CONFIG || $NOFORK;
@@ -173,6 +175,8 @@ sub do_start {
         $ravada->process_long_requests();
         $ravada->process_requests();
 
+        exit if done_request();
+
         if ( time - $t_refresh > 60 ) {
             Ravada::Request->cleanup();
             Ravada::Request->refresh_vms()      if rand(5)<3;
@@ -185,6 +189,16 @@ sub do_start {
 
 }
 
+sub done_request {
+    return 0 if !$RUN_REQUEST;
+    my $req;
+    eval { $req = Ravada::Request->open($RUN_REQUEST) };
+    warn $req->status;
+    warn $@ if $@;
+    return 1 if !$req || $req->status eq 'done';
+
+}
+
 sub clean_old_requests {
     my $ravada = Ravada->new( %CONFIG );
     $ravada->clean_old_requests();
@@ -204,6 +218,7 @@ sub start {
     for (;;) {
         eval { do_start() };
         warn $@ if $@;
+        exit if done_request();
     }
 }
 

debian/control-debian-10

@@ -4,7 +4,7 @@ Architecture: all
 Section: utils
 Priority: optional
 Maintainer: Francesc Guasch <frankie@telecos.upc.edu>
-Depends: perl (>=5.18),libmojolicious-perl,mysql-common,libauthen-passphrase-perl, libdatetime-perl, libdbd-mysql-perl,libdbi-perl,libdbix-connector-perl,libipc-run3-perl,libnet-ldap-perl,libproc-pid-file-perl,libvirt-daemon-system,libsys-virt-perl,libxml-libxml-perl,libconfig-yaml-perl,libmoose-perl,libjson-xs-perl,qemu-utils,perlmagick,libmoosex-types-netaddr-ip-perl,libio-interface-perl,libiptables-chainmgr-perl,libnet-dns-perl,wget,liblocale-maketext-lexicon-perl,libmojolicious-plugin-i18n-perl,libdbd-sqlite3-perl, debconf (>= 0.2.26), adduser, libdigest-sha-perl, qemu-kvm, net-tools, libfile-rsync-perl, libnet-ssh2-perl, bridge-utils
+Depends: perl (>=5.18),libmojolicious-perl,mysql-common,libauthen-passphrase-perl, libdatetime-perl, libdbd-mysql-perl,libdbi-perl,libdbix-connector-perl,libipc-run3-perl,libio-stringy-perl,libnet-ldap-perl,libproc-pid-file-perl,libvirt-daemon-system,libsys-virt-perl,libxml-libxml-perl,libconfig-yaml-perl,libmoose-perl,libjson-xs-perl,qemu-utils,perlmagick,libmoosex-types-netaddr-ip-perl,libio-interface-perl,libiptables-chainmgr-perl,libnet-dns-perl,wget,liblocale-maketext-lexicon-perl,libmojolicious-plugin-i18n-perl,libdbd-sqlite3-perl, debconf (>= 0.2.26), adduser, libdigest-sha-perl, qemu-kvm, net-tools, libfile-rsync-perl, libnet-ssh2-perl, bridge-utils
 Description: Remote Virtual Desktops Manager
  Ravada is a software that allows the user to connect to a
  remote virtual desktop.

debian/control-ubuntu-18.04

@@ -4,7 +4,7 @@ Architecture: all
 Section: utils
 Priority: optional
 Maintainer: Francesc Guasch <frankie@telecos.upc.edu>
-Depends: perl (>=5.18),libmojolicious-perl,mysql-common,libauthen-passphrase-perl, libdatetime-perl, libdbd-mysql-perl,libdbi-perl,libdbix-connector-perl,libipc-run3-perl,libnet-ldap-perl,libproc-pid-file-perl,libvirt-bin,libvirt-daemon-system,libsys-virt-perl,libxml-libxml-perl,libconfig-yaml-perl,libmoose-perl,libjson-xs-perl,qemu-utils,perlmagick,libmoosex-types-netaddr-ip-perl,libio-interface-perl,libiptables-chainmgr-perl,libnet-dns-perl,wget,liblocale-maketext-lexicon-perl,libmojolicious-plugin-i18n-perl,libdbd-sqlite3-perl, debconf (>= 0.2.26), adduser, libdigest-sha-perl, qemu-kvm, net-tools, libfile-rsync-perl, libnet-ssh2-perl, bridge-utils
+Depends: perl (>=5.18),libmojolicious-perl,mysql-common,libauthen-passphrase-perl, libdatetime-perl, libdbd-mysql-perl,libdbi-perl,libdbix-connector-perl,libipc-run3-perl,libio-stringy-perl,libnet-ldap-perl,libproc-pid-file-perl,libvirt-bin,libvirt-daemon-system,libsys-virt-perl,libxml-libxml-perl,libconfig-yaml-perl,libmoose-perl,libjson-xs-perl,qemu-utils,perlmagick,libmoosex-types-netaddr-ip-perl,libio-interface-perl,libiptables-chainmgr-perl,libnet-dns-perl,wget,liblocale-maketext-lexicon-perl,libmojolicious-plugin-i18n-perl,libdbd-sqlite3-perl, debconf (>= 0.2.26), adduser, libdigest-sha-perl, qemu-kvm, net-tools, libfile-rsync-perl, libnet-ssh2-perl, bridge-utils
 Description: Remote Virtual Desktops Manager
  Ravada is a software that allows the user to connect to a
  remote virtual desktop.

debian/control-ubuntu-19.04

@@ -4,7 +4,7 @@ Architecture: all
 Section: utils
 Priority: optional
 Maintainer: Francesc Guasch <frankie@telecos.upc.edu>
-Depends: perl (>=5.18),libmojolicious-perl,mysql-common,libauthen-passphrase-perl, libdatetime-perl, libdbd-mysql-perl,libdbi-perl,libdbix-connector-perl,libipc-run3-perl,libnet-ldap-perl,libproc-pid-file-perl,libvirt-daemon-system,libsys-virt-perl,libxml-libxml-perl,libconfig-yaml-perl,libmoose-perl,libjson-xs-perl,qemu-utils,perlmagick,libmoosex-types-netaddr-ip-perl,libio-interface-perl,libiptables-chainmgr-perl,libnet-dns-perl,wget,liblocale-maketext-lexicon-perl,libmojolicious-plugin-i18n-perl,libdbd-sqlite3-perl, debconf (>= 0.2.26), adduser, libdigest-sha-perl, qemu-kvm, net-tools, libfile-rsync-perl, libnet-ssh2-perl, bridge-utils
+Depends: perl (>=5.18),libmojolicious-perl,mysql-common,libauthen-passphrase-perl, libdatetime-perl, libdbd-mysql-perl,libdbi-perl,libdbix-connector-perl,libipc-run3-perl,libio-stringy-perl,libnet-ldap-perl,libproc-pid-file-perl,libvirt-daemon-system,libsys-virt-perl,libxml-libxml-perl,libconfig-yaml-perl,libmoose-perl,libjson-xs-perl,qemu-utils,perlmagick,libmoosex-types-netaddr-ip-perl,libio-interface-perl,libiptables-chainmgr-perl,libnet-dns-perl,wget,liblocale-maketext-lexicon-perl,libmojolicious-plugin-i18n-perl,libdbd-sqlite3-perl, debconf (>= 0.2.26), adduser, libdigest-sha-perl, qemu-kvm, net-tools, libfile-rsync-perl, libnet-ssh2-perl, bridge-utils
 Description: Remote Virtual Desktops Manager
  Ravada is a software that allows the user to connect to a
  remote virtual desktop.

lib/Ravada.pm

@@ -2548,22 +2548,35 @@ sub _can_fork {
     warn $msg if $DEBUG;
 
     $req->error($msg);
+    $req->at_time(time+10);
     $req->status('waiting') if $req->status() !~ 'waiting';
     return 0;
 }
 sub _wait_pids {
     my $self = shift;
 
+    my @done;
     for my $type ( keys %{$self->{pids}} ) {
         for my $pid ( keys %{$self->{pids}->{$type}}) {
             my $kid = waitpid($pid , WNOHANG);
             last if $kid <= 0 ;
-            my $request = Ravada::Request->open($self->{pids}->{$type}->{$kid});
-            if ($request) {
-                $request->status('done') if $request->status =~ /working/i;
-            };
-            delete $self->{pids}->{$type}->{$kid};
+            push @done, ($kid);
+        }
+    }
+    return if !@done;
+    for my $pid (@done) {
+        my $id_req;
+        for my $type ( keys %{$self->{pids}} ) {
+            $id_req = $self->{pids}->{$type}->{$pid} if exists $self->{pids}->{$type}->{$pid};
+            next if !$id_req;
+            delete $self->{pids}->{$type}->{$pid};
+            last;
         }
+        next if !$id_req;
+        my $request = Ravada::Request->open($id_req);
+        if ($request) {
+            $request->status('done') if $request->status =~ /working/i;
+        };
     }
 }
 
@@ -3069,6 +3082,7 @@ sub _cmd_refresh_machine($self, $request) {
     my $id_domain = $request->args('id_domain');
     my $user = Ravada::Auth::SQL->search_by_id($request->args('uid'));
     my $domain = Ravada::Domain->open($id_domain) or confess "Error: domain $id_domain not found";
+    $domain->check_status();
     $domain->list_volumes_info();
     $domain->info($user);
     $self->_remove_unnecessary_downs($domain);
@@ -3295,6 +3309,7 @@ sub _refresh_disabled_nodes($self, $request = undef ) {
 }
 
 sub _refresh_active_domain($self, $domain, $active_domain) {
+    $domain->check_status();
     return if $domain->is_hibernated();
 
     my $is_active = $domain->is_active();

lib/Ravada/Domain.pm

@@ -1073,14 +1073,15 @@ sub open($class, @args) {
         $domain = $vm->search_domain($row->{name}, $force) or return;
         $domain->_data(id_vm => $vm->id);
     }
-    if (!$id_vm) {
-        $domain->_search_already_started() if !$domain->is_base;
-        $domain->_check_clean_shutdown()  if $domain->domain && !$domain->is_active;
-    }
     $domain->_insert_db_extra() if $domain && !$domain->is_known_extra();
     return $domain;
 }
 
+sub check_status($self) {
+    $self->_search_already_started()    if !$self->is_base;
+    $self->_check_clean_shutdown()      if $self->domain;
+}
+
 =head2 is_known
 
 Returns if the domain is known in Ravada.
@@ -1448,6 +1449,8 @@ sub _pre_remove_domain($self, $user, @) {
 
 }
 
+# check the node is active
+# search the domain in another node if it is not
 sub _check_active_node($self) {
     return $self->_vm if $self->_vm->is_active(1);
 
@@ -1455,7 +1458,9 @@ sub _check_active_node($self) {
         next if !$node->is_local;
 
         $self->_vm($node);
-        $self->domain($node->search_domain_by_id($self->id)->domain);
+        my $domain_active = $node->search_domain_by_id($self->id);
+        next if !$domain_active;
+        $self->domain($domain_active->domain);
         last;
     }
     return $self->_vm;
@@ -2015,7 +2020,6 @@ sub _pre_shutdown {
 
     $self->_allow_shutdown(@_);
 
-    $self->_vm->connect;
     $self->_pre_shutdown_domain();
 
     if ($self->is_paused) {
@@ -3469,6 +3473,7 @@ sub _pre_migrate($self, $node, $request = undef) {
 
     return if !$self->id_base;
 
+    $self->check_status();
     confess "ERROR: Active domains can't be migrated"   if $self->is_active;
 
     my $base = Ravada::Domain->open($self->id_base);

lib/Ravada/VM.pm

@@ -9,7 +9,7 @@ Ravada::VM - Virtual Managers library for Ravada
 
 =cut
 
-use Carp qw( carp croak cluck);
+use Carp qw( carp confess croak cluck);
 use Data::Dumper;
 use File::Path qw(make_path);
 use Hash::Util qw(lock_hash);
@@ -20,6 +20,7 @@ use Moose::Role;
 use Net::DNS;
 use Net::Ping;
 use Net::SSH2 qw(LIBSSH2_FLAG_SIGPIPE);
+use IO::Scalar;
 use IO::Socket;
 use IO::Interface;
 use Net::Domain qw(hostfqdn);
@@ -305,7 +306,6 @@ sub _connect_ssh($self, $disconnect=0) {
         warn $self->name." readonly, don't do ssh";
         return;
     }
-    return if !$self->ping();
 
     my @pwd = getpwuid($>);
     my $home = $pwd[7];
@@ -314,6 +314,7 @@ sub _connect_ssh($self, $disconnect=0) {
     $ssh = $SSH{$self->host}    if exists $SSH{$self->host};
 
     if (! $ssh || $disconnect ) {
+        return if !$self->ping();
         $ssh->disconnect if $ssh && $disconnect;
         $ssh = Net::SSH2->new( timeout => $SSH_TIMEOUT );
         my $connect;
@@ -1000,10 +1001,33 @@ sub ping($self, $option=undef) {
     confess "ERROR: option unknown" if defined $option && $option ne 'debug';
 
     return 1 if $self->is_local();
+
+    my $cache_key = "ping_".$self->host;
+    my $ping = $self->_get_cache($cache_key);
+    return $ping if defined $ping;
+
     my $debug = 0;
     $debug = 1 if defined $option && $option eq 'debug';
 
-    return $self->_do_ping($self->host, $debug);
+    $ping = $self->_do_ping($self->host, $debug);
+    $self->_set_cache($cache_key => $ping);
+    return $ping;
+}
+
+sub _set_cache($self, $key, $value) {
+    $key = "_cache_$key";
+    $self->{$key} = [ $value, time ];
+}
+
+sub _get_cache($self, $key, $timeout=30) {
+    $key = "_cache_$key";
+    return if !exists $self->{$key};
+    my ($value, $time) = @{$self->{$key}};
+    if ( time - $time > $timeout ) {
+        delete $self->{$key};
+        return ;
+    }
+    return $value;
 }
 
 sub _do_ping($self, $host, $debug=0) {
@@ -1202,9 +1226,14 @@ sub _write_file_local( $self, $file, $contents ) {
 sub read_file( $self, $file ) {
     return $self->_read_file_local($file) if $self->is_local;
 
-    my ($content, $err) = $self->run_command("cat $file");
-    confess $err if $err;
-    return $content;
+    my $ssh = ($self->{_ssh} or $self->_connect_ssh());
+    die "Error: no ssh connection to ".$self->name if ! $ssh;
+
+    my $data = '';
+    my $io = IO::Scalar->new(\$data);
+    my $ok = $ssh->scp_get($file, $io);
+
+    return $data;
 }
 
 sub _read_file_local( $self, $file ) {
@@ -1215,18 +1244,13 @@ sub _read_file_local( $self, $file ) {
 sub file_exists( $self, $file ) {
     return -e $file if $self->is_local;
 
-    # why should we force disconnect before ?
-    $self->_connect_ssh();
-    my ( $out, $err) = $self->run_command("/usr/bin/test",
-        "-e $file ; echo \$?");
-
-    chomp $out;
-    chomp $err;
+    my $ssh = ($self->{_ssh} or $self->_connect_ssh());
+    die "Error: no ssh connection to ".$self->name if ! $ssh;
 
-    warn $self->name." ".$err if $err;
+    my $io = IO::Scalar->new();
+    my $ok = $ssh->scp_get($file, $io);
 
-    return 1 if $out =~ /^0$/;
-    return 0;
+    return $ok;
 }
 
 sub remove_file( $self, $file ) {
@@ -1416,24 +1440,44 @@ sub shutdown_domains($self) {
     $sth->finish;
 }
 
+sub _shared_storage_cache($self, $node, $dir, $value=undef) {
+    if (!defined $value) {
+        my $sth = $$CONNECTOR->dbh->prepare(
+            "SELECT is_shared FROM storage_nodes "
+            ." WHERE dir= ? "
+            ." AND ((id_node1 = ? AND id_node2 = ? ) "
+            ."      OR (id_node2 = ? AND id_node1 = ? )) "
+        );
+        $sth->execute($dir, $self->id, $node->id, $node->id, $self->id);
+        my ($is_shared) = $sth->fetchrow;
+        return $is_shared;
+    }
+    my $sth = $$CONNECTOR->dbh->prepare(
+        "INSERT INTO storage_nodes (id_node1, id_node2, dir, is_shared) "
+        ." VALUES (?,?,?,?)"
+    );
+    $sth->execute($self->id, $node->id, $dir, $value);
+    return $value;
+}
+
 sub shared_storage($self, $node, $dir) {
+    $dir .= '/' if $dir !~ m{/$};
+    my $shared_cache = $self->_shared_storage_cache($node, $dir);
+    return $shared_cache if defined $shared_cache;
+
     return if !$node->is_active || !$self->is_active;
-    my $cached_st_key = "_cached_shared_storage_".$self->name.$node->name.$dir;
-    $cached_st_key =~ s{/}{_}g;
-    return $self->{$cached_st_key} if exists $self->{$cached_st_key};
 
-    $dir .= '/' if $dir !~ m{/$};
     my $file;
     for ( ;; ) {
         $file = $dir.Ravada::Utils::random_name(4).".tmp";
+        my $exists;
         eval {
-            next if $self->file_exists($file);
-            next if $node->file_exists($file);
+            $exists = $self->file_exists($file) || $node->file_exists($file);
         };
+        next if $exists;
         return if $@ && $@ =~ /onnect to SSH/i;
         last;
     }
-    $file = "$dir$cached_st_key";
     $self->write_file($file,''.localtime(time));
     confess if !$self->file_exists($file);
     my $shared;
@@ -1443,8 +1487,9 @@ sub shared_storage($self, $node, $dir) {
         sleep 1;
     }
     $self->remove_file($file);
+    $shared = 0 if !defined $shared;
+    $self->_shared_storage_cache($node, $dir, $shared);
 
-    $self->{$cached_st_key} = $shared;
     return $shared;
 }
 sub _fetch_tls_host_subject($self) {

sql/mysql/storage_nodes.sql

+create table storage_nodes (
+    `id` integer NOT NULL AUTO_INCREMENT,
+    `id_node1` integer NOT NULL,
+    `id_node2` integer NOT NULL,
+    `dir` varchar(255) NOT NULL,
+    `is_shared` integer NOT NULL DEFAULT 1,
+    PRIMARY KEY (`id`),
+    UNIQUE (`id_node1`,`id_node2`, `dir`)
+);
+
+

sql/sqlite/storage_nodes.sql

+create table storage_nodes (
+    `id` integer NOT NULL PRIMARY KEY AUTOINCREMENT
+,    `id_node1` integer NOT NULL
+,    `id_node2` integer NOT NULL
+,    `dir` varchar(255) NOT NULL
+,    `is_shared` integer NOT NULL DEFAULT 1
+,    UNIQUE (`id_node1`,`id_node2`, `dir`)
+);

t/kvm/n10_nodes.t

@@ -809,6 +809,7 @@ sub test_domain_already_started {
 
     { # clone is active, it should be found in node
     my $clone3 = rvd_back->search_domain($clone->name);
+    $clone3->check_status();
     is($clone3->id, $clone->id);
     is($clone3->_vm->host , $node->host,"Expecting ".$clone3->name
         ." in ".$node->host) or exit;
@@ -1016,6 +1017,11 @@ sub test_shutdown($node) {
     is($clone->is_active,0,"[".$clone->type."] Expecting clone ".$clone->name." inactive") or return;
     is($clone->_data('status'),'shutdown',"[".$clone->type."] Expecting clone ".$clone->name." data active") or return;
 
+    my $req = Ravada::Request->refresh_vms();
+    wait_request(debug => 1);
+    is($req->status,'done');
+    is($req->error,'');
+
     my $clone2 = Ravada::Domain->open($clone->id); #open will clean internal shutdown
     is($clone2->is_active,0) or exit;
 
@@ -1024,6 +1030,7 @@ sub test_shutdown($node) {
         my $md5_remote = _md5($file, $node);
         is($md5_remote, $md5);
     }
+    # this would eventualy be called on check_vms request
     my @line = search_iptable_remote(
         node => $node
         , remote_ip => $remote_ip