20_create_domain.t 3.3 KB
Newer Older
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
use warnings;
use strict;

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

use_ok('Ravada::Front');

my ($DOMAIN_NAME) = $0 =~ m{.*/(.*)\.t};
$DOMAIN_NAME = 'front_'.$DOMAIN_NAME;
my $CONT= 0;

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

16
17
18
19
20
21
22
23
24
my @rvd_args = (
       config => 't/etc/ravada.conf' 
   ,connector => $test->connector 
);

my $RVD_BACK  = Ravada->new( @rvd_args );
my $RVD_FRONT = Ravada::Front->new( @rvd_args
    , backend => $RVD_BACK
);
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42

my %CREATE_ARGS = (
    kvm => { id_iso => 1 }
    ,lxc => { id_template => 1 }
);

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

sub _new_name {
    return $DOMAIN_NAME."_".$CONT++;
}

sub create_args {
    my $backend = shift;

    die "Unknown backend $backend" if !$CREATE_ARGS{$backend};
    return %{$CREATE_ARGS{$backend}};
}
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
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
sub remove_old_disks {
    my $name = $DOMAIN_NAME;

    my $vm = $RVD_BACK->search_vm('kvm');
    ok($vm,"I can't find a KVM virtual manager") or return;

    my $dir_img = $vm->dir_img();
    ok($dir_img," I cant find a dir_img in the KVM virtual manager") or return;

    for my $count ( 0 .. 10 ) {
        my $disk = $dir_img."/$name"."_$count.img";
        if ( -e $disk ) {
            unlink $disk or die "I can't remove $disk";
        }
    }
    $vm->storage_pool->refresh();
}

sub remove_old_domains {
    for ( 0 .. 10 ) {
        my $dom_name = $DOMAIN_NAME."_$_";
        my $domain = $RVD_BACK->search_domain($dom_name);
        $domain->shutdown_now() if $domain;
        test_remove_domain($dom_name);
    }
}

sub search_domain_db
 {
    my $name = shift;
    my $sth = $test->dbh->prepare("SELECT * FROM domains WHERE name=? ");
    $sth->execute($name);
    my $row =  $sth->fetchrow_hashref;
    return $row;

}

sub test_remove_domain {
    my $name = shift;

    my $domain;
    $domain = $RVD_BACK->search_domain($name,1);

    if ($domain) {
        diag("Removing domain $name");
        $domain->remove();
    }
    $domain = $RVD_BACK->search_domain($name);
    die "I can't remove old domain $name"
        if $domain;

    ok(!search_domain_db($name),"Domain $name still in db");
}

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

remove_old_domains();
remove_old_disks();

103

104
for my $vm_name ('kvm','lxc') {
105

106
107
108
109
110
    my $vm = $RVD_BACK->search_vm($vm_name);
    if (!$vm) {
        diag("Skipping VM $vm_name in this system");
        next;
    }
111
112

    my $name = _new_name();
113
    my $req = $RVD_FRONT->create_domain( name => $name 
114
115
        , vm => $vm_name
        , create_args($vm_name)
116
    );
Francesc Guasch's avatar
Francesc Guasch committed
117
118
    ok($req, "Request $name not created");

119
    $RVD_FRONT->wait_request($req);
120

121
    ok($req->status eq 'done',"Request for create $vm domain ".$req->status);
122
    ok(!$req->error,$req->error);
123
124
125

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

126
    ok($domain,"Domain $name not found") or exit;
127
128
129
    ok($domain && $domain->{name} && 
        $domain->{name} eq $name,"Expecting domain name $name, got "
        .($domain->{name} or '<UNDEF>'));
130
131
132
133
134
135
136
137

    $RVD_FRONT->start_domain($name);
    $RVD_FRONT->wait_request($req,10);
    ok($req->status('done'),"Request ".$req->status);

    my $display = $RVD_FRONT->domdisplay($name);
    ok($display,"No display for domain $name found. Is it active ?");
    ok($display =~ m{\w+://.*?:\d+},"Expecting display a URL, it is '$display'");
138
139
}
done_testing();