35_request_start.t 6.36 KB
Newer Older
Francesc Guasch's avatar
Francesc Guasch committed
1
2
3
use warnings;
use strict;

4
5
use Carp qw(confess);
use Data::Dumper;
Francesc Guasch's avatar
Francesc Guasch committed
6
7
8
9
10
use Test::More;
use Test::SQL::Data;

use_ok('Ravada');
use_ok('Ravada::Request');
11
use lib 't/lib';
Francesc Guasch's avatar
Francesc Guasch committed
12

13
use Test::Ravada;
Francesc Guasch's avatar
Francesc Guasch committed
14

15
my $test = Test::SQL::Data->new(config => 't/etc/sql.conf');
16

17
18
init($test->connector, 't/etc/ravada.conf');
my $RAVADA = rvd_back();
19
my $USER = create_user('foo','bar', 1);
Francesc Guasch's avatar
Francesc Guasch committed
20

21
my @ARG_CREATE_DOM = ( id_owner => $USER->id , id_iso => 1 );
Francesc Guasch's avatar
Francesc Guasch committed
22
23

sub test_remove_domain {
24
    my $vm_name = shift;
Francesc Guasch's avatar
Francesc Guasch committed
25
26
    my $name = shift;

27
28
29
30
31
    my $vm = rvd_back->search_vm($vm_name) 
        or confess "I can't find vm $vm_name";

    diag("[$vm_name] removing domain $name");
    my $domain = $vm->search_domain($name,1);
Francesc Guasch's avatar
Francesc Guasch committed
32

33
34
    my $disks_not_removed = 0;

Francesc Guasch's avatar
Francesc Guasch committed
35
36
    if ($domain) {
        diag("Removing domain $name");
37
38
        my @disks = $domain->list_disks();
        eval { 
39
            $domain->remove(user_admin->id);
40
41
        };
        ok(!$@ , "Error removing domain $name ".ref($domain).": $@") or exit;
Francesc Guasch's avatar
Francesc Guasch committed
42

43
44
45
        for (@disks) {
            ok(!-e $_,"Disk $_ should be removed") or $disks_not_removed++;
        }
Francesc Guasch's avatar
Francesc Guasch committed
46
47

    }
48
49
    $domain = $vm->search_domain($name,1);
    ok(!$domain, "Removing old domain $name") or exit;
50
    ok(!$disks_not_removed,"$disks_not_removed disks not removed from domain $name");
Francesc Guasch's avatar
Francesc Guasch committed
51
52
53
}

sub test_new_domain {
54
    my $vm_name = shift;
Francesc Guasch's avatar
Francesc Guasch committed
55
56
    my $name = shift;

57
    my $vm = $RAVADA->search_vm($vm_name);
Francesc Guasch's avatar
Francesc Guasch committed
58

59
60
61
#    test_remove_domain($vm_name, $name);

    diag("[$vm_name] Creating domain $name");
62
    $vm->connect();
63
    my $domain = $vm->create_domain(name => $name, @ARG_CREATE_DOM, active => 0);
Francesc Guasch's avatar
Francesc Guasch committed
64
65
66
67
68
69
70
71

    ok($domain,"Domain not created");

    return $domain;
}


sub test_start {
72
73
    my $vm_name = shift;

74
    my $name = new_domain_name();
75
#    test_remove_domain($vm_name, $name);
Francesc Guasch's avatar
Francesc Guasch committed
76
77


78
79
    my $remote_ip = '99.88.77.66';

Francesc Guasch's avatar
Francesc Guasch committed
80
    my $req = Ravada::Request->start_domain(
81
82
        name => "does not exists"
        ,uid => $USER->id
83
        ,remote_ip => $remote_ip
Francesc Guasch's avatar
Francesc Guasch committed
84
    );
85
    $RAVADA->process_requests();
Francesc Guasch's avatar
Francesc Guasch committed
86

87
88
89
    wait_request($req);

    ok($req->status eq 'done', "[$vm_name] Req ".$req->{id}." expecting status done, got ".$req->status);
Francesc Guasch's avatar
Francesc Guasch committed
90
    ok($req->error && $req->error =~ /unknown/i
91
            ,"[$vm_name] Req ".$req->{id}." expecting unknown domain error , got "
92
                .($req->error or '<NULL>')) or return;
Francesc Guasch's avatar
Francesc Guasch committed
93
94
    $req = undef;

Francesc Guasch's avatar
Francesc Guasch committed
95
96
97
    #####################################################################3
    #
    # start
98
    test_new_domain($vm_name, $name);
99

100
101
102
103
104
    {
        my $vm = $RAVADA->search_vm($vm_name);
        my $domain = $vm->search_domain($name);
        ok(!$domain->is_active,"Domain $name should be inactive") or return;
    }
105
    my $req2 = Ravada::Request->start_domain(name => $name, uid => $USER->id
106
        ,remote_ip => $remote_ip
107
    );
108
    $RAVADA->process_requests();
Francesc Guasch's avatar
Francesc Guasch committed
109

110
111
112
    wait_request($req2);
    ok($req2->status eq 'done',"Expecting request status 'done' , got "
                                .$req2->status);
Francesc Guasch's avatar
Francesc Guasch committed
113

114
115
116
117
    {
        my $domain = $RAVADA->search_domain($name);
        $domain->start($USER)    if !$domain->is_active();
        ok($domain->is_active);
Francesc Guasch's avatar
Francesc Guasch committed
118

119
120
121
122
        my $vm = $RAVADA->search_vm($vm_name);
        my $domain2 = $vm->search_domain($name);
        ok($domain2->is_active);
    }
Francesc Guasch's avatar
Francesc Guasch committed
123

Francesc Guasch's avatar
Francesc Guasch committed
124
125
126
127
128
129
    $req2 = undef;

    #####################################################################3
    #
    # stop

130
    my $req3 = Ravada::Request->shutdown_domain(name => $name, uid => $USER->id, timeout => 2);
131
    $RAVADA->process_requests();
132
133
134
    wait_request($req3);
    ok($req3->status eq 'done',"[$vm_name] expecting request done , got "
                            .$req3->status);
135
    ok(!$req3->error,"Error shutting down domain $name , expecting ''. Got '".$req3->error);
Francesc Guasch's avatar
Francesc Guasch committed
136

137
    my $vm = $RAVADA->search_vm($vm_name);
138
    my $domain3 = $vm->search_domain($name);
139
    ok(!$domain3->is_active,"Domain $name should not be active");
Francesc Guasch's avatar
Francesc Guasch committed
140

141
142
    return $domain3;

Francesc Guasch's avatar
Francesc Guasch committed
143
144
}

145
146
sub test_screenshot {
    my $vm_name = shift;
147
    my $domain_name = shift;
148

149
    my $domain = $RAVADA->search_domain($domain_name);
150
151
152
153
154
155
156
157
158
    $domain->start($USER) if !$domain->is_active();
    return if !$domain->can_screenshot();

    unlink $domain->_file_screenshot or die "$! ".$domain->_file_screenshot
        if -e $domain->_file_screenshot;

    ok(!-e $domain->_file_screenshot,"File screenshot ".$domain->_file_screenshot
                                    ." should not exist");

159
160
161
162
163
    my $file_screenshot = $domain->_file_screenshot();
    my $domain_id = $domain->id;
    $domain = undef;

    my $req = Ravada::Request->screenshot_domain(id_domain => $domain_id );
164
165
166
167
168
169
    ok($req);
    $RAVADA->process_requests();
    wait_request($req);
    ok($req->status('done'),"Request should be done, it is ".$req->status);
    ok(!$req->error(''),"Error should be '' , it is ".$req->error);

170
    ok(-e $file_screenshot,"File screenshot ".$file_screenshot
171
172
173
174
175
                                    ." should exist");
}

sub test_screenshot_file {
    my $vm_name = shift;
176
177
178
    my $domain_name = shift;

    my $domain = $RAVADA->search_domain($domain_name);
179
180
181
182
183
184
185
186
187
188

    $domain->start($USER) if !$domain->is_active();
    return if !$domain->can_screenshot();

    unlink $domain->_file_screenshot or die "$! ".$domain->_file_screenshot
        if -e $domain->_file_screenshot;

    ok(!-e $domain->_file_screenshot,"File screenshot should not exist");

    my $file = "/var/tmp/screenshot.$$.png";
189
190
191
    my $domain_id = $domain->id;
    $domain = undef;

192
    my $req = Ravada::Request->screenshot_domain(
193
        id_domain => $domain_id
194
195
196
197
198
199
200
201
202
203
204
205
206
207
        ,filename => $file);
    ok($req);

    $RAVADA->process_requests();
    wait_request($req);

    ok($req->status('done'),"Request should be done, it is ".$req->status);
    ok(!$req->error(''),"Error should be '' , it is ".$req->error);

    ok(-e $file,"File '$file' screenshot should exist");

}


Francesc Guasch's avatar
Francesc Guasch committed
208
209
210
###############################################################
#

Francesc Guasch's avatar
Francesc Guasch committed
211
212
213
remove_old_domains();
remove_old_disks();

214
for my $vm_name (qw(KVM Void)) {
215
    my $vmm = $RAVADA->search_vm($vm_name);
216

217
218
219
220
    SKIP: {
        my $msg = "SKIPPED: Virtual manager $vm_name not found";
        diag($msg) if !$vmm;
        skip($msg,10) if !$vmm;
221

222
#        $vmm->disconnect() if $vmm;
223
224
        diag("Testing VM $vm_name");
        my $domain = test_start($vm_name);
225
#        $domain->_vm->disconnect;
226
227
        my $domain_name = $domain->name;
        $domain = undef;
228

229
230
        test_screenshot($vm_name, $domain_name);
        test_screenshot_file($vm_name, $domain_name);
231
232
233
234
    };
}
remove_old_domains();
remove_old_disks();
235

Francesc Guasch's avatar
Francesc Guasch committed
236
237
done_testing();