Fix ports expose (#1142)

* test(networking): flush and check FORWARD table
* fix(networking): open forward chain when exposing ports
* fix(frontend): allow ports beyond 99

issue #1134 

lib/Ravada.pm

@@ -1213,6 +1213,7 @@ sub _upgrade_tables {
 
     $self->_upgrade_table('requests','at_time','int(11) DEFAULT NULL');
     $self->_upgrade_table('requests','run_time','float DEFAULT NULL');
+    $self->_upgrade_table('requests','retry','int(11) DEFAULT NULL');
 
     $self->_upgrade_table('iso_images','rename_file','varchar(80) DEFAULT NULL');
     $self->_clean_iso_mini();
@@ -2084,7 +2085,7 @@ sub process_requests {
     for my $req (sort { $a->priority <=> $b->priority } @reqs) {
         next if $req eq 'refresh_vms' && scalar@reqs > 2;
 
-        warn "[$request_type] $$ executing request ".$req->id." ".$req->status()." "
+        warn "[$request_type] $$ executing request ".$req->id." ".$req->status()." retry=".($req->retry or '<UNDEF>')." "
             .$req->command
             ." ".Dumper($req->args) if $DEBUG || $debug;
 
@@ -2311,20 +2312,11 @@ sub _execute {
         return;
     }
 
-    $request->pid($$);
     $request->start_time(time);
     $request->error('');
+        $request->status('working','');
     if ($dont_fork || !$CAN_FORK) {
-
-        my $t0 = [gettimeofday];
-        eval { $sub->($self,$request) };
-        my $err = ($@ or '');
-        my $elapsed = tv_interval($t0,[gettimeofday]);
-        $request->run_time($elapsed);
-        $request->status('done') if $request->status() ne 'done'
-                                    && $request->status !~ /retry/;
-        $request->error($err) if $err;
-        warn $err if $err;
+        $self->_do_execute_command($sub, $request);
         return;
     }
 
@@ -2335,12 +2327,7 @@ sub _execute {
     die "I can't fork" if !defined $pid;
 
     if ( $pid == 0 ) {
-        $request->status('working','');
-        my $t0 = [gettimeofday];
-        srand();
         $self->_do_execute_command($sub, $request);
-        my $elapsed = tv_interval($t0,[gettimeofday]);
-        $request->run_time($elapsed) if !$request->run_time();
         exit;
     }
     $self->_add_pid($pid, $request);
@@ -2360,6 +2347,7 @@ sub _do_execute_command {
 #        local *STDERR = $f_err;
 #    }
 
+    $request->pid($$);
     my $t0 = [gettimeofday];
     eval {
         $sub->($self,$request);
@@ -2368,10 +2356,22 @@ sub _do_execute_command {
     my $elapsed = tv_interval($t0,[gettimeofday]);
     $request->run_time($elapsed);
     $request->error($err)   if $err;
+    if ($err && $err =~ /retry.?$/i) {
+        my $retry = $request->retry;
+        if (defined $retry && $retry>0) {
+            $request->status('requested');
+            $request->at(time + 10);
+            $request->retry($retry-1);
+        } else {
+            $request->status('done');
+            $err =~ s/(.*?)retry.?/$1/i;
+            $request->error($err)   if $err;
+        }
+    } else {
     $request->status('done')
         if $request->status() ne 'done'
             && $request->status() !~ /^retry/i;
-
+    }
 }
 
 sub _cmd_manage_pools($self, $request) {

lib/Ravada/Domain.pm

@@ -1966,6 +1966,7 @@ sub _post_pause {
 sub _post_hibernate($self, $user) {
     $self->_data(status => 'hibernated');
     $self->_remove_iptables();
+    $self->_close_exposed_port();
 }
 
 sub _pre_shutdown {
@@ -2251,7 +2252,7 @@ sub _add_expose($self, $internal_port, $name, $restricted) {
     );
     $sth->finish;
 
-    $self->_open_exposed_port($internal_port, $restricted) if $self->is_active;
+    $self->_open_exposed_port($internal_port, $restricted) if $self->is_active && $self->ip;
     return $public_port;
 }
 
@@ -2274,28 +2275,44 @@ sub _open_exposed_port($self, $internal_port, $restricted) {
     confess "Error: I can't get the internal IP of ".$self->name
         if !$internal_ip || $internal_ip !~ /^(\d+\.\d+)/;
 
-    $self->_vm->iptables(
-                t => 'nat'
-                ,A => 'PREROUTING'
-                ,p => 'tcp'
-                ,d => $local_ip
-                ,dport => $public_port
-                ,j => 'DNAT'
-                ,'to-destination' => "$internal_ip:$internal_port"
-    ) if !$>;
-
-    if ($restricted) {
-        $self->_open_exposed_port_client($public_port);
+    if ( !$> ) {
+        $self->_vm->iptables_unique(
+            t => 'nat'
+            ,A => 'PREROUTING'
+            ,p => 'tcp'
+            ,d => $local_ip
+            ,dport => $public_port
+            ,j => 'DNAT'
+            ,'to-destination' => "$internal_ip:$internal_port"
+        ) if !$>;
+
+        if ($restricted) {
+            $self->_open_exposed_port_client($public_port);
+        }
+        $self->_open_iptables_state();
     }
 }
 
+sub _open_iptables_state($self) {
+    my $local_net = $self->ip;
+    $local_net =~ s{(.*)\.\d+}{$1.0/24};
+
+    $self->_vm->iptables_unique(
+        I => 'FORWARD'
+        ,m => 'state'
+        ,d => $local_net
+        ,state => 'NEW,RELATED,ESTABLISHED'
+        ,j => 'ACCEPT'
+    );
+}
+
 sub _open_exposed_port_client($self, $public_port) {
     my $remote_ip = $self->remote_ip;
     return if !$remote_ip;
 
     my $local_ip = $self->_vm->ip;
 
-    $self->_vm->iptables(
+    $self->_vm->iptables_unique(
         A => $IPTABLES_CHAIN
         ,s => $remote_ip
         ,d => $local_ip
@@ -2304,7 +2321,7 @@ sub _open_exposed_port_client($self, $public_port) {
         ,dport => $public_port
         ,j => 'ACCEPT'
     );
-    $self->_vm->iptables(
+    $self->_vm->iptables_unique(
         A => $IPTABLES_CHAIN
         ,d => $local_ip
         ,m => 'tcp'
@@ -2319,12 +2336,7 @@ sub open_exposed_ports($self) {
     return if !@ports;
 
     if ( ! $self->ip ) {
-        Ravada::Request->open_exposed_ports(
-            uid => Ravada::Utils::user_daemon->id
-            ,id_domain => $self->id
-            ,at => time + 10
-        );
-        return;
+        die "Error: No ip in domain. Retry.\n";
     }
 
     for my $expose ( @ports ) {
@@ -2356,6 +2368,10 @@ sub _close_exposed_port($self,$internal_port_req=undef) {
     $self->_close_exposed_port_nat($iptables, %port);
     $self->_close_exposed_port_client($iptables, %port);
 
+    $sth = $$CONNECTOR->dbh->prepare("DELETE FROM requests WHERE id_domain=? "
+            ." AND command='open_exposed_ports'");
+    $sth->execute($self->id);
+    $sth->finish;
 }
 
 sub _close_exposed_port_client($self, $iptables, %port) {
@@ -2544,6 +2560,7 @@ sub _post_start {
     } else {
         %arg = @_;
     }
+    my $remote_ip = $arg{remote_ip};
 
     $self->_data('status','active') if $self->is_active();
     my $sth = $$CONNECTOR->dbh->prepare(
@@ -2557,6 +2574,11 @@ sub _post_start {
 
     $self->_add_iptable(@_);
     $self->_update_id_vm();
+    Ravada::Request->open_exposed_ports(
+            uid => Ravada::Utils::user_daemon->id
+            ,id_domain => $self->id
+            ,retry => 5
+    ) if $remote_ip && $self->list_ports();
 
     if ($self->run_timeout) {
         my $req = Ravada::Request->shutdown_domain(
@@ -2577,7 +2599,6 @@ sub _post_start {
         $self->display_file($arg{user});
         $self->info($arg{user});
     }
-    $self->open_exposed_ports();
     Ravada::Request->enforce_limits(at => time + 60);
     Ravada::Request->manage_pools(
             uid => Ravada::Utils::user_daemon->id
@@ -4112,13 +4133,11 @@ sub rebase_volumes($self, $new_base) {
     my @files_target = $new_base->list_files_base_target();
     my %file_target = map { $_->[1] => $_->[0] } @files_target;
 
-    warn "rebasing ".$self->name."\n";
     for my $vol ( $self->list_volumes_info) {
-        next if $vol->{device} ne 'disk';
-        my $new_base = $file_target{$vol->{target}};
+        next if $vol->info->{device} ne 'disk';
+        my $new_base = $file_target{$vol->info->{target}};
         die "I can't find new base file for ".Dumper($vol) if !$new_base;
-        warn "$vol->{file}\n$new_base\n";
-        my @cmd = ('/usr/bin/qemu-img','rebase','-b',$new_base,$vol->{file});
+        my @cmd = ('/usr/bin/qemu-img','rebase','-b',$new_base,$vol->file);
         my ($out, $err) = $self->_vm->run_command(@cmd);
     }
     $self->id_base($new_base->id);

lib/Ravada/Request.pm

@@ -412,7 +412,7 @@ sub _check_args {
     my $args = { @_ };
 
     my $valid_args = $VALID_ARG{$sub};
-    for (qw(at after_request)) {
+    for (qw(at after_request retry)) {
         $valid_args->{$_}=2 if !exists $valid_args->{$_};
     }
 
@@ -540,6 +540,8 @@ sub _new_request {
             $args{id_domain} = $id_domain_args;
             $args{after_request} = delete $args{args}->{after_request}
                 if exists $args{args}->{after_request};
+            $args{retry} = delete $args{args}->{retry}
+                if exists $args{args}->{retry};
 
         }
         $args{args} = encode_json($args{args});
@@ -641,6 +643,12 @@ sub status {
     return $status;
 }
 
+sub at($self, $value) {
+    my $sth = $$CONNECTOR->dbh->prepare("UPDATE requests set at_time=? "
+            ." WHERE id=?");
+    $sth->execute($value, $self->{id});
+}
+
 sub _search_domain_name {
     my $self = shift;
     my $domain_id = shift;

lib/Ravada/VM.pm

@@ -1261,6 +1261,38 @@ sub iptables($self, @args) {
     warn $err if $err;
 }
 
+sub iptables_unique($self,@rule) {
+    return if $self->search_iptables(@rule);
+    return $self->iptables(@rule);
+}
+
+sub search_iptables($self, %rule) {
+    my $table = 'filter';
+    $table = delete $rule{t} if exists $rule{t};
+    my $iptables = $self->iptables_list();
+
+    if (exists $rule{I}) {
+        $rule{A} = delete $rule{I};
+    }
+    $rule{m} = $rule{p} if exists $rule{p} && !exists $rule{m};
+    $rule{d} = "$rule{d}/32" if exists $rule{d} && $rule{d} !~ m{/\d+$};
+    $rule{s} = "$rule{s}/32" if exists $rule{s} && $rule{s} !~ m{/\d+$};
+
+    for my $line (@{$iptables->{$table}}) {
+
+        my %args = @$line;
+        my $match = 1;
+        for my $key (keys %rule) {
+            $match = 0 if !exists $args{$key} || $args{$key} ne $rule{$key};
+            last if !$match;
+        }
+        if ( $match ) {
+            return 1;
+        }
+    }
+    return 0;
+}
+
 sub iptables_list($self) {
 #   Extracted from Rex::Commands::Iptables
 #   (c) Jan Gehring <jan.gehring@gmail.com>

lib/Ravada/VM/KVM.pm

@@ -535,7 +535,7 @@ sub create_domain {
 
     croak "argument name required"       if !$args{name};
     croak "argument id_owner required"   if !$args{id_owner};
-    croak "argument id_iso or id_base required ".Dumper(\%args)
+    confess "argument id_iso or id_base required ".Dumper(\%args)
         if !$args{id_iso} && !$args{id_base};
 
     my $domain;

lib/Ravada/VM/Void.pm

@@ -294,8 +294,18 @@ sub search_volume_path_re {
 
 }
 
-sub import_domain {
-    confess "Not implemented";
+sub import_domain($self, $name, $user) {
+
+    my $file = $self->dir_img."/$name.yml";
+
+    die "Error: domain $name not found in ".$self->dir_img if !-e $file;
+
+    return Ravada::Domain::Void->new(
+        domain => $file
+        ,name => $name
+        ,_vm => $self
+    );
+
 }
 
 sub refresh_storage {}

rvd_front.pl

@@ -1580,11 +1580,16 @@ sub provision_req($c, $id_base, $name, $ram=0, $disk=0) {
         if ( $domain->id_owner == $USER->id
                 && $domain->id_base == $id_base && !$domain->is_base ) {
             if ($domain->is_active) {
-                return Ravada::Request->open_iptables(
+                Ravada::Request->open_iptables(
                     uid => $USER->id
                 , id_domain => $domain->id
                 , remote_ip => _remote_ip($c)
                 );
+
+                 Ravada::Request->open_exposed_ports(
+                    uid => $USER->id
+                , id_domain => $domain->id
+                );
             }
             return Ravada::Request->start_domain(
                 uid => $USER->id

t/kvm/40_import.t

@@ -12,7 +12,7 @@ use_ok('Ravada');
 my $RVD_BACK = rvd_back();
 my $RVD_FRONT= rvd_front();
 
-my @VMS = ('KVM');
+my @VMS = ('KVM','Void');
 my $USER = create_user("foo","bar", 1);
 
 #############################################################################
@@ -90,8 +90,9 @@ sub test_import {
 
 sub test_import_spinoff {
     my $vm_name = shift;
+    return if $vm_name eq 'Void';
 
-    my $vm = rvd_back->search_vm('kvm');
+    my $vm = rvd_back->search_vm($vm_name);
     my $domain = test_create_domain($vm_name,$vm);
     $domain->is_public(1);
     my $clone = $domain->clone(name => new_domain_name(), user => user_admin );
@@ -139,8 +140,7 @@ sub test_import_spinoff {
 
 ############################################################################
 
-remove_old_domains();
-remove_old_disks();
+clean();
 
 for my $vm_name (@VMS) {
     my $vm = $RVD_BACK->search_vm($vm_name);
@@ -153,6 +153,7 @@ for my $vm_name (@VMS) {
         diag($msg)      if !$vm;
         skip $msg,10    if !$vm;
 
+        diag("Tesing import in $vm_name");
         test_wrong_args($vm_name, $vm);
 
         my $domain = test_already_there($vm_name, $vm);
@@ -162,8 +163,7 @@ for my $vm_name (@VMS) {
     }
 }
 
-remove_old_domains();
-remove_old_disks();
+clean();
 
 done_testing();
 

t/lib/Test/Ravada.pm

@@ -56,6 +56,8 @@ create_domain
 
     create_storage_pool
     local_ips
+
+    delete_request
 );
 
 our $DEFAULT_CONFIG = "t/etc/ravada.conf";
@@ -165,9 +167,14 @@ sub create_domain {
 
     my $name = new_domain_name();
 
+    my $domain;
+    eval { $domain = $vm->import_domain($name, $user) };
+    die $@ if $@ && $@ !~ /Domain.* not found/i;
+
+    return $domain if $domain;
+
     my %arg_create = (id_iso => $id_iso);
 
-    my $domain;
     eval { $domain = $vm->create_domain(name => $name
                     , id_owner => $user->id
                     , %arg_create
@@ -597,6 +604,15 @@ sub _list_requests {
     return @req;
 }
 
+sub delete_request {
+    confess "Error: missing request command to delete" if !@_;
+
+    my $sth = $CONNECTOR->dbh->prepare("DELETE FROM requests WHERE command=?");
+    for my $command (@_) {
+        $sth->execute($command);
+    }
+}
+
 sub wait_request {
     my %args;
     if (scalar @_ % 2 == 0 ) {
@@ -606,7 +622,12 @@ sub wait_request {
         $args{request} = [ $_[0] ];
     }
     my $timeout = delete $args{timeout};
-    my $request = ( delete $args{request} or [] );
+    my $request = delete $args{request};
+    if (!$request) {
+        my @list_requests = map { Ravada::Request->open($_) }
+            _list_requests();
+        $request = \@list_requests;
+    }
 
     my $background = delete $args{background};
     $background = 1 if !defined $background;
@@ -634,6 +655,7 @@ sub wait_request {
             my $req = Ravada::Request->open($req_id);
             next if $skip{$req->command};
             if ( $req->status ne 'done' ) {
+                diag("Waiting for request ".$req->id." ".$req->command) if $debug;
                 $done_all = 0;
             } elsif (!$done{$req->id}) {
                 $done{$req->{id}}++;
@@ -877,8 +899,6 @@ sub search_iptable_remote {
     my $chain = (delete $args{chain} or $CHAIN);
     my $to_dest = delete $args{'to-destination'};
 
-    confess "Error: Unknown args ".Dumper(\%args) if keys %args;
-
     my $iptables = $node->iptables_list();
 
     $remote_ip .= "/32" if defined $remote_ip && $remote_ip !~ m{/};
@@ -913,6 +933,10 @@ sub flush_rules_node($node) {
     $node->create_iptables_chain($CHAIN);
     $node->run_command("/sbin/iptables","-F", $CHAIN);
     $node->run_command("/sbin/iptables","-X", $CHAIN);
+
+    # flush forward too. this is only supposed to run on test servers
+    $node->run_command("/sbin/iptables","-F", 'FORWARD');
+
 }
 
 sub flush_rules {
@@ -938,6 +962,12 @@ sub flush_rules {
         run3([@cmd, $n], \$in, \$out, \$err);
         warn $err if $err;
     }
+    run3(["/sbin/iptables","-F", $CHAIN], \$in, \$out, \$err);
+    run3(["/sbin/iptables","-X", $CHAIN], \$in, \$out, \$err);
+
+    # flush forward too. this is only supposed to run on test servers
+    run3(["/sbin/iptables","-F", ], \$in, \$out, \$err);
+
 }
 
 sub _domain_node($node) {

t/user/20_grants.t

@@ -275,7 +275,7 @@ sub test_shutdown_clone {
 sub test_remove {
     my $vm_name = shift;
 
-    my $user = create_user("oper_r$$","bar");
+    my $user = create_user("oper_r$$.$vm_name","bar");
     ok(!$user->is_operator);
     ok(!$user->is_admin);
 

t/vm/92_ports.t

@@ -3,6 +3,7 @@ use strict;
 
 use Carp qw(confess);
 use Data::Dumper;
+use IPC::Run3;
 use JSON::XS;
 use Test::More;
 use IPTables::ChainMgr;
@@ -15,8 +16,139 @@ use feature qw(signatures);
 
 use_ok('Ravada');
 
-##############################################################
+sub test_no_dupe($vm) {
+
+    flush_rules($vm);
+
+    my $domain = create_domain($vm->type, user_admin ,'debian stretch');
+
+    my $remote_ip = '10.0.0.1';
+    my $local_ip = $vm->ip;
+
+    my ($internal_port, $name_port) = (22, 'ssh');
+
+    my ($in, $out, $err);
+    run3(['/sbin/iptables','-t','nat','-L','PREROUTING','-n'],\($in, $out, $err));
+    my @out = split /\n/,$out;
+    is(grep(/^DNAT.*/,@out),0);
+
+    run3(['/sbin/iptables','-L','FORWARD','-n'],\($in, $out, $err));
+    @out = split /\n/,$out;
+    is(grep(m{^ACCEPT.*192.168.\d+\.0/24\sstate NEW},@out),0);
+
+    $domain->start(user => user_admin, remote_ip => $remote_ip);
+    my @request = $domain->list_requests();
+
+    # No requests because no ports exposed
+    is(scalar @request,0) or exit;
+    delete_request('enforce_limits');
+    wait_request(debug => 1, background => 0);
+
+    my $client_ip = $domain->remote_ip();
+    is($client_ip, $remote_ip);
+    my $public_port;
+    _wait_ip($vm->type, $domain);
+    my $internal_ip = $domain->ip;
+    my $internal_net = $internal_ip;
+    $internal_net =~ s{(.*)\.\d+$}{$1.0/24};
+
+    ($public_port) = $domain->expose(
+        port => $internal_port
+        , name => $name_port
+        , restricted => 1
+    );
+    delete_request('enforce_limits');
+    wait_request(background => 0, debug => 1);
+
+    run3(['/sbin/iptables','-t','nat','-L','PREROUTING','-n'],\($in, $out, $err));
+    @out = split /\n/,$out;
+    is(grep(/^DNAT.*$local_ip.*dpt:$public_port to:$internal_ip:$internal_port/,@out),1);
+
+    run3(['/sbin/iptables','-L','FORWARD','-n'],\($in, $out, $err));
+    @out = split /\n/,$out;
+    is(grep(m{^ACCEPT.*$internal_net\s+state NEW},@out),1,"Expecting rule for $internal_net")
+        or die $out;
+
+    run3(['/sbin/iptables','-L','RAVADA','-n'],\($in, $out, $err));
+    @out = split /\n/,$out;
+    is(grep(m{^ACCEPT.*$remote_ip\s+$local_ip.*dpt:$public_port},@out),1) or die $out;
+    is(grep(m{^DROP.*0.0.0.0.+$local_ip.*dpt:$public_port},@out),1) or die $out;
+
+    ##########################################################################
+    #
+    # start again check only one instance of each
+    #
+    $domain->start(user => user_admin, remote_ip => $remote_ip);
+    is($domain->is_active,1);
+    run3(['/sbin/iptables','-t','nat','-L','PREROUTING','-n'],\($in, $out, $err));
+    @out = split /\n/,$out;
+    is(grep(/^DNAT.*$local_ip.*dpt:$public_port to:$internal_ip:$internal_port/,@out),1);
+
+    run3(['/sbin/iptables','-L','FORWARD','-n'],\($in, $out, $err));
+    @out = split /\n/,$out;
+    is(grep(m{^ACCEPT.*$internal_net\s+state NEW},@out),1) or die $out;
+
+    run3(['/sbin/iptables','-L','RAVADA','-n'],\($in, $out, $err));
+    @out = split /\n/,$out;
+    is(grep(m{^ACCEPT.*$remote_ip\s+$local_ip.*dpt:$public_port},@out),1) or die $out;
+    is(grep(m{^DROP.*0.0.0.0.+$local_ip.*dpt:$public_port},@out),1) or die $out;
+
+    test_hibernate($domain, $local_ip, $public_port, $internal_ip, $internal_port,$remote_ip);
+    test_start_after_hibernate($domain, $local_ip, $public_port, $internal_ip, $internal_port,$remote_ip);
+    $domain->remove(user_admin);
+
+    flush_rules($vm);
+}
 
+sub test_hibernate($domain
+        ,$local_ip, $public_port, $internal_ip, $internal_port, $remote_ip) {
+    $domain->hibernate(user_admin);
+
+    my ($in,$out,$err);
+    run3(['/sbin/iptables','-t','nat','-L','PREROUTING','-n'],\($in, $out, $err));
+    my @out = split /\n/,$out;
+    is(grep(/^DNAT.*$local_ip.*dpt:$public_port to:$internal_ip:$internal_port/,@out),0);
+
+    run3(['/sbin/iptables','-L','FORWARD','-n'],\($in, $out, $err));
+    @out = split</