Fix shared ports

lib/Ravada.pm

@@ -5614,7 +5614,8 @@ sub _cmd_refresh_machine_ports($self, $request) {
     my $domain = Ravada::Domain->open($id_domain) or confess "Error: domain $id_domain not found";
 
     die "USER $uid not authorized to refresh machine ports for domain ".$domain->name
-    unless $domain->_data('id_owner') ==  $user->id || $user->is_operator;
+    unless $domain->_data('id_owner') ==  $user->id || $user->is_operator
+            || $user->can_start_machine($domain->id);
 
     return if !$domain->is_active;
 
@@ -6762,6 +6763,14 @@ sub _cmd_open_exposed_ports($self, $request) {
     my $domain = Ravada::Domain->open($request->id_domain) or return;
     return if !$domain->list_ports();
 
+    my $uid = $request->args('uid');
+    my $user = Ravada::Auth::SQL->search_by_id( $uid )
+        or die "Error: user $uid not found";
+
+    die "Error: user ".$user->name." not authorized to open ports"
+    unless $user->is_admin || $domain->_data('id_owner') == $uid
+        || $user->can_start_machine($domain);
+
     my $remote_ip = $request->defined_arg('remote_ip');
 
     $domain->open_exposed_ports($remote_ip);
@@ -6783,7 +6792,8 @@ sub _cmd_close_exposed_ports($self, $request) {
     return if !$domain;
 
     die "Error: user ".$user->name." not authorized to delete iptables rule"
-    unless $user->is_admin || $domain->_data('id_owner') == $uid;
+    unless $user->is_admin || $domain->_data('id_owner') == $uid
+        || $user->can_start_machine($domain);
 
     my $port = $request->defined_arg('port');
 

lib/Ravada/Request.pm

@@ -252,7 +252,7 @@ our %COMMAND = (
         limit => 50
         ,priority => 4
         ,commands => ['shutdown','shutdown_now', 'enforce_limits', 'set_time'
-            ,'remove_domain','refresh_machine_ports'
+            ,'remove_domain', 'remove', 'refresh_machine_ports'
         ]
     }
 

t/device/10_templates.t

@@ -938,24 +938,15 @@ for my $vm_name ( vm_names()) {
 
         test_frontend_list($vm);
 
-        warn 1;
-
         test_templates_gone_usb_2($vm);
 
-        warn 2;
-
         test_templates_gone_usb($vm);
-        warn 3;
         test_templates_changed_usb($vm);
 
-        warn 4;
         test_templates_start_nohd($vm);
-        warn 5;
         test_templates_change_filter($vm);
 
-        warn 6;
         test_templates($vm);
-        warn 7;
         test_templates_change_devices($vm);
 
     }

t/lib/Test/Ravada.pm

@@ -1542,18 +1542,21 @@ sub remove_void_networks($vm=undef) {
 }
 
 sub remove_networks_req() {
-    my $sth = connector()->dbh->prepare("SELECT id,id_vm,name FROM virtual_networks "
-        ." WHERE name like ? "
+    my $sth = connector()->dbh->prepare(
+        "SELECT vn.id,id_vm,vn.name,v.name "
+        ." FROM virtual_networks vn, vms v"
+        ." WHERE vn.name like ? "
+        ."   AND vn.id_vm=v.id"
     );
     $sth->execute(base_domain_name."%");
-    while (my ($id, $id_vm, $name) = $sth->fetchrow) {
+    while (my ($id, $id_vm, $name, $node) = $sth->fetchrow) {
         my $req = Ravada::Request->remove_network(
             uid => user_admin()->id
             ,id => $id
             ,id_vm => $id_vm
         );
     }
-    wait_request();
+    wait_request(debug => 1);
 }
 
 sub remove_qemu_networks($vm=undef) {

t/mojo/70_volatile.t

@@ -142,13 +142,6 @@ sub _set_base_vms($vm_name, $id_base, $network) {
     while ( my ($id_vm) = $sth->fetchrow) {
         $t->post_ok("/node/enable/$id_vm.json");
 
-        my $req = Ravada::Request->create_network(
-        uid => user_admin->id
-        ,id_vm => $id_vm
-        ,data => $network
-        );
-        wait_request(check_error => 0);
-
         my $id_req = mojo_request($t,"set_base_vm", { id_vm => $id_vm, id_domain => $id_base, value => 1 }, 0);
         mojo_request($t,"clone", { id_domain => $id_base , after_request => $id_req, name => new_domain_name()
                     ,options => { network => $network->{name} }
@@ -176,38 +169,63 @@ sub _count_nodes($vm_name) {
     return ($count or 1);
 }
 
-sub _new_network($id_vm) {
+sub _new_network($vm_name,$id_vm) {
 
-    my $req_new = Ravada::Request->new_network(
-        uid => user_admin->id
-        ,id_vm => $id_vm
-        ,name => base_domain_name()
-    );
-    wait_request(debug => 0);
-    like($req_new->output , qr/\d+/) or exit;
+    my ($req,$net);
 
-    my $net = decode_json($req_new->output);
-    my $name = $net->{name};
+    for my $cont ( 140 .. 150 ) {
+        my $req_new = Ravada::Request->new_network(
+            uid => user_admin->id
+            ,id_vm => $id_vm
+            ,name => base_domain_name()
+        );
+        wait_request(debug => 0);
+        like($req_new->output , qr/\d+/) or exit;
 
-    my $user = create_user();
-    my $req = Ravada::Request->create_network(
-        uid => user_admin->id
-        ,id_vm => $id_vm
-        ,data => $net
-    );
-    wait_request(check_error => 0);
+        $net = decode_json($req_new->output);
+        $net->{ip_address} =~ s/(\d+\.\d+\.)\d+(.*)/$1$cont$2/;
+        my $name = $net->{name};
 
+        my $user = create_user();
+        $req = Ravada::Request->create_network(
+            uid => user_admin->id
+            ,id_vm => $id_vm
+            ,data => $net
+        );
+        wait_request(check_error => 0);
+
+        last if !$req->error;
+    }
     die $req->error if $req->error;
 
+    _create_network_nodes($vm_name, $net);
+
     return $net;
 }
 
+sub _create_network_nodes($vm_name, $net) {
+    my $sth = connector->dbh->prepare(
+        "SELECT id FROM vms WHERE vm_type=?"
+        ."  AND is_active=1 AND enabled=1"
+    );
+    $sth->execute($vm_name);
+    while ( my ($id_vm) = $sth->fetchrow ) {
+        $net->{id_vm} = $id_vm;
+        Ravada::Request->create_network(
+            uid => user_admin->id
+            ,id_vm => $id_vm
+            ,data => $net
+        );
+
+    }
+}
+
 sub test_clone($vm_name, $n=10) {
     my $id_vm = _id_vm($vm_name);
 
     my @bases = bases($vm_name);
 
-    my $network = _new_network($id_vm);
+    my $network = _new_network($vm_name, $id_vm);
     my $network_name = $network->{name};
 
     for my $base ( @bases ) {
@@ -257,8 +275,10 @@ sub test_clone($vm_name, $n=10) {
                 );
                 delete_request('set_time','force_shutdown');
                 next if $vm_name eq 'Void';
-                wait_request(debug => 1);
-                _wait_ip($name,$seconds++);
+                if (_slightly_loaded() ) {
+                    wait_request(debug => 1);
+                    _wait_ip($name,$seconds++);
+                }
                 last if _too_loaded();
             }
         }
@@ -292,22 +312,23 @@ sub _search_domain_by_name($name) {
     return $id;
 }
 
-sub _too_loaded($msg) {
+sub _slightly_loaded($msg="") {
     open my $in,"<","/proc/loadavg" or die $!;
     my ($load) = <$in>;
     close $in;
     chomp $load;
     $load =~ s/\s.*//;
-    return $load>$MAX_LOAD;
+    return $load>$MAX_LOAD/3;
 }
 
-sub _too_loaded() {
+
+sub _too_loaded($msg="") {
     open my $in,"<","/proc/loadavg" or die $!;
     my ($load) = <$in>;
     close $in;
     chomp $load;
     $load =~ s/\s.*//;
-    diag("$load / $MAX_LOAD");
+    diag("$msg $load / $MAX_LOAD");
     return $load>$MAX_LOAD;
 }
 

t/user/35_share.t

@@ -100,15 +100,30 @@ sub test_requests_shared($user, $clone) {
     wait_request();
     is($req3->status,'done');
     is($req3->error,'');
-
-    my $req4 = Ravada::Request->list_cpu_models(
+    my @args = (
         uid => $user->id
         ,id_domain => $clone->id
     );
+    my $req4 = Ravada::Request->list_cpu_models(@args);
     wait_request();
     is($req4->status,'done');
     is($req4->error,'');
 
+    my $req5 = Ravada::Request->open_exposed_ports(@args);
+    wait_request();
+    is($req5->status,'done');
+    is($req5->error,'');
+
+    $req5 = Ravada::Request->refresh_machine_ports(@args);
+    wait_request();
+    is($req5->status,'done');
+    is($req5->error,'');
+
+    $req5 = Ravada::Request->close_exposed_ports(@args);
+    wait_request();
+    is($req5->status,'done');
+    is($req5->error,'');
+
 }
 
 sub test_machine_info_shared($user, $clone) {