35_request_start.t 7.47 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
use Test::More;

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

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

14
my $RAVADA = rvd_back();
15
my $USER = create_user('foo','bar', 1);
Francesc Guasch's avatar
Francesc Guasch committed
16

17
my @ARG_CREATE_DOM = ( id_owner => $USER->id , id_iso => search_id_iso('Alpine') );
Francesc Guasch's avatar
Francesc Guasch committed
18
19

sub test_remove_domain {
20
    my $vm_name = shift;
Francesc Guasch's avatar
Francesc Guasch committed
21
22
    my $name = shift;

23
24
25
26
27
    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
28

29
30
    my $disks_not_removed = 0;

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

39
40
41
        for (@disks) {
            ok(!-e $_,"Disk $_ should be removed") or $disks_not_removed++;
        }
Francesc Guasch's avatar
Francesc Guasch committed
42
43

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

sub test_new_domain {
50
    my $vm_name = shift;
Francesc Guasch's avatar
Francesc Guasch committed
51
52
    my $name = shift;

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

55
56
57
#    test_remove_domain($vm_name, $name);

    diag("[$vm_name] Creating domain $name");
58
    $vm->connect();
Francesc Guasch's avatar
Francesc Guasch committed
59
    my $domain = $vm->create_domain(name => $name, @ARG_CREATE_DOM, active => 0, disk => 1024 * 1024);
Francesc Guasch's avatar
Francesc Guasch committed
60
61
62
63
64
65
66
67

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

    return $domain;
}


sub test_start {
68
    my $vm_name = shift;
69
    my $fork = shift;
70

71
    my $name = new_domain_name();
72
#    test_remove_domain($vm_name, $name);
Francesc Guasch's avatar
Francesc Guasch committed
73
74


75
76
    my $remote_ip = '99.88.77.66';

Francesc Guasch's avatar
Francesc Guasch committed
77
    my $req = Ravada::Request->start_domain(
78
79
        name => "does not exists"
        ,uid => $USER->id
80
        ,remote_ip => $remote_ip
Francesc Guasch's avatar
Francesc Guasch committed
81
    );
82
83
84
85
86
    if ($fork) {
        $RAVADA->process_requests(0);
    } else {
        $RAVADA->_process_all_requests_dont_fork(0);
    }
Francesc Guasch's avatar
Francesc Guasch committed
87

88
    wait_request( background => $fork, check_error => 0 );
89
90

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

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

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

111
112
113
    wait_request($req2);
    ok($req2->status eq 'done',"Expecting request status 'done' , got "
                                .$req2->status);
Francesc Guasch's avatar
Francesc Guasch committed
114
    is($req2->error,'');
115
    my $id_domain;
116
117
    {
        my $domain = $RAVADA->search_domain($name);
118
        $id_domain = $domain->id;
119
120
        $domain->start($USER)    if !$domain->is_active();
        ok($domain->is_active);
121
        is($domain->is_volatile,0);
Francesc Guasch's avatar
Francesc Guasch committed
122

123
124
125
        my $vm = $RAVADA->search_vm($vm_name);
        my $domain2 = $vm->search_domain($name);
        ok($domain2->is_active);
126
        is($domain2->is_volatile,0);
127
    }
Francesc Guasch's avatar
Francesc Guasch committed
128

Francesc Guasch's avatar
Francesc Guasch committed
129
130
131
132
133
134
    $req2 = undef;

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

135
    my $req3 = Ravada::Request->force_shutdown_domain(id_domain => $id_domain, uid => $USER->id);
Francesc Guasch's avatar
Francesc Guasch committed
136
    $RAVADA->_process_all_requests_dont_fork(0);
137
138
139
    wait_request($req3);
    ok($req3->status eq 'done',"[$vm_name] expecting request done , got "
                            .$req3->status);
140
141
    ok(!$req3->error,"Error shutting down domain $name , expecting ''
                        . Got '".($req3->error or ''));
Francesc Guasch's avatar
Francesc Guasch committed
142

143
    my $vm = $RAVADA->search_vm($vm_name);
144
    my $domain3 = $vm->search_domain($name);
145
    ok($domain3,"[$vm_name] Searching for domain $name") or exit;
146
    for ( 1 .. 60 ) {
147
        last if !$domain3 || !$domain3->is_active;
148
149
        sleep 1;
    }
150
    ok(!$domain3->is_active,"Domain $name should not be active");
Francesc Guasch's avatar
Francesc Guasch committed
151

152
153
    return $domain3;

Francesc Guasch's avatar
Francesc Guasch committed
154
155
}

156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
sub test_screenshot_db {
    my $vm_name = shift;
    my $domain_name = shift;

    my $domain = $RAVADA->search_domain($domain_name);
    $domain->start($USER) if !$domain->is_active();
    return if !$domain->can_screenshot();
    sleep 2;

    $domain->screenshot();
    $domain->shutdown(user => $USER, timeout => 1);
    my $sth = connector->dbh->prepare("SELECT screenshot FROM domains WHERE id=?");
    $sth->execute($domain->id);
    my @fields = $sth->fetchrow;

    ok($fields[0]);
}

174
175
sub test_screenshot {
    my $vm_name = shift;
176
    my $domain_name = shift;
177

178
    my $domain = $RAVADA->search_domain($domain_name);
179
180
181
182
183
184
185
186
187
    $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");

188
189
190
191
192
    my $file_screenshot = $domain->_file_screenshot();
    my $domain_id = $domain->id;
    $domain = undef;

    my $req = Ravada::Request->screenshot_domain(id_domain => $domain_id );
193
    ok($req);
194
195
196

    my $dont_fork = 1;
    rvd_back->process_all_requests(0,$dont_fork);
197
    wait_request( background=> !$dont_fork );
198
199
200
    ok($req->status('done'),"Request should be done, it is ".$req->status);
    ok(!$req->error(''),"Error should be '' , it is ".$req->error);

201
    ok(-e $file_screenshot,"File screenshot ".$file_screenshot
202
203
204
205
206
                                    ." should exist");
}

sub test_screenshot_file {
    my $vm_name = shift;
207
208
209
    my $domain_name = shift;

    my $domain = $RAVADA->search_domain($domain_name);
210
211
212
213
214
215
216
217
218
219

    $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";
220
221
222
    my $domain_id = $domain->id;
    $domain = undef;

223
    my $req = Ravada::Request->screenshot_domain(
224
        id_domain => $domain_id
225
226
227
        ,filename => $file);
    ok($req);

228
229
    my $dont_fork = 1;
    rvd_back->process_all_requests(0,$dont_fork);
230
    wait_request( background => !$dont_fork );
231
232

    ok($req->status('done'),"Request should be done, it is ".$req->status);
233
    ok(!$req->error(),"Error should be '' , it is ".($req->error or ''));
234
235
236
237
238
239

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

}


Francesc Guasch's avatar
Francesc Guasch committed
240
241
242
###############################################################
#

Francesc Guasch's avatar
Francesc Guasch committed
243
244
init();
clean();
Francesc Guasch's avatar
Francesc Guasch committed
245

246
for my $vm_name (qw(KVM Void)) {
247
    my $vmm = $RAVADA->search_vm($vm_name);
248

249
250
    SKIP: {
        my $msg = "SKIPPED: Virtual manager $vm_name not found";
Francesc Guasch's avatar
Francesc Guasch committed
251
        if ($vmm && $vm_name eq 'KVM' && $>) {
252
253
254
255
            $msg = "SKIPPED: Test must run as root";
            $vmm = undef;
        }

256
257
        diag($msg) if !$vmm;
        skip($msg,10) if !$vmm;
258

259
#        $vmm->disconnect() if $vmm;
260
        diag("Testing VM $vm_name");
261
262
        my $domain = test_start($vm_name,0);
        $domain = test_start($vm_name,1);
263
#        $domain->_vm->disconnect;
264
        next if !$domain;
265
266
        my $domain_name = $domain->name;
        $domain = undef;
267

268
        test_screenshot_db($vm_name, $domain_name);
269
270
    };
}
Francesc Guasch's avatar
Francesc Guasch committed
271
clean();
272

Francesc Guasch's avatar
Francesc Guasch committed
273
274
done_testing();