n10_nodes.t 35.2 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
12
use Test::More;
use Test::SQL::Data;

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

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

16
17
18
19
20
21
22
23
24
25
26
my $test = Test::SQL::Data->new(config => 't/etc/sql.conf');

use_ok('Ravada');
my %ARG_CREATE_DOM = (
      KVM => [ id_iso => 1 ]
);

my @VMS = reverse keys %ARG_CREATE_DOM;
init($test->connector);
my $USER = create_user("foo","bar");

Francesc Guasch's avatar
Francesc Guasch committed
27
28
my $REMOTE_CONFIG;
##########################################################
29

Francesc Guasch's avatar
Francesc Guasch committed
30
31
32
33
34
35
sub test_node_renamed {
    my $vm_name = shift;
    my $node = shift;

    my $name = $node->name;

36
    my $name2 = "knope_".new_domain_name();
Francesc Guasch's avatar
Francesc Guasch committed
37
38
39
40
41
42
43
44

    my $sth= $test->connector->dbh->prepare(
        "UPDATE vms SET name=? WHERE name=?"
    );
    $sth->execute($name2, $name);
    $sth->finish;

    my $node2 = Ravada::VM->open($node->id);
45
46
47
    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
48
49
50
51
52

    my $rvd_back2 = Ravada->new(
        connector => $test->connector
        ,config => "t/etc/ravada.conf"
    );
53
    is(scalar(@{rvd_back->vm}), scalar(@{$rvd_back2->vm}),Dumper(rvd_back->vm)) or return;
54
    my @list_nodes2 = rvd_front->list_vms;
55

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

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

62
63
64
    @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));
65

Francesc Guasch's avatar
Francesc Guasch committed
66
67
}

Francesc Guasch's avatar
Francesc Guasch committed
68
69
sub test_node {
    my $vm_name = shift;
70

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

Francesc Guasch's avatar
Francesc Guasch committed
74
75
76
    my $vm = rvd_back->search_vm($vm_name);

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

Francesc Guasch's avatar
Francesc Guasch committed
79
80
    eval { $node = $vm->new(%{$REMOTE_CONFIG}) };
    ok(!$@,"Expecting no error connecting to $vm_name at ".Dumper($REMOTE_CONFIG).", got :'"
81
        .($@ or '')."'") or return;
Francesc Guasch's avatar
Francesc Guasch committed
82
83
    ok($node) or return;

84
    is($node->type,$vm->type) or return;
85

Francesc Guasch's avatar
Francesc Guasch committed
86
    is($node->host,$REMOTE_CONFIG->{host});
87
88
89
90
    is($node->name,$REMOTE_CONFIG->{name}) or return;

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

92
93
94
95
96
97
98
99
100
101
102
103
    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);
        }
    }
104
    start_node($node);
Francesc Guasch's avatar
Francesc Guasch committed
105

106
107
    clean_remote_node($node);

108
    { $node->vm };
109
    is($@,'')   or return;
Francesc Guasch's avatar
Francesc Guasch committed
110

111
112
    ok($node->id) or return;
    is($node->is_active,1) or return;
113

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

116
117
118
    my $node2 = Ravada::VM->open($node->id);
    is($node2->id, $node->id);
    is($node2->name, $node->name);
Francesc Guasch's avatar
Francesc Guasch committed
119
    is($node2->public_ip, $node->public_ip);
120
    ok(!$node2->is_local,"[$vm_name] node remote") or return;
121

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

125
126
127
128
    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);
129
    my @list_nodes2 = rvd_front->list_vms;
130
131
132
133
    ($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
134
135
136
137
    return $node;
}

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

Francesc Guasch's avatar
Francesc Guasch committed
140
    eval { $clone->rsync($node) };
Francesc Guasch's avatar
Francesc Guasch committed
141
    is(''.$@,'') or return;
Francesc Guasch's avatar
Francesc Guasch committed
142
143
    # TODO test synced files

Francesc Guasch's avatar
Francesc Guasch committed
144
145
146
147
148
    eval { $base->rsync($node) };
    is($@,'') or return;

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

151
152
153
154
155
156
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
157
158

    is($domain_ip->remote_ip, $ip);
159
160
161
162
163
164
165
166
167
168
169
    $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
170
171
sub test_domain {
    my $vm_name = shift;
Francesc Guasch's avatar
Francesc Guasch committed
172
    my $node = shift or die "Missing node";
173
    my $remote_ip = shift;
Francesc Guasch's avatar
Francesc Guasch committed
174
175
176
177
178
179
180

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

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

    $base->prepare_base(user_admin);
181
    $base->migrate_base(node => $node, user => user_admin);
Francesc Guasch's avatar
Francesc Guasch committed
182
183
184
185
    my $clone = $base->clone(name => new_domain_name
        ,user => user_admin
    );

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

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

191
192
193
194
195
    my @start_arg = ( user => user_admin );
    push @start_arg , ( remote_ip => $remote_ip )   if $remote_ip;

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

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

199
    my $local_ip = $node->ip;
200

201
202
203
204
205
206
207
208
    $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
209
210
    return $clone;
}
211

212
213
214
215
216
217
218
219
220
221
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));
}
222
223
224
225
226
227
228
229
230
231
232
233

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

    my $domain;
    eval {
        $domain = $node->create_domain(
            name => new_domain_name
            ,id_owner => user_admin->id
            ,id_iso => 1
        );
    };
Francesc Guasch's avatar
Francesc Guasch committed
234
    like($@,qr'.',"Expecting no domain in remote node by now");
235
236
237
238

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

239
240
sub test_remove_domain_from_local {
    my ($vm_name, $node, $domain_orig) = @_;
241
    $domain_orig->shutdown_now(user_admin)   if $domain_orig->is_active;
242
243
244
245
246
247
248

    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
249
    is(''.$@,'',"Expecting no errors removing domain ".$domain_orig->name);
250
251
252
253
254

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

    my $domain3 = $node->search_domain($domain->name);
255
    ok(!$domain3,"Expecting no domain ".$domain->name." in node ".$node->name) or return;
256
257
258
259
260
261
262

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

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


263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
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
282
283
284
285
    if ($node->type ne 'KVM') {
        diag("SKIPPING: test_remove_domain_node skipped on ".$node->type);
        return;
    }
286
287
288
289
290
291
292
293
294
295
    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) {
296
        ok(!$found{$path},$node->name." Expecting vol $path removed")
297
            or return;
298
299
300
    }

}
301
302

sub test_domain_starts_in_same_vm {
303
304
305
306
307
308
    my ($vm_name, $node) = @_;

    my $domain = test_domain($vm_name, $node);

    my $display = $domain->display(user_admin);
    $domain->shutdown_now(user_admin)   if $domain->is_active;
309
310
311
312
313
314
315

    unlike($domain->_vm->host, qr/localhost/)   or return;
    is($domain->_vm->host, $node->host)         or return;

    my $domain2 = rvd_back->search_domain($domain->name);
    ok($domain2,"Expecting a domain called ".$domain->name) or return;

316
    $domain2->start(user => user_admin);
317
    is($domain2->_vm->host, $node->host);
318
319
320
    is($domain2->display(user_admin), $display);

    $domain->remove(user_admin);
321
}
322

323
324
325
326
327
sub test_sync_base {
    my ($vm_name, $node) = @_;

    my $vm =rvd_back->search_vm($vm_name);
    my $base = create_domain($vm_name);
328
    $base->add_volume(name => 'vdb', swap => 1, size => 512*1024 );
329
330
331
332
333
334
335
336
    my $clone = $base->clone(
        name => new_domain_name
       ,user => user_admin
    );

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

337
    eval { $base->migrate_base(user => user_admin, vm => $node); };
338
339
    is(''.$@,'');

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

343
344
    $clone->start(user_admin);
    $clone->shutdown_now(user_admin);
345
346
347
348
349
350
351
352
353
354
355
356
    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(''.$@,'');

357
358
    is($clone2->_data('id_vm'),$node->id);

359
360
    my $clone3 = $node->search_domain($clone2->name);
    ok($clone3,"[$vm_name] expecting ".$clone2->name." found in "
361
                .$node->host) or exit;
362

363
364
365
366
    my $domains = rvd_front->list_domains();
    my ($clone_f) = grep { $_->{name} eq $clone2->name } @$domains;
    ok($clone_f);
    is($clone_f->{id}, $clone2->id);
367
    is($clone_f->{node}, $clone2->_vm->name);
368
    is($clone_f->{id_vm}, $node->id);
369

370
371
372
373
374
375
376
377
    $clone->remove(user_admin);
    $base->remove(user_admin);

}

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

378
    if ($vm_name ne 'KVM' && $vm_name ne 'Void') {
Francesc Guasch's avatar
Francesc Guasch committed
379
380
381
382
        diag("SKIPPED: start_twice not available on $vm_name");
        return;
    }

383
384
385
386
387
388
    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
    );
389
390
    $clone->shutdown_now(user_admin)    if $clone->is_active;
    is($clone->is_active,0);
391

392
393
    eval { $base->set_base_vm(vm => $node, user => user_admin); };
    is(''.$@,'') or return;
394

395
    $clone->start(user_admin) if !$clone->is_active();
396
    my $display0 = $clone->display(user_admin);
397
    $clone->shutdown_now(user_admin) if $clone->is_active();
398

399
    eval { $clone->migrate($node); };
400
    is(''.$@,'')    or return;
401

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

404
    is($clone->is_active,0);
405

406
    # clone should be inactive in local node
407
408
    my $clone2 = $vm->search_domain($clone->name);
    is($clone2->_vm->host, $vm->host);
409
    is($clone2->is_active,0);
410

411
    start_domain_internal($clone2);
412
413

    eval { $clone->start(user => user_admin ) };
414
415
416
    like(''.$@,qr'libvirt error code: 55,',$clone->name)
        if $vm_name eq 'KVM' && $@;
    is($clone->is_active,1);
417
418
    is($clone->_vm->host, $vm->host,"[$vm_name] Expecting ".$clone->name." in ".$vm->ip)
        or return;
419
    is($clone->display(user_admin), $clone2->display(user_admin));
420
    isnt($clone->display(user_admin), $display0, $clone->name) or exit;
421
422
423
424
425
426

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

}

427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
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 $@;

448
449
    is($clone2->list_requests,2);
    for ( 1 .. 6 ) {
450
451
        for ( 1 .. 10 ) {
            last if !$clone->is_active
452
            && !$clone_local->is_active;
453
            sleep 1;
454
            rvd_back->_process_all_requests_dont_fork();
455
        }
456
457
458
    }
    rvd_back->_process_all_requests_dont_fork();

459
460
    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;
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485

    $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();
486
    for ( 1 .. 120 ) {
487
488
489
        last if $clone->is_active
                && !$clone_local->is_active
                && !$clone_local->is_hibernated;
490
491
        sleep 1;
    }
492
    rvd_back->_process_all_requests_dont_fork();
493

494
495
    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;
496
497
498
499
500

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

501
502
503
504
505
506
507
508
509
510
511
512
513
# 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);
514
    is($clone->status,'active');
515
516

    shutdown_domain_internal($clone);
517
    is($clone->status,'active');
518
519
520
521
    _write_in_volumes($clone);

    Ravada::Request->refresh_vms();

522
523
    rvd_back->_process_all_requests_dont_fork();
    is($clone->is_active,0);
524
525
526
527
528
529
530
531
532

    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;
    }

}
533

534
535
536
sub _create_clone($node) {

    my $vm =rvd_back->search_vm($node->type);
537
    is($vm->is_local,1);
538
539
    is($node->is_local,0);

540
    my $base = create_domain($vm->type);
541
542
543
544
545
546
547
    $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();
548
    my $clone = $base->clone(
549
        name => $clone_name
550
551
552
553
554
555
556
       ,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;
557
558
559
    for my $volume ( $clone->list_volumes ) {
        ok(-e $volume,"Expecting volume $volume of machine ".$clone->name);
    }
560
561

    eval { $clone->migrate($node); };
562
    is(''.$@,'')    or BAIL_OUT();
563
564
565
566
567
568

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

    return($base, $clone);
}

569
570
571
sub test_rsync_newer {
    my ($vm_name, $node) = @_;

572
    if ($vm_name ne 'KVM') {
573
        diag("Skipping: Volumes not implemented for $vm_name");
574
575
        return;
    }
576
    my $domain = test_domain($vm_name, $node) or return;
577
578
579
580
581
582
583
    $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);

584
585
    my $capacity;
    { # vols equal, then resize
586
    my $vol = $vm->search_volume($vol_name);
587
    ok($vol,"[$vm_name] expecting volume $vol_name")    or return;
588
    ok($vol->get_info,"[$vm_name] No info for remote vol "
589
        .Dumper($vol)) or return;
590

591
    my $vol_remote = $node->search_volume($vol_name);
592
    ok($vol_remote->get_info,"[$vm_name] No info for remote vol "
593
        .Dumper($vol_remote)) or return;
594
    is($vol_remote->get_info->{capacity}, $vol->get_info->{capacity});
595

596
    $capacity = int ($vol->get_info->{capacity} *1.5 );
597
598
    $vol->resize($capacity);
    }
599

600
    { # vols different
601
602
603
    my $vol2 = $vm->search_volume($vol_name);
    my $vol2_remote = $node->search_volume($vol_name);

604
605
606
607
608
    is($vol2->get_info->{capacity}, $capacity);
    isnt($vol2_remote->get_info->{capacity}, $capacity);
    isnt($vol2_remote->get_info->{capacity}, $vol2->get_info->{capacity});
    }

609
    # on starting it should sync
610
611
    is($domain->_vm->host, $node->host);
    $domain->start(user => user_admin);
612
    is($domain->_vm->host, $node->host);
613
614
615
616
617
618
619

    { # 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});
    }

620
    $domain->remove(user_admin);
621
622
}

623
624
625
626
627
628
629
sub test_bases_node {
    my ($vm_name, $node) = @_;

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

    my $domain = create_domain($vm_name);

630
631
632
633
634
635
    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');
636
637
638
639
640
641
642
643

    $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);

644
645
646
647
648
649
    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;
    }

650
651
652
653
654
    $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);
655
656
657
658
    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');
659

660
    user_admin->mark_all_messages_read();
661
662
663
664
665
    my $req = Ravada::Request->set_base_vm(
                uid => user_admin->id
             ,id_vm => $vm->id
         ,id_domain => $domain->id
    );
666
667
    rvd_back->_process_all_requests_dont_fork();
    is($req->status,'done') or die Dumper($req);
668
669
670
    is($req->error,'');
    is($domain->base_in_vm($vm->id), 1);

671
672
    is(scalar user_admin->unread_messages , 2, Dumper(user_admin->unread_messages));

673
674
675
676
677
    $req = Ravada::Request->remove_base_vm(
                uid => user_admin->id
             ,id_vm => $vm->id
         ,id_domain => $domain->id
    );
678
    rvd_back->_process_all_requests_dont_fork();
679
680
    eval { $domain->base_in_vm($vm->id)};
    like($@,qr'is not a base');
681
682
683
684

    $domain->remove(user_admin);
}

685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
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);
}

720
721
722
723
724
725
726
sub _disable_storage_pools {
    my $node = shift;
    for my $sp ($node->vm->list_all_storage_pools()) {
        $sp->destroy();
    }
}

727

728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
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) };
    like($@, qr'storage pools');
    is($domain->base_in_vm($node->id), undef);

    _enable_storage_pools($node);

    $domain->remove(user_admin);
}

759
760
761
762
763
764
765
766
767
768
769
770
sub test_clone_not_in_node {
    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);

771
772
773
774
775
776
    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) };
777
        is(''.$@,'',"[$vm_name] Clone of ".$domain->name." failed ".$clone1->name) or return;
778
        is($clone1->is_active,1);
779
780

    # search the domain in the underlying VM
Francesc Guasch's avatar
Francesc Guasch committed
781
782
783
784
785
786
787
788
        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);
        }
789
        last if $clone1->_vm->host ne $clones[0]->_vm->host;
790
791
792
    }


793
794
    isnt($clones[-1]->_vm->host, $clones[0]->_vm->host,"[$vm_name] "
        .$clones[-1]->name
795
        ." - ".$clones[0]->name) or return;
796
797
    for (@clones) {
        $_->remove(user_admin);
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
    }
    $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
817
    eval { $clone->migrate($node) };
818
    is(''.$@,'')                        or return;
819
    is($clone->_vm->host, $node->host);
820
    is($clone->_vm->id, $node->id) or return;
Francesc Guasch's avatar
Francesc Guasch committed
821

822
    is($clone->_data('id_vm'), $node->id) or return;
Francesc Guasch's avatar
Francesc Guasch committed
823
824
825
826
827

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

    eval { $clone->start(user_admin) };
832
    is(''.$@,'',$clone->name) or return;
833
    is($clone->is_active,1);
834
835
    is($clone->_vm->id, $node->id)  or return;
    is($clone->_vm->host, $node->host)  or return;
836
837
838
839
840
841
842
843
844
845
846

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

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

847
    { # clone is active, it should be found in node
848
849
    my $clone3 = rvd_back->search_domain($clone->name);
    is($clone3->id, $clone->id);
850
851
    is($clone3->_vm->host , $node->host,"Expecting ".$clone3->name
        ." in ".$node->host) or exit;
852
    }
853
854
855

    $clone->remove(user_admin);
    $domain->remove(user_admin);
856
}
857
858
859
860
861
862

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

    my $domain = create_domain($vm_name);
863
    eval { $domain->base_in_vm($vm->id) };
864
    like($@,qr'is not a base');
865
866
867
868
869

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

    $domain->remove_base(user_admin);
870
871
    eval { $domain->base_in_vm($vm->id) };
    like($@,qr'is not a base');
872
873
874

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

876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
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);
}

906
907
908
sub test_node_inactive($vm_name, $node) {

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

910
    hibernate_node($node);
911
912
913
914
    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
915

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

919
920
921
    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
922

923
    start_node($node);
Francesc Guasch's avatar
Francesc Guasch committed
924
925

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

}

934
sub test_sync_back($node) {
935
    diag("Testing sync back on remote non shared storage node");
936
937
938
939
940
941
942
943
944
945
946
    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);
947
948
    eval { $clone->start(user_admin) };
    is(''.$@,'',"[".$node->type."] expecting no error starting ".$clone->name) or exit;
949
950
    is($clone->_vm->host, $node->host);

951
    _write_in_volumes($clone);
952
953
954
955
956
957
958
    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);
959
    is ( $clone->is_active, 0 );
960
961
962
    for my $file ($clone->list_volumes) {
        my $md5 = _md5($file, $vm);
        my $md5_remote = _md5($file, $node);
963
964
        is( $md5_remote, $md5, "[".$node->type."] ".$clone->name." $file" )
                or exit;
965
    }
966
967
    $clone->remove(user_admin);
    $domain->remove(user_admin);
968
969
}

970
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