t10_timeout.t 2.43 KB
Newer Older
Francesc Guasch's avatar
Francesc Guasch committed
1
2
3
4
5
6
7
8
9
10
11
use warnings;
use strict;

use Carp qw(confess);
use Data::Dumper;
use IPC::Run3;
use Test::More;

use lib 't/lib';
use Test::Ravada;

Francesc Guasch's avatar
Francesc Guasch committed
12
my $RVD_BACK = rvd_back();
Francesc Guasch's avatar
Francesc Guasch committed
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
my $USER;

$USER = create_user('foo','bar');

######################################################

sub test_run_timeout {
    my $vm_name = shift;
    my $domain = create_domain($vm_name, user_admin)
        or return;

    my $timeout = 5;

    $domain->run_timeout($timeout);


    is($domain->run_timeout(),$timeout);
    $domain->prepare_base(user_admin);

    $domain->is_public(1);
    ok($domain->is_public());
    ok($domain->is_base());

    my $domain_f = rvd_front->search_domain($domain->name);
    is($domain_f->run_timeout(),$timeout);
    is($domain_f->is_public(),1);

    my $clone = $domain->clone(user => $USER, name => new_domain_name());

    is($clone->run_timeout(),$timeout);

    $clone->start(user => $USER);
45
46
47
48
49
50
51
    my @requests = $clone->list_requests(1);
    my ($req) = grep { $_->command eq 'shutdown' } @requests;
    ok($req, "Expecting shutdown requested ".Dumper($req,[map { [$_->command, $_->at_time] } @requests])) and do {
        is($req->args('id_domain'), $clone->id);
        my $at = $req->at_time();
        ok($at > time(),"Expecting at in the future ".($at - time));
    };
Francesc Guasch's avatar
Francesc Guasch committed
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85

    $clone->remove(user_admin);
    $domain->remove(user_admin);
}

sub test_run_timeout_propagate {
    my $vm_name = shift;

    my $domain = create_domain($vm_name, user_admin) or return;

    my $timeout = 5;

    $domain->run_timeout($timeout);
    $domain->prepare_base(user_admin);

    $domain->is_public(1);

    my $clone = $domain->clone(user => $USER, name => new_domain_name());

    is($clone->run_timeout(),$timeout);

    my $timeout2 = 7;
    $domain->run_timeout($timeout2);

    my $clone2 = rvd_front->search_domain($clone->name);
    is($clone2->run_timeout(),$timeout2);

    $clone->remove(user_admin);
    $domain->remove(user_admin);
}

######################################################
clean();

86
for my $vm_name ( vm_names() ) {
Francesc Guasch's avatar
Francesc Guasch committed
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105

    my $vm = rvd_back->search_vm($vm_name);

    SKIP: {

        my $msg = "SKIPPED: No virtual managers found";
        if ($vm && $vm_name =~ /kvm/i && $>) {
            $msg = "SKIPPED: Test must run as root";
            $vm = undef;
        }

        skip($msg,10)   if !$vm;
        diag("Testing timeout for $vm_name");

        test_run_timeout($vm_name);
        test_run_timeout_propagate($vm_name);
    }
}

106
end();
Francesc Guasch's avatar
Francesc Guasch committed
107
done_testing();