test(frontend): check process limits

rvd_front.pl

@@ -956,7 +956,7 @@ post '/request/(:name)/' => sub {
         ,uid => $USER->id
         ,%$args
     );
-    return $c->render(json => { ok => 1 });
+    return $c->render(json => { ok => 1, request => $req });
 };
 
 get '/request/(:id).(:type)' => sub {
@@ -1307,7 +1307,7 @@ sub login {
             my @languages = I18N::LangTags::implicate_supers(
                 I18N::LangTags::Detect::detect()
             );
-            my $header = $c->req->headers->header('accept-language');
+            my $header = ( $c->req->headers->header('accept-language') or '');
             my @languages2 = map {s/^(.*?)[;-].*/$1/; $_ } split /,/,$header;
 
             Ravada::Request->post_login(
@@ -1721,7 +1721,8 @@ sub init {
     $home->detect();
 
     if (exists $ENV{MORBO_VERBOSE}
-        || (exists $ENV{MOJO_MODE} && $ENV{MOJO_MODE} =~ /devel/i )) {
+        || (exists $ENV{MOJO_MODE} && defined $ENV{MOJO_MODE}
+                && $ENV{MOJO_MODE} =~ /devel/i )) {
             return if -e $home->rel_file("public");
     }
     app->static->paths->[0] = ($CONFIG_FRONT->{dir}->{public}

t/lib/Test/Ravada.pm

@@ -57,6 +57,8 @@ create_domain
     local_ips
 
     delete_request
+
+    remove_old_domains_req
 );
 
 our $DEFAULT_CONFIG = "t/etc/ravada.conf";
@@ -361,6 +363,33 @@ sub remote_config_nodes {
     return $conf;
 }
 
+sub remove_old_domains_req() {
+    my $base_name = base_domain_name();
+    my $machines = rvd_front->list_machines(user_admin);
+    for my $machine ( @$machines) {
+        my $domain = Ravada::Front::Domain->open($machine->{id});
+        next if $domain->name !~ /^$base_name/;
+        my $n_clones = scalar($domain->clones);
+        my $req_clone;
+        for my $clone ($domain->clones) {
+            $req_clone = Ravada::Request->remove_domain(
+                name => $clone->{name}
+                ,uid => user_admin->id
+            );
+        }
+        wait_request(debug => 1, background => 1, check_error => 0, timeout => 60+2*$n_clones);
+
+        my @after_req = ();
+        @after_req = ( after_request => $req_clone->id ) if $req_clone;
+        my $req = Ravada::Request->remove_domain(
+            name => $machine->{name}
+            ,uid => user_admin->id
+        );
+    }
+    wait_request(debug => 1, background => 1, timeout => 120);
+
+}
+
 sub _remove_old_domains_vm($vm_name) {
 
     confess "Undefined vm_name" if !defined $vm_name;
@@ -685,6 +714,7 @@ sub wait_request {
         $post = '' if !defined $post;
         if ( $done_all ) {
             for my $req (@$request) {
+                $req = Ravada::Request->open($req) if !ref($req);
                 next if $skip{$req->command};
                 if ($req->status ne 'done') {
                     $done_all = 0;

t/mojo/10_login.t

@@ -16,7 +16,7 @@ my $SECONDS_TIMEOUT = 15;
 
 my $t;
 
-my $URL_LOGOUT;
+my $URL_LOGOUT = '/logout';
 my ($USERNAME, $PASSWORD);
 my $SCRIPT = path(__FILE__)->dirname->sibling('../rvd_front.pl');
 
@@ -27,20 +27,24 @@ sub remove_machines {
     my $t0 = time;
     for my $name ( @_ ) {
         my $domain = rvd_front->search_domain($name) or next;
+        my $n_clones = scalar($domain->clones);
+        my $req_clone;
         for my $clone ($domain->clones) {
-            my $req = Ravada::Request->remove_domain(
+            $req_clone = Ravada::Request->remove_domain(
                 name => $clone->{name}
                 ,uid => user_admin->id
             );
         }
-        _wait_request(debug => 1, background => 1, check_error => 1);
+        _wait_request(debug => 1, background => 1, check_error => 0, timeout => 60+2*$n_clones);
 
+        my @after_req = ();
+        @after_req = ( after_request => $req_clone->id ) if $req_clone;
         my $req = Ravada::Request->remove_domain(
             name => $name
             ,uid => user_admin->id
         );
     }
-    _wait_request(debug => 1, background => 1);
+    _wait_request(debug => 1, background => 1, timeout => 120);
     if ( time - $t0 > $SECONDS_TIMEOUT ) {
         login();
     }
@@ -58,12 +62,7 @@ sub _wait_request(@args) {
 
 
 sub login( $user=$USERNAME, $pass=$PASSWORD ) {
-    if ($URL_LOGOUT) {
-        $t->get_ok('/logout');
-        $URL_LOGOUT = $t->tx->req->url->to_abs;
-    } {
-        $t->ua->get($URL_LOGOUT);
-    }
+    $t->ua->get($URL_LOGOUT);
 
     $t->post_ok('/' => form => {login => $user, password => $pass});
     like($t->tx->res->code(),qr/^(200|302)$/);
@@ -72,6 +71,51 @@ sub login( $user=$USERNAME, $pass=$PASSWORD ) {
     exit if !$t->success;
 }
 
+sub test_many_clones($base) {
+    login();
+
+    my $n_clones = 30;
+    $n_clones = 100 if $base->type =~ /Void/i;
+    $t->post_ok('/machine/copy' => json => {id_base => $base->id, copy_number => $n_clones});
+    like($t->tx->res->code(),qr/^(200|302)$/) or die $t->tx->res->body->to_string;
+
+    my $response = $t->tx->res->json();
+    ok(exists $response->{request}) or return;
+    wait_request(request => $response->{request}, background => 1);
+
+    login();
+    $t->post_ok('/request/start_clones' => json =>
+        {   id_domain => $base->id
+           ,remote_ip => '1.2.3.4'
+        }
+    );
+    like($t->tx->res->code(),qr/^(200|302)$/) or die $t->tx->res->body->to_string;
+    $response = $t->tx->res->json();
+    ok(exists $response->{request}) and do {
+        wait_request(request => $response->{request}, background => 1);
+    };
+
+    for my $clone ( $base->clones ) {
+        my $req = Ravada::Request->remove_domain(
+            name => $clone->{name}
+            ,uid => user_admin->id
+        );
+    }
+}
+
+sub _init_mojo_client {
+    return if $USERNAME;
+    $t->get_ok('/')->status_is(200)->content_like(qr/name="login"/);
+
+    my $user_admin = user_admin();
+    my $pass = "$$ $$";
+
+    $USERNAME = $user_admin->name;
+    $PASSWORD = $pass;
+
+    login($user_admin->name, $pass);
+    $t->get_ok('/')->status_is(200)->content_like(qr/choose a machine/i);
+}
 
 ########################################################################################
 
@@ -79,20 +123,11 @@ init('/etc/ravada.conf',0);
 my $connector = rvd_back->connector;
 like($connector->{driver} , qr/mysql/i) or BAIL_OUT;
 
+remove_old_domains_req();
 
 $t = Test::Mojo->new($SCRIPT);
-$t->ua->inactivity_timeout(300);
-$t->get_ok('/')->status_is(200)->content_like(qr/name="login"/);
-
-my $user_admin = user_admin();
-my $pass = "$$ $$";
-
-$USERNAME = $user_admin->name;
-$PASSWORD = $pass;
-
-login($user_admin->name, $pass);
-$t->get_ok('/')->status_is(200)->content_like(qr/choose a machine/i);
-
+$t->ua->inactivity_timeout(900);
+$t->ua->connect_timeout(60);
 my @bases;
 my @clones;
 
@@ -100,9 +135,11 @@ for my $vm_name ( vm_names() ) {
 
     diag("Testing new machine in $vm_name");
 
-    my $name = new_domain_name();
+    my $name = new_domain_name()."-".$vm_name;
     remove_machines($name,"$name-".user_admin->name);
 
+    _init_mojo_client();
+
     $t->post_ok('/new_machine.html' => form => {
             backend => $vm_name
             ,id_iso => search_id_iso('Alpine%')
@@ -124,12 +161,17 @@ for my $vm_name ( vm_names() ) {
     $base = rvd_front->search_domain($name);
     is($base->is_base,1);
 
+    is(scalar($base->list_ports),0);
     $t->get_ok("/machine/clone/".$base->id.".json")->status_is(200);
     _wait_request(debug => 0, background => 1);
-    my $clone = rvd_front->search_domain($name."-".$user_admin->name);
+    my $clone = rvd_front->search_domain($name."-".user_admin->name);
     ok($clone,"Expecting clone created");
-    is($clone->is_volatile,0) or exit;
+    if ($clone) {
+        is($clone->is_volatile,0) or exit;
+        is(scalar($clone->list_ports),0);
+    }
 
+    test_many_clones($base);
 }
 ok(@bases,"Expecting some machines created");
 remove_machines(@bases);