n10_nodes.t 26.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
    shutdown_node($node)   if $node->ping && !$node->_connect_ssh();
    start_node($node);
Francesc Guasch's avatar
Francesc Guasch committed
94

95
96
    clean_remote_node($node);

97
    { $node->vm };
98
    is($@,'')   or return;
Francesc Guasch's avatar
Francesc Guasch committed
99

100
101
    ok($node->id) or return;
    is($node->is_active,1) or return;
102

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

105
106
107
    my $node2 = Ravada::VM->open($node->id);
    is($node2->id, $node->id);
    is($node2->name, $node->name);
Francesc Guasch's avatar
Francesc Guasch committed
108
    is($node2->public_ip, $node->public_ip);
109
    ok(!$node2->is_local,"[$vm_name] node remote") or return;
110

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

114
    my @list_nodes2 = rvd_front->list_vms;
Francesc Guasch's avatar
Francesc Guasch committed
115
116
    is(scalar @list_nodes2, (scalar @list_nodes)+1,Dumper(\@list_nodes2,\@list_nodes)) or return;
    is(scalar @list_nodes2, (scalar @list_nodes0)+1,Dumper(\@list_nodes2,\@list_nodes0)) or return;
Francesc Guasch's avatar
Francesc Guasch committed
117
118
119
120
    return $node;
}

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

Francesc Guasch's avatar
Francesc Guasch committed
123
    eval { $clone->rsync($node) };
Francesc Guasch's avatar
Francesc Guasch committed
124
    is(''.$@,'') or return;
Francesc Guasch's avatar
Francesc Guasch committed
125
126
    # TODO test synced files

Francesc Guasch's avatar
Francesc Guasch committed
127
128
129
130
131
    eval { $base->rsync($node) };
    is($@,'') or return;

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

134
135
136
137
138
139
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
140
141

    is($domain_ip->remote_ip, $ip);
142
143
144
145
146
147
148
149
150
151
152
    $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
153
154
sub test_domain {
    my $vm_name = shift;
Francesc Guasch's avatar
Francesc Guasch committed
155
    my $node = shift or die "Missing node";
156
    my $remote_ip = shift;
Francesc Guasch's avatar
Francesc Guasch committed
157
158
159
160
161
162
163

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

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

    $base->prepare_base(user_admin);
164
    $base->rsync($node);
Francesc Guasch's avatar
Francesc Guasch committed
165
166
167
168
    my $clone = $base->clone(name => new_domain_name
        ,user => user_admin
    );

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

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

174
175
176
177
178
    my @start_arg = ( user => user_admin );
    push @start_arg , ( remote_ip => $remote_ip )   if $remote_ip;

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

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

182
    my $local_ip = $node->ip;
183

184
185
186
187
188
189
190
191
    $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
192
193
    return $clone;
}
194

195
196
197
198
199
200
201
202
203
204
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));
}
205
206
207
208
209
210
211
212
213
214
215
216

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
217
    like($@,qr'.',"Expecting no domain in remote node by now");
218
219
220
221

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

222
223
sub test_remove_domain_from_local {
    my ($vm_name, $node, $domain_orig) = @_;
224
    $domain_orig->shutdown_now(user_admin)   if $domain_orig->is_active;
225
226
227
228
229
230
231

    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
232
    is(''.$@,'',"Expecting no errors removing domain ".$domain_orig->name);
233
234
235
236
237

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

    my $domain3 = $node->search_domain($domain->name);
238
    ok(!$domain3,"Expecting no domain ".$domain->name." in node ".$node->name) or return;
239
240
241
242
243
244
245

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

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


246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
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
265
266
267
268
    if ($node->type ne 'KVM') {
        diag("SKIPPING: test_remove_domain_node skipped on ".$node->type);
        return;
    }
269
270
271
272
273
274
275
276
277
278
    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) {
279
        ok(!$found{$path},$node->name." Expecting vol $path removed")
280
            or return;
281
282
283
    }

}
284
285

sub test_domain_starts_in_same_vm {
286
287
288
289
290
291
    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;
292
293
294
295
296
297
298

    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;

299
    $domain2->start(user => user_admin);
300
    is($domain2->_vm->host, $node->host);
301
302
303
    is($domain2->display(user_admin), $display);

    $domain->remove(user_admin);
304
}
305

306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
sub test_sync_base {
    my ($vm_name, $node) = @_;

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

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

    eval { $base->rsync($node); };
    is(''.$@,'');

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

325
326
327
328
329
330
331
332
333
334
335
336
    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(''.$@,'');

337
338
    is($clone2->_data('id_vm'),$node->id);

339
340
    my $clone3 = $node->search_domain($clone2->name);
    ok($clone3,"[$vm_name] expecting ".$clone2->name." found in "
341
                .$node->host) or return;
342

343
344
345
346
    my $domains = rvd_front->list_domains();
    my ($clone_f) = grep { $_->{name} eq $clone2->name } @$domains;
    ok($clone_f);
    is($clone_f->{id}, $clone2->id);
347
    is($clone_f->{node}, $clone2->_vm->name);
348
    is($clone_f->{id_vm}, $node->id);
349

350
351
352
353
354
355
356
357
    $clone->remove(user_admin);
    $base->remove(user_admin);

}

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

358
    if ($vm_name ne 'KVM' && $vm_name ne 'Void') {
Francesc Guasch's avatar
Francesc Guasch committed
359
360
361
362
        diag("SKIPPED: start_twice not available on $vm_name");
        return;
    }

363
364
365
366
367
368
    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
    );
369
370
    $clone->shutdown_now(user_admin)    if $clone->is_active;
    is($clone->is_active,0);
371

372
373
    eval { $base->set_base_vm(vm => $node, user => user_admin); };
    is(''.$@,'') or return;
374

375
376
    my $display0 = $clone->display(user_admin);

377
    eval { $clone->migrate($node); };
378
    is(''.$@,'')    or return;
379

380
381
382
    is($clone->_vm->host, $node->host) or exit;
    isnt($clone->display(user_admin), $display0, $clone->name) or exit;

383
    is($clone->is_active,0);
384

385
    # clone should be inactive in local node
386
387
    my $clone2 = $vm->search_domain($clone->name);
    is($clone2->_vm->host, $vm->host);
388
    is($clone2->is_active,0);
389

390
    # start the clone on local node internally
391
    if ($vm_name eq 'KVM') {
392
393
394
        eval { $clone2->domain->create() };
        is(''.$@ ,'' , "[$vm_name] Starting ".$clone2->name." from libvirt")
            or exit;
395
396
397
398
399
    } elsif ($vm_name eq 'Void') {
        $clone2->_store(is_active => 1);
    } else {
        die "test_start_twice not available on $vm_name";
    }
400
401

    eval { $clone->start(user => user_admin ) };
402
403
    like(''.$@,qr'libvirt error code: 55,',$clone->name) or exit
        if $vm_name eq 'KVM';
404
405
    is($clone->_vm->host, $vm->host,"[$vm_name] Expecting ".$clone->name." in ".$vm->ip)
        or return;
406
407
408
409
410
411
412
    is($clone->display(user_admin), $clone2->display(user_admin));

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

}

413
414
415
sub test_rsync_newer {
    my ($vm_name, $node) = @_;

416
    if ($vm_name ne 'KVM') {
417
        diag("Skipping: Volumes not implemented for $vm_name");
418
419
        return;
    }
420
    my $domain = test_domain($vm_name, $node) or return;
421
422
423
424
425
426
427
    $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);

428
429
    my $capacity;
    { # vols equal, then resize
430
    my $vol = $vm->search_volume($vol_name);
431
    ok($vol,"[$vm_name] expecting volume $vol_name")    or return;
432
    ok($vol->get_info,"[$vm_name] No info for remote vol "
433
        .Dumper($vol)) or return;
434

435
    my $vol_remote = $node->search_volume($vol_name);
436
    ok($vol_remote->get_info,"[$vm_name] No info for remote vol "
437
        .Dumper($vol_remote)) or return;
438
    is($vol_remote->get_info->{capacity}, $vol->get_info->{capacity});
439

440
    $capacity = int ($vol->get_info->{capacity} *1.5 );
441
442
    $vol->resize($capacity);
    }
443

444
    { # vols different
445
446
447
    my $vol2 = $vm->search_volume($vol_name);
    my $vol2_remote = $node->search_volume($vol_name);

448
449
450
451
452
    is($vol2->get_info->{capacity}, $capacity);
    isnt($vol2_remote->get_info->{capacity}, $capacity);
    isnt($vol2_remote->get_info->{capacity}, $vol2->get_info->{capacity});
    }

453
    # on starting it should sync
454
455
    is($domain->_vm->host, $node->host);
    $domain->start(user => user_admin);
456
    is($domain->_vm->host, $node->host);
457
458
459
460
461
462
463

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

464
    $domain->remove(user_admin);
465
466
}

467
468
469
470
471
472
sub test_bases_node {
    my ($vm_name, $node) = @_;

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

    my $domain = create_domain($vm_name);
473
    my $local_display = $domain->display(user_admin);
474

475
476
477
478
479
480
    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');
481
482
483
484
485
486

    $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);
487
    isnt($domain->display(user_admin), $local_display) or exit;
488
489
    is($domain->base_in_vm($node->id), 1);

490
491
492
493
494
495
    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;
    }

496
497
498
499
500
    $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);
501
502
503
504
    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');
505
506
507
508
509
510

    my $req = Ravada::Request->set_base_vm(
                uid => user_admin->id
             ,id_vm => $vm->id
         ,id_domain => $domain->id
    );
511
512
    rvd_back->_process_all_requests_dont_fork();
    is($req->status,'done') or die Dumper($req);
513
514
515
516
517
518
519
520
    is($req->error,'');
    is($domain->base_in_vm($vm->id), 1);

    $req = Ravada::Request->remove_base_vm(
                uid => user_admin->id
             ,id_vm => $vm->id
         ,id_domain => $domain->id
    );
521
    rvd_back->_process_all_requests_dont_fork();
522
523
    eval { $domain->base_in_vm($vm->id)};
    like($@,qr'is not a base');
524
525
526
527

    $domain->remove(user_admin);
}

528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
sub _disable_storage_pools {
    my $node = shift;
    for my $sp ($node->vm->list_all_storage_pools()) {
        $sp->destroy();
    }
}

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

566
567
568
569
570
571
572
573
574
575
576
577
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);

578
579
580
581
582
583
    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) };
584
        is(''.$@,'',"[$vm_name] Clone of ".$domain->name." failed ".$clone1->name) or return;
585
        is($clone1->is_active,1);
586
587

    # search the domain in the underlying VM
Francesc Guasch's avatar
Francesc Guasch committed
588
589
590
591
592
593
594
595
        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);
        }
596
        last if $clone1->_vm->host ne $clones[0]->_vm->host;
597
598
599
    }


600
601
    isnt($clones[-1]->_vm->host, $clones[0]->_vm->host,"[$vm_name] "
        .$clones[-1]->name
602
        ." - ".$clones[0]->name) or return;
603
604
    for (@clones) {
        $_->remove(user_admin);
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
    }
    $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
624
    eval { $clone->migrate($node) };
625
    is(''.$@,'')                        or return;
626
    is($clone->_vm->host, $node->host);
627
    is($clone->_vm->id, $node->id) or return;
Francesc Guasch's avatar
Francesc Guasch committed
628

629
    is($clone->_data('id_vm'), $node->id) or return;
Francesc Guasch's avatar
Francesc Guasch committed
630
631
632
633
634

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

    eval { $clone->start(user_admin) };
639
    is(''.$@,'',$clone->name) or return;
640
    is($clone->is_active,1);
641
642
    is($clone->_vm->id, $node->id)  or return;
    is($clone->_vm->host, $node->host)  or return;
643
644
645
646
647
648
649
650
651
652
653

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

654
    { # clone is active, it should be found in node
655
656
    my $clone3 = rvd_back->search_domain($clone->name);
    is($clone3->id, $clone->id);
657
658
    is($clone3->_vm->host , $node->host,"Expecting ".$clone3->name
        ." in ".$node->host) or exit;
659
    }
660
661
662

    $clone->remove(user_admin);
    $domain->remove(user_admin);
663
}
664
665
666
667
668
669

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

    my $domain = create_domain($vm_name);
670
    eval { $domain->base_in_vm($vm->id) };
671
    like($@,qr'is not a base');
672
673
674
675
676

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

    $domain->remove_base(user_admin);
677
678
    eval { $domain->base_in_vm($vm->id) };
    like($@,qr'is not a base');
679
680
681

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

683
684
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
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
713
714
715
sub test_node_inactive {
    my ($vm_name, $node) = @_;

716
    shutdown_node($node);
Francesc Guasch's avatar
Francesc Guasch committed
717
718
    is($node->is_active,0);

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

722
723
724
    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
725

726
    start_node($node);
Francesc Guasch's avatar
Francesc Guasch committed
727
728

    for ( 1 .. 10 ) {
729
        last if $node->_do_is_active;
Francesc Guasch's avatar
Francesc Guasch committed
730
731
732
733
734
735
736
        sleep 1;
        diag("[$vm_name] waiting for node ".$node->name);
    }
    is($node->is_active,1,"[$vm_name] node ".$node->name." active");

}

737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
sub test_sync_back($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);
    $clone->start(user_admin);
    _shutdown_nicely($clone);
    _write_in_volumes($clone);
    $clone->shutdown_now(user_admin)    if !$clone->is_active;
    for my $file ($clone->list_volumes) {
        my $md5 = _md5($file, $vm);
        my $md5_remote = _md5($file, $node);
        is($md5_remote, $md5);
    }
758
759
    $clone->remove(user_admin);
    $domain->remove(user_admin);
760
761
}

Francesc Guasch's avatar
Francesc Guasch committed
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
sub test_shutdown($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);
    my $remote_ip = '1.2.4.5';
    $clone->start(user => user_admin, remote_ip => $remote_ip);
    my ($local_ip,$local_port)
        = $clone->display(user_admin) =~ m{(\d+.\d+\.\d+\.\d+):(\d+)};

    is($clone->remote_ip, $remote_ip);

    if ($clone->type eq 'KVM') {
        $clone->domain->destroy();
    } elsif ($clone->type eq 'Void') {
        $clone->_store(is_active => 0);
    } else {
        diag("SKIPPED: I can't test shutdown of ".$node->type." nodes");
    }
    is($clone->is_active,0,"[".$clone->type."] Expecting clone ".$clone->name." inactive") or return;
Francesc Guasch's avatar
Francesc Guasch committed
790
    is($clone->_data('status'),'active',"[".$clone->type."] Expecting clone ".$clone->name." data active") or return;
Francesc Guasch's avatar
Francesc Guasch committed
791
792
793
794
795
796
797
798
799
800
801
802
803
804

    my $clone2 = Ravada::Domain->open($clone->id); #open will clean internal shutdown

    for my $file ($clone->list_volumes) {
        my $md5 = _md5($file, $vm);
        my $md5_remote = _md5($file, $node);
        is($md5_remote, $md5);
    }
    my @line = search_iptable_remote(
        node => $node
        , remote_ip => $remote_ip
        , local_ip => $local_ip
        , local_port => $local_port
    );
805
806
    ok(scalar @line == 0,"[".$node->type."] There should be no iptables found"
        ." $remote_ip -> $local_ip:$local_port ".Dumper(\@line)) ;
Francesc Guasch's avatar
Francesc Guasch committed
807

808
    $clone->remove(user_admin);
Francesc Guasch's avatar
Francesc Guasch committed
809
810
811
    $domain->remove(user_admin);
}

Francesc Guasch's avatar
Francesc Guasch committed
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
sub _md5($file, $vm) {
    if ($vm->is_local) {
        my  $ctx = Digest::MD5->new;
        open my $in,'<',$file or die "$! $file";
        $ctx->addfile($in);
        return $ctx->hexdigest;
    } else {
        my @md5 = $vm->run_command("md5sum $file");
        my $md5 = $md5[0];
        chomp $md5;
        $md5 =~ s/(.*?)\s+.*/$1/;
        return $md5;
    }
}

827
828
829
830
831
832
833
834
835
836
sub _shutdown_nicely($clone) {
    $clone->shutdown(user => user_admin);
    for ( 1 .. 2 ) {
        last if !$clone->is_active;
        sleep 1;
        diag("Waiting for ".$clone->name." shutdown")   if !$clone->is_active;
    }
    $clone->shutdown_now(user_admin);
}

837
838
839
840
841
842
sub _write_in_volumes($clone) {
    for my $file ($clone->list_volumes) {
        $clone->_vm->run_command("echo hola > $file");
    }
}

843
844
845
846
847
848
849
850
851
852
853
854
855
sub _domain_node($node) {
    my $vm = rvd_back->search_vm('KVM','localhost');
    my $domain = $vm->search_domain($node->name);
    $domain = rvd_back->import_domain(name => $node->name
            ,user => user_admin->name
            ,vm => 'KVM'
            ,spinoff_disks => 0
    )   if !$domain || !$domain->is_known;

    ok($domain->id,"Expecting an ID for domain ".Dumper($domain)) or exit;
    $domain->_set_vm($vm, 'force');
    return $domain;
}
Francesc Guasch's avatar
Francesc Guasch committed
856

857
#############################################################
858
clean();
Francesc Guasch's avatar
Francesc Guasch committed
859
clean_remote();
860

861
862
$Ravada::Domain::MIN_FREE_MEMORY = 256 * 1024;

863
for my $vm_name ('Void' , 'KVM' ) {
864
865
866
867
868
my $vm;
eval { $vm = rvd_back->search_vm($vm_name) };

SKIP: {

Francesc Guasch's avatar
Francesc Guasch committed
869
    my $msg = "SKIPPED: $vm_name virtual manager not found ".($@ or '');
Francesc Guasch's avatar
Francesc Guasch committed
870
    $REMOTE_CONFIG = remote_config($vm_name);
Francesc Guasch's avatar
Francesc Guasch committed
871
    if (!keys %$REMOTE_CONFIG) {
872
        my $msg = "skipped, missing the remote configuration for $vm_name in the file "
873
874
875
876
877
878
879
880
881
882
            .$Test::Ravada::FILE_CONFIG_REMOTE;
        diag($msg);
        skip($msg,10);
    }

    if ($vm && $vm_name =~ /kvm/i && $>) {
        $msg = "SKIPPED: Test must run as root";
        $vm = undef;
    }

Francesc Guasch's avatar
Francesc Guasch committed
883
    diag($msg)      if !$vm;
884
885
    skip($msg,10)   if !$vm;

886
    diag("Testing remote node in $vm_name");
887
    my $node = test_node($vm_name)  or next;
888

889
890
    ok($node->vm,"[$vm_name] expecting a VM inside the node") or do {
        remove_node($node);
891
        next;
892
    };
893
    test_bases_node($vm_name, $node);
Francesc Guasch's avatar
Francesc Guasch committed
894

895
    test_sync_base($vm_name, $node);
896
    test_sync_back($node);
897
    test_start_twice($vm_name, $node);
898

Francesc Guasch's avatar
Francesc Guasch committed
899
900
    test_shutdown($node);

901
902
    test_domain_ip($vm_name, $node);

Francesc Guasch's avatar
Francesc Guasch committed
903
904
    test_node_renamed($vm_name, $node);

905
906
    test_bases_different_storage_pools($vm_name, $node);

907
    test_domain_already_started($vm_name, $node);
908
    test_clone_not_in_node($vm_name, $node);
909
    test_rsync_newer($vm_name, $node);
910
    test_domain_no_remote($vm_name, $node);
Francesc Guasch's avatar
Francesc Guasch committed
911

912
913
914
915
916
917
    my $domain2 = test_domain($vm_name, $node);
    test_remove_domain_from_local($vm_name, $node, $domain2)    if $domain2;

    my $domain3 = test_domain($vm_name, $node);
    test_remove_domain($vm_name, $node, $domain3)               if $domain3;

918

919
        test_domain_starts_in_same_vm($vm_name, $node);
920
        test_prepare_sets_vm($vm_name, $node);
921

922
923
    test_remove_base($node);

Francesc Guasch's avatar
Francesc Guasch committed
924

925
926
    test_node_inactive($vm_name, $node);

927
    start_node($node);
928
    clean_remote_node($node);
929
    clean_remote_node($vm);
930
    remove_node($node);
Francesc Guasch's avatar
Francesc Guasch committed
931
}
932
933
934

}

935
END: {
936
clean();
937
clean_remote();
938
939

done_testing();
940
}