30_request.t 10.2 KB
Newer Older
1
2
3
use warnings;
use strict;

4
use Carp qw(confess);
5
use Data::Dumper;
6
use POSIX qw(WNOHANG);
Francesc Guasch's avatar
Francesc Guasch committed
7
use Test::Moose::More;
8
use Test::More;# tests => 82;
9
10
11
12

use_ok('Ravada');
use_ok('Ravada::Request');

13
14
15
use lib 't/lib';
use Test::Ravada;

16
my $ravada;
17
18
19
20

my ($DOMAIN_NAME) = $0 =~ m{.*/(.*)\.};
my $DOMAIN_NAME_SON=$DOMAIN_NAME."_son";

Francesc Guasch's avatar
Francesc Guasch committed
21
init();
22
23

my $RVD_BACK = rvd_back();# $test->connector , 't/etc/ravada.conf');
24
my $USER = create_user("foo","bar", 1);
25
$RVD_BACK = undef;
26

27
my @ARG_CREATE_DOM = (
Francesc Guasch's avatar
Francesc Guasch committed
28
        id_owner => $USER->id
Francesc Guasch's avatar
Francesc Guasch committed
29
        ,disk => 1024 * 1024
30
31
);

32
$Ravada::CAN_FORK = 0;
33

Francesc Guasch's avatar
Francesc Guasch committed
34
35
#######################################################################

36
37
38
39
40
41
sub test_empty_request {
    my $request = $ravada->request();
    ok($request);
}

sub test_remove_domain {
42
    my $vm = shift;
43
44
    my $name = shift;

45
46
    my $domain;
    $domain = $name if ref($name);
47
    $domain = $vm->search_domain($name,1);
48
49

    if ($domain) {
50
#        diag("Removing domain $name");
51
        eval { $domain->remove(user_admin()) };
52
53
        ok(!$@ , "Error removing domain $name : $@") or exit;

54
        # TODO check remove files base
55
56

    }
57
58
    $domain = $vm->search_domain($name,1);
    ok(!$domain, "I can't remove old domain $name");
59
60
61

}

62
63
64
65
66
67
68
69
70
71
72
73
74
75
sub test_req_start_domain {
    my $vm_name = shift;
    my $name = shift;

    $USER->mark_all_messages_read();
    test_unread_messages($USER,0, "[$vm_name] start domain $name");

    my $req = Ravada::Request->start_domain( 
        name => $name
        ,uid => $USER->id
        ,remote_ip => '127.0.0.1'
    );
    ok($req);
    ok($req->status);
Francesc Guasch's avatar
Francesc Guasch committed
76
    $ravada->_process_requests_dont_fork();
77
78
79
80
81
82
83
    $ravada->_wait_pids();
    wait_request($req);

    ok($req->status eq 'done'
        ,"Status of request is ".$req->status." it should be done") 
            or return ;
    ok(!$req->error,"Error ".$req->error." creating domain ".$name) 
Francesc Guasch's avatar
Francesc Guasch committed
84
            or return;
85
86
87
88

    my $n_expected = 1;
    test_unread_messages($USER, $n_expected, "[$vm_name] create domain $name");

89
90
}

91
sub test_req_create_domain_iso {
92
    my $vm_name = shift;
93

Francesc Guasch's avatar
Francesc Guasch committed
94
    my $name = new_domain_name();
95
#    diag("Requesting create domain $name");
96

97
98
99
    $USER->mark_all_messages_read();
    test_unread_messages($USER,0, "[$vm_name] create domain $name");

100
101
    my $req;
    eval { $req = Ravada::Request->create_domain( 
102
        name => $name
Francesc Guasch's avatar
Francesc Guasch committed
103
        ,id_iso => search_id_iso('Alpine')
Francesc Guasch's avatar
Francesc Guasch committed
104
        ,disk => 1024 * 1024
105
        ,@ARG_CREATE_DOM
106
107
108
        );
    };
    ok(!$@,"Expecting \$@=''  , got='".($@ or '')."'") or return;
109
110
    ok($req);
    ok($req->status);
111
    ok($req->args('id_owner'));
112
113

    
114
115
116
117
118
119
    ok(defined $req->args->{name} 
        && $req->args->{name} eq $name
            ,"Expecting args->{name} eq $name "
             ." ,got '".($req->args->{name} or '<UNDEF>')."'");

    ok($req->status eq 'requested'
120
        ,"$$ Status of request is ".$req->status." it should be requested");
121

Francesc Guasch's avatar
Francesc Guasch committed
122
    $ravada->process_requests();
123
124

    $ravada->_wait_pids();
125
    wait_request($req);
126
127

    ok($req->status eq 'done'
128
129
        ,"Status of request is ".$req->status." it should be done") or return ;
    ok(!$req->error,"Error ".$req->error." creating domain ".$name) or return ;
130
131
132

    my $n_expected = 1;
    test_unread_messages($USER, $n_expected, "[$vm_name] create domain $name");
133

134
    my $req2 = Ravada::Request->open($req->id);
135
    ok($req2->{id} == $req->id,"iso req2->{id} = ".$req2->{id}." , expecting ".$req->id);
136

137
    my $vm = $ravada->search_vm($vm_name);
138
    my $domain =  $vm->search_domain($name);
139

140
    ok($domain,"[$vm_name] I can't find domain $name");
141
142

    $USER->mark_all_messages_read();
143
144
145
    return $domain;
}

146
147
sub test_req_create_base {

Francesc Guasch's avatar
Francesc Guasch committed
148
149
    my $name = new_domain_name();

150
151
    my $req = Ravada::Request->create_domain( 
        name => $name
Francesc Guasch's avatar
Francesc Guasch committed
152
        ,disk => 1024 * 1024
153
        ,@ARG_CREATE_DOM
154
155
156
157
158
159
160
161
162
163
164
    );
    ok($req);
    ok($req->status);
    ok(defined $req->args->{name} 
        && $req->args->{name} eq $name
            ,"Expecting args->{name} eq $name "
             ." ,got '".($req->args->{name} or '<UNDEF>')."'");

    ok($req->status eq 'requested'
        ,"Status of request is ".$req->status." it should be requested");

165
    $ravada->_process_requests_dont_fork();
166
167
168
169
170
171
172

    ok($req->status eq 'done'
        ,"Status of request is ".$req->status." it should be done");
    ok(!$req->error,"Error ".$req->error." creating domain ".$name);

    my $domain =  $ravada->search_domain($name);

173
    ok($domain,"I can't find domain $name") && do {
174
        $domain->prepare_base(user_admin);
175
176
        ok($domain && $domain->is_base,"Domain $name should be base");
    };
177
178
179
180
    return $domain;
}


181
sub test_req_remove_domain_obj {
182
    my $vm = shift;
183
184
    my $domain = shift;

185
    my $domain_name = $domain->name;
186
    my $req = Ravada::Request->remove_domain(name => $domain->name, uid => user_admin->id);
Francesc Guasch's avatar
Francesc Guasch committed
187
    $ravada->_process_requests_dont_fork();
188

189
190
191
192
193
    ok($req->status eq 'done',ref($vm)." status ".$req->status." should be done");
    ok(!$req->error ,ref($vm)." error : '".$req->error."' , should be ''");
    my $domain2;
    eval { $domain2 =  $vm->search_domain($domain->name) };
    ok(!$domain2,ref($vm)." Domain $domain_name should be removed ");
194
195
196
197
198


}

sub test_req_remove_domain_name {
199
    my $vm = shift;
200
201
    my $name = shift;

202
    my $req = Ravada::Request->remove_domain(name => $name, uid => user_admin()->id);
203

204
205
206
207
    rvd_back->_process_all_requests_dont_fork();

    ok($req->status eq 'done',ref($vm)." status ".$req->status." should be done");
    ok(!$req->error ,ref($vm)." error : '".$req->error."' , should be ''");
208

209
    my $domain =  $vm->search_domain($name);
210
    ok(!$domain,ref($vm)." Domain $name should be removed") or exit;
211
212
213
214
    ok(!$req->error,"Error ".$req->error." removing domain $name");

}

215
sub test_unread_messages {
216
217
    my ($user, $n_unread, $test) = @_;
    confess "Missing test name" if !$test;
218
219
220

    my @messages = $user->unread_messages();

221
    ok(scalar @messages == $n_unread,"$test: Expecting $n_unread unread messages , got "
222
223
224
225
226
        .scalar@messages." ".Dumper(\@messages));

    $user->mark_all_messages_read();
}

227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
sub test_requests_by_domain {
    my $vm_name = shift;

    my $vm = rvd_back->search_vm($vm_name);
    my $domain = create_domain($vm_name, user_admin);
    ok($domain,"Expecting new domain created") or exit;

    my $req1 = Ravada::Request->prepare_base(uid => user_admin->id, id_domain => $domain->id);
    ok($domain->list_requests == 1);

    my $req2 = Ravada::Request->remove_base(uid => user_admin->id, id_domain => $domain->id);
    ok($domain->list_requests == 2);

    my $clone_name = new_domain_name();
    my $req_clone = Ravada::Request->create_domain (
        name => $clone_name
        ,id_owner => user_admin->id
        ,id_base => $domain->id
        ,vm => $vm_name
    );

248
    my $req4 = Ravada::Request->prepare_base(uid => user_admin->id, id_domain => $domain->id);
Francesc Guasch's avatar
Francesc Guasch committed
249
    is($domain->list_requests,3,Dumper([map { $_->{command} } $domain->list_requests]));
250

Francesc Guasch's avatar
Francesc Guasch committed
251
    rvd_back->_process_all_requests_dont_fork();
252
    wait_request();
253
254
255
256
257
258
259
260
261
262
263
264
265

    is($req1->status , 'done');
    is($req2->status , 'done');

    is($req4->status , 'done');
    is($domain->is_base,1) or exit;

    my $req4b = Ravada::Request->open($req4->id);
    is($req4b->status , 'done') or exit;

    rvd_back->_process_all_requests_dont_fork();
    like($req_clone->status,qr(done)) or exit;
    is($req_clone->error, '') or exit;
266
267
268
269

    my $clone = $vm->search_domain($clone_name);
    ok($clone,"Expecting domain $clone_name created") or exit;
}
270

271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
sub test_req_many_clones {
    my ($vm, $base) = @_;

    is(scalar $base->clones , 0, Dumper([$base->clones]));

    my ($name1, $name2) = (new_domain_name, new_domain_name);
    my $req1 = Ravada::Request->clone(
        name => $name1
        ,uid => user_admin->id
        ,id_domain => $base->id
    );
    my $req2 = Ravada::Request->clone(
        name => $name2
        ,uid => user_admin->id
        ,id_domain => $base->id
    );

    rvd_back->_process_all_requests_dont_fork();
    rvd_back->_process_all_requests_dont_fork();

    is($req1->status, 'done');
    is($req1->error, '');

    is($req2->status, 'done');
    is($req2->error, '');

    my $clone1 = rvd_back->search_domain($name1);
    ok($clone1,"Expecting clone $name1 created");

    my $clone2 = rvd_back->search_domain($name2);
    ok($clone2,"Expecting clone $name2 created");

    $clone1->remove(user_admin) if $clone1;
    $clone2->remove(user_admin) if $clone2;

    is(scalar $base->clones , 0, Dumper([$base->clones]));
}

309
################################################
Francesc Guasch's avatar
Francesc Guasch committed
310
eval { $ravada = rvd_back () };
311

312
ok($ravada,"I can't launch a new Ravada");# or exit;
313
314
remove_old_domains();
remove_old_disks();
315

Francesc Guasch's avatar
Francesc Guasch committed
316
for my $vm_name ( vm_names() ) {
317
318
319
    my $vm;
    eval {
        $vm= $ravada->search_vm($vm_name)  if $ravada;
320
        @ARG_CREATE_DOM = ( id_iso => search_id_iso('alpine'), vm => $vm_name, id_owner => $USER->id , disk => 1024 * 1024 )       if $vm;
321
    };
322

323
    SKIP: {
Francesc Guasch's avatar
Francesc Guasch committed
324
        my $msg = "SKIPPED: No $vm_name found";
325
        if ($vm && $vm_name =~ /kvm/i && $>) {
Francesc Guasch's avatar
Francesc Guasch committed
326
            $msg = "SKIPPED $vm_name: Test must run as root";
327
328
            $vm = undef;
        }
Francesc Guasch's avatar
Francesc Guasch committed
329
        diag($msg)      if !$vm;
330
331
        skip($msg,10)   if !$vm;
    
Francesc Guasch's avatar
Francesc Guasch committed
332
        diag("Testing $vm_name requests with ".(ref $vm or '<UNDEF>'));
333
    
334
        test_requests_by_domain($vm_name);
335
336
        my $domain_iso0 = test_req_create_domain_iso($vm_name);
        test_req_remove_domain_obj($vm, $domain_iso0)         if $domain_iso0;
337
    
338
339
        my $domain_iso = test_req_create_domain_iso($vm_name);
        test_req_remove_domain_name($vm, $domain_iso->name)  if $domain_iso;
340
    
341
        my $domain_base = test_req_create_base($vm);
342
        if ($domain_base) {
343
            $domain_base->is_public(1);
344
            is ($domain_base->_vm->readonly, 0) or next;
345

346
            my $domain_clone = $domain_base->clone(user => $USER, name => new_domain_name);
Francesc Guasch's avatar
Francesc Guasch committed
347
348
349
350
            $domain_clone = Ravada::Domain->open($domain_clone->id);
            meta_ok($domain_clone,'Ravada::Domain::KVM');
            does_ok($domain_clone, 'Ravada::Domain');
            role_wraps_after_method_ok 'Ravada::Domain',('remove');
351
352
            test_req_start_domain($vm,$domain_clone->name);
            $domain_clone->remove($USER);
Francesc Guasch's avatar
Francesc Guasch committed
353
            is(scalar @{rvd_front->list_domains( id => $domain_clone->id)}, 0) or exit;
354
355

            test_req_many_clones($vm, $domain_base);
356
357
            test_req_remove_domain_name($vm, $domain_base->name);
        }
358

359
360
    };
}
361

362
end();
363
done_testing();