n10_nodes.t 35.4 KB
Newer Older
1
2
3
4
5
use warnings;
use strict;

use Carp qw(confess);
use Data::Dumper;
6
use Digest::MD5;
7
8
9
10
11
use Test::More;

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

Francesc Guasch's avatar
Francesc Guasch committed
12
13
14
no warnings "experimental::signatures";
use feature qw(signatures);

15
16
use_ok('Ravada');

17
init();
18
19
my $USER = create_user("foo","bar");

Francesc Guasch's avatar
Francesc Guasch committed
20
21
my $REMOTE_CONFIG;
##########################################################
22

Francesc Guasch's avatar
Francesc Guasch committed
23
24
25
26
27
28
sub test_node_renamed {
    my $vm_name = shift;
    my $node = shift;

    my $name = $node->name;

29
    my $name2 = "knope_".new_domain_name();
Francesc Guasch's avatar
Francesc Guasch committed
30

31
    my $sth= connector->dbh->prepare(
Francesc Guasch's avatar
Francesc Guasch committed
32
33
34
35
36
37
        "UPDATE vms SET name=? WHERE name=?"
    );
    $sth->execute($name2, $name);
    $sth->finish;

    my $node2 = Ravada::VM->open($node->id);
38
39
40
    ok($node2,"Expecting a node id=".$node->id) or return;
    is($node2->name, $name2)                    or return;
    is($node2->id, $node->id)                   or return;
Francesc Guasch's avatar
Francesc Guasch committed
41
42

    my $rvd_back2 = Ravada->new(
43
        connector => connector
Francesc Guasch's avatar
Francesc Guasch committed
44
45
        ,config => "t/etc/ravada.conf"
    );
46
    $rvd_back2->_install();
47
    is(scalar(@{rvd_back->vm}), scalar(@{$rvd_back2->vm}),Dumper(rvd_back->vm)) or return;
48
    my @list_nodes2 = rvd_front->list_vms;
49

50
51
    my ($node_f) = grep { $_->{name} eq $name2} @list_nodes2;
    ok($node_f,"[$vm_name] expecting node $name2 in frontend ".Dumper(\@list_nodes2));
52
53
54
55

    $sth->execute($name,$name2);
    $sth->finish;

56
57
58
    @list_nodes2 = rvd_front->list_vms;
    ($node_f) = grep { $_->{name} eq $name} @list_nodes2;
    ok($node_f,"[$vm_name] expecting node $name in frontend ".Dumper(\@list_nodes2));
59

Francesc Guasch's avatar
Francesc Guasch committed
60
61
}

Francesc Guasch's avatar
Francesc Guasch committed
62
63
sub test_node {
    my $vm_name = shift;
64

65
66
67
    die "Error: missing host in remote config\n ".Dumper($REMOTE_CONFIG)
        if !$REMOTE_CONFIG->{host};

Francesc Guasch's avatar
Francesc Guasch committed
68
69
70
    my $vm = rvd_back->search_vm($vm_name);

    my $node;
Francesc Guasch's avatar
Francesc Guasch committed
71
72
    my @list_nodes0 = rvd_front->list_vms;

Francesc Guasch's avatar
Francesc Guasch committed
73
74
    eval { $node = $vm->new(%{$REMOTE_CONFIG}) };
    ok(!$@,"Expecting no error connecting to $vm_name at ".Dumper($REMOTE_CONFIG).", got :'"
75
        .($@ or '')."'") or return;
Francesc Guasch's avatar
Francesc Guasch committed
76
77
    ok($node) or return;

78
    is($node->type,$vm->type) or return;
79

Francesc Guasch's avatar
Francesc Guasch committed
80
    is($node->host,$REMOTE_CONFIG->{host});
81
82
83
84
    is($node->name,$REMOTE_CONFIG->{name}) or return;

    eval { $node->ping };
    is($@,'',"[$vm_name] ping ".$node->name);
Francesc Guasch's avatar
Francesc Guasch committed
85

86
87
88
89
90
91
92
93
94
95
96
97
    if ( $node->ping && !$node->_connect_ssh() ) {
        my $ssh;
        for ( 1 .. 10 ) {
            $ssh = $node->_connect_ssh();
            last if $ssh;
            sleep 1;
            diag("I can ping node ".$node->name." but I can't connect to ssh");
        }
        if (! $ssh ) {
            shutdown_node($node);
        }
    }
98
    start_node($node);
Francesc Guasch's avatar
Francesc Guasch committed
99

100
101
    clean_remote_node($node);

102
    { $node->vm };
103
    is($@,'')   or return;
Francesc Guasch's avatar
Francesc Guasch committed
104

105
106
    ok($node->id) or return;
    is($node->is_active,1) or return;
107

Francesc Guasch's avatar
Francesc Guasch committed
108
109
    ok(!$node->is_local,"[$vm_name] node remote");

110
111
112
    my $node2 = Ravada::VM->open($node->id);
    is($node2->id, $node->id);
    is($node2->name, $node->name);
Francesc Guasch's avatar
Francesc Guasch committed
113
    is($node2->public_ip, $node->public_ip);
114
    ok(!$node2->is_local,"[$vm_name] node remote") or return;
115

Francesc Guasch's avatar
Francesc Guasch committed
116
117
    my @list_nodes = $vm->list_nodes();
    is(scalar @list_nodes, 2,"[$vm_name] Expecting nodes") or return;
118

119
120
121
122
    my ($node_remote) = grep { $_->name eq $REMOTE_CONFIG->{name}} @list_nodes;
    ok($node_remote, "[$vm_name] Expecting node $REMOTE_CONFIG->{name} in back->list_nodes")
        or return;
    ok($node_remote->{type} eq $vm_name);
123
    my @list_nodes2 = rvd_front->list_vms;
124
125
126
127
    ($node_remote) = grep { $_->{name} eq $REMOTE_CONFIG->{name}} @list_nodes2;
    ok($node_remote, "[$vm_name] Expecting node $REMOTE_CONFIG->{name} in front->list_vms")
        or return;
    ok($node_remote->{type} eq $vm_name);
Francesc Guasch's avatar
Francesc Guasch committed
128
129
130
131
    return $node;
}

sub test_sync {
Francesc Guasch's avatar
Francesc Guasch committed
132
    my ($vm_name, $node, $base, $clone) = @_;
Francesc Guasch's avatar
Francesc Guasch committed
133

Francesc Guasch's avatar
Francesc Guasch committed
134
    eval { $clone->rsync($node) };
Francesc Guasch's avatar
Francesc Guasch committed
135
    is(''.$@,'') or return;
Francesc Guasch's avatar
Francesc Guasch committed
136
137
    # TODO test synced files

Francesc Guasch's avatar
Francesc Guasch committed
138
139
140
141
142
    eval { $base->rsync($node) };
    is($@,'') or return;

    eval { $clone->rsync($node) };
    is($@,'') or return;
Francesc Guasch's avatar
Francesc Guasch committed
143
144
}

145
146
147
148
149
150
sub test_domain_ip($vm_name, $node) {
    my $ip = '1.2.4.5';
    my $domain_ip = test_domain($vm_name, $node, $ip);

    my ($local_ip,$local_port)
        = $domain_ip->display(user_admin) =~ m{(\d+.\d+\.\d+\.\d+):(\d+)};
Francesc Guasch's avatar
Francesc Guasch committed
151
152

    is($domain_ip->remote_ip, $ip);
153
154
155
156
157
158
159
160
161
162
163
    $domain_ip->remove(user_admin);
    my @line = search_iptable_remote(
        node => $node
        , remote_ip => $ip
        , local_ip => $local_ip
        , local_port => $local_port
    );
    ok(scalar @line == 0,$node->type." There should be no iptables found $ip -> $local_ip:$local_port ".Dumper(\@line));

}

Francesc Guasch's avatar
Francesc Guasch committed
164
165
sub test_domain {
    my $vm_name = shift;
Francesc Guasch's avatar
Francesc Guasch committed
166
    my $node = shift or die "Missing node";
167
    my $remote_ip = shift;
Francesc Guasch's avatar
Francesc Guasch committed
168
169
170
171
172
173
174

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

    my $base = create_domain($vm_name);
    is($base->_vm->host, 'localhost');

    $base->prepare_base(user_admin);
175
    $base->migrate_base(node => $node, user => user_admin);
Francesc Guasch's avatar
Francesc Guasch committed
176
177
178
179
    my $clone = $base->clone(name => new_domain_name
        ,user => user_admin
    );

Francesc Guasch's avatar
Francesc Guasch committed
180
    test_sync($vm_name, $node, $base, $clone);
Francesc Guasch's avatar
Francesc Guasch committed
181

182
    eval { $clone->migrate($node) };
183
    is(''.$@ , '') or return;
Francesc Guasch's avatar
Francesc Guasch committed
184

185
186
187
188
189
    my @start_arg = ( user => user_admin );
    push @start_arg , ( remote_ip => $remote_ip )   if $remote_ip;

    eval { $clone->start(@start_arg) };

190
    ok(!$@,$node->name." Expecting no error, got ".($@ or ''));
191
    is($clone->is_active,1) or return;
Francesc Guasch's avatar
Francesc Guasch committed
192

193
    my $local_ip = $node->ip;
194

195
196
197
198
199
200
201
202
    $local_ip = $REMOTE_CONFIG->{public_ip}
        if $REMOTE_CONFIG->{public_ip};
    like($clone->display(user_admin),qr($local_ip));

    diag("SKIPPED: Add public_ip to remote_vm.conf to test nodes with 2 IPs")
        if !exists $REMOTE_CONFIG->{public_ip};
    my ($local_port) = $clone->display(user_admin) =~ m{:(\d+)};
    test_iptables($node, $remote_ip, $local_ip, $local_port)  if $remote_ip;
Francesc Guasch's avatar
Francesc Guasch committed
203
204
    return $clone;
}
205

206
207
208
209
210
211
212
213
214
215
sub test_iptables($node, $remote_ip, $local_ip, $local_port) {
    my @line = search_iptable_remote(
        node => $node
        , remote_ip => $remote_ip
        , local_ip => $local_ip
        , local_port => $local_port
    );
    ok(scalar @line,$node->type." No iptables found $remote_ip -> $local_ip:$local_port");
    ok(scalar @line == 1,$node->type." iptables should found only 1 found $remote_ip -> $local_ip:$local_port ".Dumper(\@line));
}
216

217
sub test_domain_on_remote {
218
219
220
221
222
223
224
    my ($vm_name, $node) = @_;

    my $domain;
    eval {
        $domain = $node->create_domain(
            name => new_domain_name
            ,id_owner => user_admin->id
225
            ,id_iso => search_id_iso('Alpine')
226
227
        );
    };
228
    is($@,'',"Expecting no domain in remote node by now");
229
230
231
232

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

233
234
sub test_remove_domain_from_local {
    my ($vm_name, $node, $domain_orig) = @_;
235
    $domain_orig->shutdown_now(user_admin)   if $domain_orig->is_active;
236
237
238
239
240
241
242

    my $vm = rvd_back->search_vm($vm_name);
    my $domain = $vm->search_domain($domain_orig->name);

    my @volumes = $domain->list_volumes();

    eval {$domain->remove(user_admin); };
Francesc Guasch's avatar
Francesc Guasch committed
243
    is(''.$@,'',"Expecting no errors removing domain ".$domain_orig->name);
244
245
246
247
248

    my $domain2 = $vm->search_domain($domain->name);
    ok(!$domain2,"Expecting no domain in local");

    my $domain3 = $node->search_domain($domain->name);
249
    ok(!$domain3,"Expecting no domain ".$domain->name." in node ".$node->name) or return;
250
251
252
253
254
255
256

    test_remove_domain_node($node, $domain, \@volumes);

    test_remove_domain_node($vm, $domain, \@volumes);
}


257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
sub test_remove_domain {
    my ($vm_name, $node, $domain) = @_;

    my @volumes = $domain->list_volumes();

    eval {$domain->remove(user_admin); };
    is($@,'');

    test_remove_domain_node($node, $domain, \@volumes);

    my $vm = rvd_back->search_vm($vm_name);
    isnt($vm->name, $node->name) or return;

    test_remove_domain_node($vm, $domain, \@volumes);
}

sub test_remove_domain_node {
    my ($node, $domain, $volumes) = @_;

Francesc Guasch's avatar
Francesc Guasch committed
276
277
278
279
    if ($node->type ne 'KVM') {
        diag("SKIPPING: test_remove_domain_node skipped on ".$node->type);
        return;
    }
280
281
282
283
284
285
286
287
288
289
    my %found = map { $_ => 0 } @$volumes;

    $node->_refresh_storage_pools();
    for my $pool ($node->vm->list_all_storage_pools()) {
        for my $vol ($pool->list_all_volumes()) {
            my $path = $vol->get_path();
            $found{$path}++ if exists $found{$path};
        }
    }
    for my $path (keys %found) {
290
        ok(!$found{$path},$node->name." Expecting vol $path removed")
291
            or return;
292
293
294
    }

}
295

296
297
298
299
300
sub test_sync_base {
    my ($vm_name, $node) = @_;

    my $vm =rvd_back->search_vm($vm_name);
    my $base = create_domain($vm_name);
301
    $base->add_volume(name => 'vdb', swap => 1, size => 512*1024 );
302
303
304
305
306
307
308
309
    my $clone = $base->clone(
        name => new_domain_name
       ,user => user_admin
    );

    eval { $clone->migrate($node); };
    like($@, qr'.');

310
    eval { $base->migrate_base(user => user_admin, vm => $node); };
311
312
    is(''.$@,'');

Francesc Guasch's avatar
Francesc Guasch committed
313
    is($base->base_in_vm($node->id),1,"Expecting domain ".$base->id
314
        ." base in node ".$node->id ) or return;
Francesc Guasch's avatar
Francesc Guasch committed
315

316
317
    $clone->start(user_admin);
    $clone->shutdown_now(user_admin);
318
319
320
321
322
323
324
325
326
327
328
329
    eval { $clone->migrate($node); };
    is(''.$@,'');

    is($clone->_vm->host, $node->host);
    $clone->shutdown_now(user_admin);

    my $clone2 = $vm->search_domain($clone->name);
    is($clone2->_vm->host, $vm->host);

    eval { $clone2->migrate($node); };
    is(''.$@,'');

330
331
    is($clone2->_data('id_vm'),$node->id);

332
333
    my $clone3 = $node->search_domain($clone2->name);
    ok($clone3,"[$vm_name] expecting ".$clone2->name." found in "
334
                .$node->host) or exit;
335

336
337
338
339
    my $domains = rvd_front->list_domains();
    my ($clone_f) = grep { $_->{name} eq $clone2->name } @$domains;
    ok($clone_f);
    is($clone_f->{id}, $clone2->id);
340
    is($clone_f->{node}, $clone2->_vm->name);
341
    is($clone_f->{id_vm}, $node->id);
342

343
344
345
346
347
348
349
350
    $clone->remove(user_admin);
    $base->remove(user_admin);

}

sub test_start_twice {
    my ($vm_name, $node) = @_;

351
    if ($vm_name ne 'KVM' && $vm_name ne 'Void') {
Francesc Guasch's avatar
Francesc Guasch committed
352
353
354
355
        diag("SKIPPED: start_twice not available on $vm_name");
        return;
    }

356
357
358
359
360
361
    my $vm =rvd_back->search_vm($vm_name);
    my $base = create_domain($vm_name);
    my $clone = $base->clone(
        name => new_domain_name
       ,user => user_admin
    );
362
363
    $clone->shutdown_now(user_admin)    if $clone->is_active;
    is($clone->is_active,0);
364

365
366
    eval { $base->set_base_vm(vm => $node, user => user_admin); };
    is(''.$@,'') or return;
367
368

    eval { $clone->migrate($node); };
369
    is(''.$@,'')    or return;
370

371
372
    is($clone->_vm->host, $node->host) or exit;

373
    is($clone->is_active,0);
374

375
    # clone should be inactive in local node
376
377
    my $clone2 = $vm->search_domain($clone->name);
    is($clone2->_vm->host, $vm->host);
378
    is($clone2->is_active,0);
379

380
381
382
383
384
    is($clone->_vm->id, $node->id);
    start_domain_internal($clone);
    is($clone->_vm->id, $node->id);

    is($clone->_vm->id, $node->id) or exit;
385
386

    eval { $clone->start(user => user_admin ) };
387
    is($clone->_vm->id, $node->id);
388
    is($clone->is_active,1);
389
390
391
    is($clone2->is_active,0);
    $clone2 = $vm->search_domain($clone->name);
    is($clone2->_vm->host, $vm->host,"[$vm_name] Expecting ".$clone->name." in ".$vm->ip)
392
        or return;
393
394
395
396
397

    my $clone_generic = Ravada::Domain->open($clone->id);
    is($clone_generic->is_active,1);
    is($clone_generic->_vm->host, $node->host,"[$vm_name] Expecting ".$clone->name
                                                        ." in ".$node->ip);
398
399
400
401
402
403

    $clone->remove(user_admin);
    $base->remove(user_admin);

}

404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
sub test_already_started_twice($vm_name, $node) {
    my ($base, $clone) = _create_clone($node);
    my $vm = rvd_back->search_vm($vm_name);

    diag("test start twice both already started");

    is($vm->is_local, 1);

    my $clone_local = $vm->search_domain($clone->name);
    is($clone_local->_vm->is_local, 1);

    start_domain_internal($clone);
    start_domain_internal($clone_local);

    is($clone->is_active, 1,"expecting clone active on remote");
    is($clone_local->is_active, 1, "expecting clone active on local");

    my $clone2 = rvd_back->search_domain($clone->name);
    eval { $clone2->start(user => user_admin) };
    like($@,qr/already running/)    if $@;

425
426
    is($clone2->list_requests,2);
    for ( 1 .. 6 ) {
427
428
        for ( 1 .. 10 ) {
            last if !$clone->is_active
429
            && !$clone_local->is_active;
430
            sleep 1;
431
            rvd_back->_process_all_requests_dont_fork();
432
        }
433
434
435
    }
    rvd_back->_process_all_requests_dont_fork();

436
437
    is($clone->is_active, 0,"[".$node->type."] expecting remote clone ".$clone->name." down") or exit;
    is($clone_local->is_active, 0,"[".$node->type."] expecting local clone down") or exit;
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462

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

sub test_already_started_hibernated($vm_name, $node) {
    my ($base, $clone) = _create_clone($node);
    my $vm = rvd_back->search_vm($vm_name);

    is($vm->is_local, 1);

    my $clone_local = $vm->search_domain($clone->name);
    is($clone_local->_vm->is_local, 1);

    start_domain_internal($clone);
    hibernate_domain_internal($clone_local);

    is($clone->is_active, 1,"expecting clone active on remote");
    is($clone_local->is_hibernated, 1, "expecting clone hibernated on local");

    my $clone2 = rvd_back->search_domain($clone->name);
    eval { $clone2->start(user => user_admin) };
    like($@,qr/already running/)    if $@;

    rvd_back->_process_all_requests_dont_fork();
463
    for ( 1 .. 120 ) {
464
465
466
        last if $clone->is_active
                && !$clone_local->is_active
                && !$clone_local->is_hibernated;
467
468
        sleep 1;
    }
469
    rvd_back->_process_all_requests_dont_fork();
470

471
472
    is($clone->is_active, 0,"[$vm_name] expected ".$clone->name." down");
    is($clone_local->is_active, 0,"[$vm_name] expected ".$clone->name." down") or exit;
473
474
475
476
477

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

478
479
480
481
482
483
484
485
486
487
488
489
490
# Test it shuts down and syncs back
sub test_shutdown_internal( $node ) {
    my ($base, $clone) = _create_clone($node);
    my $vm = rvd_back->search_vm($node->type);

    is($vm->is_local, 1);

    my $clone_local = $vm->search_domain($clone->name);
    is($clone_local->_vm->is_local, 1);
    is($clone_local->is_active, 0);

    start_domain_internal($clone);
    is($clone->is_active,1);
491
    is($clone->status,'active');
492
493

    shutdown_domain_internal($clone);
494
    is($clone->status,'active');
495
496
497
498
    _write_in_volumes($clone);

    Ravada::Request->refresh_vms();

499
500
    rvd_back->_process_all_requests_dont_fork();
    is($clone->is_active,0);
501
502
503
504
505
506
507
508

    for my $file ($clone_local->list_volumes) {
        my $md5 = _md5($file, $vm);
        my $md5_remote = _md5($file, $node);
        is( $md5_remote, $md5, "[".$node->type."] ".$clone->name." $file" )
                or exit;
    }

509
510
    $clone->remove(user_admin);
    $base->remove(user_admin);
511
}
512

513
514
515
sub _create_clone($node) {

    my $vm =rvd_back->search_vm($node->type);
516
    is($vm->is_local,1);
517
518
    is($node->is_local,0);

519
    my $base = create_domain($vm->type);
520
521
522
523
524
525
526
    $base->shutdown_now(user_admin) if $base->is_active;

    my $clone_name = new_domain_name();

    my $clone_remote = $node->search_domain($clone_name);
    ok(!$clone_remote,"[".$node->type."] expectin cleaned domain in node ".$node->name)
        or BAIL_OUT();
527
    my $clone = $base->clone(
528
        name => $clone_name
529
530
531
532
533
534
535
       ,user => user_admin
    );
    $clone->shutdown_now(user_admin)    if $clone->is_active;
    is($clone->is_active,0);

    eval { $base->set_base_vm(vm => $node, user => user_admin); };
    is(''.$@,'')    or return;
536
537
538
    for my $volume ( $clone->list_volumes ) {
        ok(-e $volume,"Expecting volume $volume of machine ".$clone->name);
    }
539
540

    eval { $clone->migrate($node); };
541
    is(''.$@,'')    or BAIL_OUT();
542
543
544
545
546
547

    is($clone->_vm->host, $node->host) or exit;

    return($base, $clone);
}

548
549
550
sub test_rsync_newer {
    my ($vm_name, $node) = @_;

551
    if ($vm_name ne 'KVM') {
552
        diag("Skipping: Volumes not implemented for $vm_name");
553
554
        return;
    }
555
    my $domain = test_domain($vm_name, $node) or return;
556
557
558
559
560
561
562
    $domain->shutdown_now(user_admin)   if $domain->is_active;

    my ($volume) = $domain->list_volumes();
    my ($vol_name) = $volume =~ m{.*/(.*)};

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

563
564
    my $capacity;
    { # vols equal, then resize
565
    my $vol = $vm->search_volume($vol_name);
566
    ok($vol,"[$vm_name] expecting volume $vol_name")    or return;
567
    ok($vol->get_info,"[$vm_name] No info for remote vol "
568
        .Dumper($vol)) or return;
569

570
    my $vol_remote = $node->search_volume($vol_name);
571
    ok($vol_remote->get_info,"[$vm_name] No info for remote vol "
572
        .Dumper($vol_remote)) or return;
573
    is($vol_remote->get_info->{capacity}, $vol->get_info->{capacity});
574

575
    $capacity = int ($vol->get_info->{capacity} *1.5 );
576
577
    $vol->resize($capacity);
    }
578

579
    { # vols different
580
581
582
    my $vol2 = $vm->search_volume($vol_name);
    my $vol2_remote = $node->search_volume($vol_name);

583
584
585
586
587
    is($vol2->get_info->{capacity}, $capacity);
    isnt($vol2_remote->get_info->{capacity}, $capacity);
    isnt($vol2_remote->get_info->{capacity}, $vol2->get_info->{capacity});
    }

588
    # on starting it should sync
589
590
    is($domain->_vm->host, $node->host);
    $domain->start(user => user_admin);
591
    is($domain->_vm->host, $node->host);
592
593
594
595
596
597
598

    { # syncs for start, so vols should be equal
    my $vol3 = $vm->search_volume($vol_name);
    my $vol3_remote = $node->search_volume($vol_name);
    is($vol3_remote->get_info->{capacity}, $vol3->get_info->{capacity});
    }

599
    $domain->remove(user_admin);
600
601
}

602
603
604
605
606
607
608
sub test_bases_node {
    my ($vm_name, $node) = @_;

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

    my $domain = create_domain($vm_name);

609
610
611
612
613
614
    eval { $domain->base_in_vm($domain->_vm->id)};
    like($@,qr'is not a base');

#    is($domain->base_in_vm($domain->_vm->id),1);
    eval { $domain->base_in_vm($node->id) };
    like($@,qr'is not a base');
615
616
617
618
619
620
621
622

    $domain->prepare_base(user_admin);
    is($domain->base_in_vm($domain->_vm->id), 1);
    is($domain->base_in_vm($node->id), undef);

    $domain->migrate($node);
    is($domain->base_in_vm($node->id), 1);

623
624
625
626
627
628
    for my $file ( $domain->list_files_base ) {
        my ($name) = $file =~ m{.*/(.*)};
        my $vol_path = $node->search_volume_path($name);
        ok($vol_path,"[$vm_name] Expecting file '$name' in node ".$node->name) or exit;
    }

629
630
631
632
633
    $domain->set_base_vm(vm => $node, value => 0, user => user_admin);
    is($domain->base_in_vm($node->id), 0);

    $domain->set_base_vm(vm => $vm, value => 0, user => user_admin);
    is($domain->is_base(),0);
634
635
636
637
    eval { is($domain->base_in_vm($vm->id), 0) };
    like($@,qr'is not a base');
    eval { is($domain->base_in_vm($node->id), 0) };
    like($@,qr'is not a base');
638

639
    user_admin->mark_all_messages_read();
640
641
642
643
644
    my $req = Ravada::Request->set_base_vm(
                uid => user_admin->id
             ,id_vm => $vm->id
         ,id_domain => $domain->id
    );
645
646
    rvd_back->_process_all_requests_dont_fork();
    is($req->status,'done') or die Dumper($req);
647
648
649
    is($req->error,'');
    is($domain->base_in_vm($vm->id), 1);

650
651
    is(scalar user_admin->unread_messages , 2, Dumper(user_admin->unread_messages));

652
653
654
655
656
    $req = Ravada::Request->remove_base_vm(
                uid => user_admin->id
             ,id_vm => $vm->id
         ,id_domain => $domain->id
    );
657
    rvd_back->_process_all_requests_dont_fork();
658
659
    eval { $domain->base_in_vm($vm->id)};
    like($@,qr'is not a base');
660
661
662
663

    $domain->remove(user_admin);
}

664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
sub test_clone_make_base {
    my ($vm_name, $node) = @_;

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

    my $domain = create_domain($vm_name);

    $domain->prepare_base(user_admin);
    is($domain->base_in_vm($domain->_vm->id), 1);

    is($domain->base_in_vm($node->id), undef) or exit;

    $domain->set_base_vm(vm => $node, user => user_admin);
    is($domain->base_in_vm($node->id), 1);

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

    $clone->migrate($node);
    eval { $clone->base_in_vm($node->id) };
    like($@,qr(is not a base));

    eval { $clone->base_in_vm($vm->id) };
    like($@,qr(is not a base));

    $clone->prepare_base(user_admin);
    is($clone->base_in_vm($vm->id),1);
    is($clone->base_in_vm($node->id),undef);

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

699
700
701
702
703
704
705
sub _disable_storage_pools {
    my $node = shift;
    for my $sp ($node->vm->list_all_storage_pools()) {
        $sp->destroy();
    }
}

706

707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
sub _enable_storage_pools {
    my $node = shift;
    for my $sp ($node->vm->list_all_storage_pools()) {
        $sp->create();
    }
}

sub test_bases_different_storage_pools {
    my ($vm_name, $node) = @_;
    return if $vm_name ne 'KVM';

    _disable_storage_pools($node);
    is(scalar($node->list_storage_pools),0);

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

    my $domain = create_domain($vm_name);

    $domain->prepare_base(user_admin);
    is($domain->base_in_vm($domain->_vm->id), 1);
    is($domain->base_in_vm($node->id), undef);

    eval {$domain->migrate($node) };
730
    like($@, qr'storage pool.*not found'i);
731
732
733
734
735
736
737
    is($domain->base_in_vm($node->id), undef);

    _enable_storage_pools($node);

    $domain->remove(user_admin);
}

738
739
740
sub test_clone_not_in_node {
    my ($vm_name, $node) = @_;

741
742
    diag("[$vm_name] Checking some clones go to other nodes");

743
744
745
746
747
    my $vm = rvd_back->search_vm($vm_name);

    my $domain = create_domain($vm_name);

    $domain->prepare_base(user_admin);
748
    is($domain->base_in_vm($vm->id), 1);
749
750
751
752
    $domain->set_base_vm(vm => $node, user => user_admin);

    is($domain->base_in_vm($node->id), 1);

753
754
755
756
757
758
    my @clones;
    for ( 1 .. 4 ) {
        my $clone1 = $domain->clone(name => new_domain_name, user => user_admin);
        push @clones,($clone1);
        is($clone1->_vm->host, 'localhost');
        eval { $clone1->start(user_admin) };
759
        is(''.$@,'',"[$vm_name] Clone of ".$domain->name." failed ".$clone1->name) or return;
760
        is($clone1->is_active,1);
761
762

    # search the domain in the underlying VM
Francesc Guasch's avatar
Francesc Guasch committed
763
764
765
766
767
768
769
770
        if ($vm_name eq 'KVM') {
            my $virt_domain;
            eval { $virt_domain = $clone1->_vm->vm
                                ->get_domain_by_name($clone1->name) };
            is(''.$@,'');
            ok($virt_domain,"Expecting ".$clone1->name." in "
                .$clone1->_vm->host);
        }
771
        last if $clone1->_vm->host ne $clones[0]->_vm->host;
772
773
774
    }


775
776
    isnt($clones[-1]->_vm->host, $clones[0]->_vm->host,"[$vm_name] "
        .$clones[-1]->name
777
        ." - ".$clones[0]->name.Dumper({map {$_->name => $_->_vm->host} @clones})) or exit;
778
779
    for (@clones) {
        $_->remove(user_admin);
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
    }
    $domain->remove(user_admin);
}

sub test_domain_already_started {
    my ($vm_name, $node) = @_;

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

    my $domain = create_domain($vm_name);

    $domain->prepare_base(user_admin);
    $domain->set_base_vm(vm => $node, user => user_admin);

    is($domain->base_in_vm($node->id), 1);

    my $clone = $domain->clone(name => new_domain_name, user => user_admin);
    is($clone->_vm->host, 'localhost');

Francesc Guasch's avatar
Francesc Guasch committed
799
    eval { $clone->migrate($node) };
800
    is(''.$@,'')                        or return;
801
    is($clone->_vm->host, $node->host);
802
    is($clone->_vm->id, $node->id) or return;
Francesc Guasch's avatar
Francesc Guasch committed
803

804
    is($clone->_data('id_vm'), $node->id) or return;
Francesc Guasch's avatar
Francesc Guasch committed
805
806
807
808
809

    {
        my $clone_copy = $node->search_domain($clone->name);
        ok($clone_copy,"[$vm_name] expecting domain ".$clone->name
                        ." in node ".$node->host
810
        ) or exit;
Francesc Guasch's avatar
Francesc Guasch committed
811
    }
812
813

    eval { $clone->start(user_admin) };
814
    is(''.$@,'',$clone->name) or return;
815
    is($clone->is_active,1);
816
817
    is($clone->_vm->id, $node->id)  or return;
    is($clone->_vm->host, $node->host)  or return;
818
819
820
821
822
823
824

    {
    my $clone2 = rvd_back->search_domain($clone->name);
    is($clone2->id, $clone->id);
    is($clone2->_vm->host , $clone->_vm->host);
    }

825
    my $sth = connector->dbh->prepare("UPDATE domains set id_vm=NULL WHERE id=?");
826
827
828
    $sth->execute($clone->id);
    $sth->finish;

829
    { # clone is active, it should be found in node
830
831
    my $clone3 = rvd_back->search_domain($clone->name);
    is($clone3->id, $clone->id);
832
833
    is($clone3->_vm->host , $node->host,"Expecting ".$clone3->name
        ." in ".$node->host) or exit;
834
    }
835
836
837

    $clone->remove(user_admin);
    $domain->remove(user_admin);
838
}
839
840
841
842
843
844

sub test_prepare_sets_vm {
    my $vm_name = shift;
    my $vm = rvd_back->search_vm($vm_name);

    my $domain = create_domain($vm_name);
845
    eval { $domain->base_in_vm($vm->id) };
846
    like($@,qr'is not a base');
847
848
849
850
851

    $domain->prepare_base(user_admin);
    is($domain->base_in_vm($vm->id),1);

    $domain->remove_base(user_admin);
852
853
    eval { $domain->base_in_vm($vm->id) };
    like($@,qr'is not a base');
854
855
856

    $domain->remove(user_admin);
}
Francesc Guasch's avatar
Francesc Guasch committed
857

858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
sub test_remove_base($node) {

    my $vm = rvd_back->search_vm($node->type, 'localhost');
    my $domain = create_domain($vm);
    $domain->prepare_base(user_admin);

    $domain->set_base_vm(vm => $node, user => user_admin);

    is($domain->base_in_vm($vm->id),1);
    is($domain->base_in_vm($node->id),1);

    $domain->remove_base_vm(vm => $node, user => user_admin);

    is($domain->base_in_vm($vm->id),1);
    is($domain->base_in_vm($node->id),0);

    $domain->set_base_vm(vm => $node, user => user_admin);
    is($domain->base_in_vm($node->id),1);

    $domain->remove_base_vm(user => user_admin, vm => $vm);

    is($domain->is_base,0);

    $domain->prepare_base(user_admin);
    is($domain->base_in_vm($vm->id),1);
    is($domain->base_in_vm($node->id),0);

    $domain->remove(user_admin);
}

Francesc Guasch's avatar
Francesc Guasch committed
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
sub test_remove_base_main($node) {

    my $vm = rvd_back->search_vm($node->type, 'localhost');
    my $domain = create_domain($vm);
    $domain->prepare_base(user_admin);

    $domain->set_base_vm(vm => $node, user => user_admin);

    is($domain->base_in_vm($vm->id),1);
    is($domain->base_in_vm($node->id),1);

    $domain->remove_base(user_admin);
    $domain->prepare_base(user_admin);

    is($domain->base_in_vm($vm->id),1);
    is($domain->base_in_vm($node->id),0) or exit;

    $domain->remove(user_admin);
}


909
910
911
sub test_node_inactive($vm_name, $node) {

    start_node($node);
Francesc Guasch's avatar
Francesc Guasch committed
912

913
    hibernate_node($node);
914
915
916
917
    is($node->ping, 0);
    is($node->_do_is_active,0);
    is($node->_data('is_active'), 0);
    is($node->is_active,0) or exit;
Francesc Guasch's avatar
Francesc Guasch committed
918

919
920
    my @list_nodes = rvd_front->list_vms;
    my ($node2) = grep { $_->{name} eq $node->name} @list_nodes;
Francesc Guasch's avatar
Francesc Guasch committed
921

922
923
924
    ok($node2,"[$vm_name] Expecting node called ".$node->name." in frontend")
        or return;
    is($node2->{is_active},0,Dumper($node2)) or return;
Francesc Guasch's avatar
Francesc Guasch committed
925

926
    start_node($node);
Francesc Guasch's avatar
Francesc Guasch committed
927
928

    for ( 1 .. 10 ) {
929
        last if $node->_do_is_active;
Francesc Guasch's avatar
Francesc Guasch committed
930
931
932
933
934
935
936
        sleep 1;
        diag("[$vm_name] waiting for node ".$node->name);
    }
    is($node->is_active,1,"[$vm_name] node ".$node->name." active");

}

937
sub test_sync_back($node) {
938
    diag("Testing sync back on remote non shared storage node");
939
940
941
942
943
944
945
946
947
948
949
    my $vm = rvd_back->search_vm($node->type, 'localhost');
    my $domain = create_domain($vm);
    $domain->prepare_base(user_admin);

    $domain->set_base_vm(vm => $node, user => user_admin);

    is($domain->base_in_vm($vm->id),1);
    is($domain->base_in_vm($node->id),1);

    my $clone = $domain->clone( name => new_domain_name(), user => user_admin );
    $clone->migrate($node);
950
951
    eval { $clone->start(user_admin) };
    is(''.$@,'',"[".$node->type."] expecting no error starting ".$clone->name) or exit;
952
953
    is($clone->_vm->host, $node->host);

954
    _write_in_volumes($clone);
955
956
957
958
959
960
961
    for my $file ($clone->list_volumes) {
        my $md5 = _md5($file, $vm);
        my $md5_remote = _md5($file, $node);
        isnt( $md5_remote, $md5, "[".$node->type."] ".$clone->name." $file" ) or exit;
    }

    _shutdown_nicely($clone);
962
    is ( $clone->is_active, 0 );
963
964
965
    for my $file ($clone->list_volumes) {
        my $md5 = _md5($file, $vm);
        my $md5_remote = _md5($file, $node);
966
967
        is( $md5_remote, $md5, "[".$node->type."] ".$clone->name." $file" )
                or exit;
968
    }
969
970
    $clone->remove(user_admin);
    $domain->remove(user_admin);
971
972
}

973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
sub test_migrate_back($node) {
    diag("Testing migrate back from remote non shared storage node");
    my $vm = rvd_back->search_vm($node->type, 'localhost');
    my $domain = create_domain($vm);
    $domain->prepare_base(user_admin);

    $domain->set_base_vm(vm => $node, user => user_admin);

    is($domain->base_in_vm($vm->id),1);
    is($domain->base_in_vm($node->id),1);

    my $clone = $domain->clone( name => new_domain_name(), user => user_admin );
    $clone->migrate($node);
    eval { $clone->start(user_admin) };
    is(''.$@,'',"[".$node->type."] expecting no error starting ".$clone->name) or exit;
    is($clone->_vm->host, $node->host);

    _write_in_volumes($clone);

    shutdown_domain_internal($clone);

    eval { $clone->migrate($vm) };
    is($@, '');

    for my $file ($clone->list_volumes) {
        my $md5 = _md5($file, $vm);
        my $md5_remote = _md5($file, $node);
        is( $md5_remote, $md5, "[".$node->type."] ".$clone->name." $file" ) or exit;
For faster browsing, not all history is shown. View entire blame