70_clone.t 3.06 KB
Newer Older
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
use warnings;
use strict;

use Data::Dumper;
use Test::More;
use Test::SQL::Data;

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

my $test = Test::SQL::Data->new(config => 't/etc/sql.conf');

use_ok('Ravada');

my $FILE_CONFIG = 't/etc/ravada.conf';

my $RVD_BACK = rvd_back($test->connector, $FILE_CONFIG);
my $RVD_FRONT= rvd_front($test->connector, $FILE_CONFIG);

my %ARG_CREATE_DOM = (
      KVM => [ id_iso => 1 ]
    ,Void => [ ]
);

my @ARG_RVD = ( config => $FILE_CONFIG,  connector => $test->connector);

my @VMS = reverse keys %ARG_CREATE_DOM;
my $USER = create_user("foo","bar");

###############################################################################

sub test_create_domain {
    my $vm_name = shift;

    my $ravada = Ravada->new(@ARG_RVD);
    my $vm = $ravada->search_vm($vm_name);
    ok($vm,"I can't find VM $vm_name") or return;

    my $name = new_domain_name();

    if (!$ARG_CREATE_DOM{$vm_name}) {
        diag("VM $vm_name should be defined at \%ARG_CREATE_DOM");
        return;
    }
    my @arg_create = @{$ARG_CREATE_DOM{$vm_name}};

    my $domain;
    eval { $domain = $vm->create_domain(name => $name
                    , id_owner => $USER->id
                    , @{$ARG_CREATE_DOM{$vm_name}})
    };

    ok($domain,"No domain $name created with ".ref($vm)." ".($@ or '')) or exit;
    ok($domain->name
        && $domain->name eq $name,"Expecting domain name '$name' , got "
        .($domain->name or '<UNDEF>')
        ." for VM $vm_name"
    );

    return $domain;
}

###############################################################################
remove_old_domains();
remove_old_disks();

for my $vm_name (reverse sort @VMS) {

    diag("Testing $vm_name VM") if $vm_name !~ /Void/i;

    my $CLASS= "Ravada::VM::$vm_name";

    use_ok($CLASS);
    my $vm;

    eval { $vm = $RVD_BACK->search_vm($vm_name) } if $RVD_BACK;

    SKIP: {
        my $msg = "SKIPPED test: No $vm_name VM found ";
        diag($msg)      if !$vm;
        skip $msg,10    if !$vm;

        my $domain = test_create_domain($vm_name);
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
        eval { $domain->start($USER) if !$domain->is_active() };
        is($@,'');
        ok($domain->is_active);
        $domain->shutdown_now($USER);

        my @domain = ( $domain);
        for my $n ( 1 .. 3 ) {

            my $name_clone = new_domain_name();
            my $clone1;
            my $base = $domain[$n-1];

            eval { $clone1 = $base->clone(name => $name_clone, user => $USER) };
            ok(!$@,"Expecting error='', got='".($@ or '')."'");
            ok($clone1,"Expecting new cloned domain from ".$base->name) or last;

            $clone1->shutdown_now($USER) if $clone1->is_active();
            eval { $clone1->start($USER) };
            is($@,'');
            ok($clone1->is_active);

            my $clone1b = $RVD_FRONT->search_domain($name_clone);
            ok($clone1b,"Expecting new cloned domain ".$name_clone);
            $clone1->shutdown_now($USER) if $clone1->is_active;
            ok(!$clone1->is_active);

            push @domain,($clone1);
        }
112
113
114
115
116
117
118
    }
}

remove_old_domains();
remove_old_disks();

done_testing();