20_domain_kvm.t 9.06 KB
Newer Older
1
2
3
use warnings;
use strict;

4
use Data::Dumper;
5
use IPC::Run3;
6
7
use Test::More;

8
9
10
use lib 't/lib';
use Test::Ravada;

Francesc Guasch's avatar
Francesc Guasch committed
11
12
my $BACKEND = 'KVM';

13
14
use_ok('Ravada');

Francesc Guasch's avatar
Francesc Guasch committed
15
my $RAVADA = rvd_back();
16
my $USER = create_user('foo','bar', 1);
17

18
sub test_vm_kvm {
19
    my $vm = $RAVADA->search_vm('kvm');
20
21
22
23
24
25
26
27
28
    ok($vm,"No vm found") or exit;
    ok(ref($vm) =~ /KVM$/,"vm is no kvm ".ref($vm)) or exit;

    ok($vm->type, "Not defined $vm->type") or exit;
    ok($vm->host, "Not defined $vm->host") or exit;

}
sub test_remove_domain {
    my $name = shift;
29
    my $user = (shift or $USER);
30
31

    my $domain;
32
    $domain = $RAVADA->search_domain($name,1);
33
34

    if ($domain) {
35
#        diag("Removing domain $name");
36
37
        eval { $domain->remove($user) };
        ok(!$@,"Domain $name should be removed ".$@) or exit;
38
    }
39
    $domain = $RAVADA->search_domain($name);
40
41
42
    die "I can't remove old domain $name"
        if $domain;

43
44
45
46
47
48
    ok(!search_domain_db($name),"Domain $name still in db");
}

sub test_remove_domain_by_name {
    my $name = shift;

49
#    diag("Removing domain $name");
50
    $RAVADA->remove_domain(name => $name, uid => $USER->id);
51

52
    my $domain = $RAVADA->search_domain($name, 1);
53
54
55
56
57
    die "I can't remove old domain $name"
        if $domain;

}

58
59
60
61
sub test_remove_corrupt_clone {
    my $vm = shift;

    my $base = create_domain($vm);
62
    $base->add_volume_swap( size => 1024 * 1024 );
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
    my $clone = $base->clone(
         name => new_domain_name
        ,user => user_admin
    );

    for my $file ( $clone->list_disks ) {
        warn $file;
        open my $out, '>',$file or die "$! $file";
        print $out "bogus\n";
        close $out;
    }
    eval { $clone->start(user_admin) };
    diag($@);
    $clone->shutdown_now(user_admin);

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

fv3rdugo's avatar
fv3rdugo committed
82
83
sub search_domain_db
 {
84
    my $name = shift;
Francesc Guasch's avatar
Francesc Guasch committed
85
    my $sth = connector->dbh->prepare("SELECT * FROM domains WHERE name=? ");
86
87
88
89
    $sth->execute($name);
    my $row =  $sth->fetchrow_hashref;
    return $row;

90
91
92
}

sub test_new_domain {
Francesc Guasch's avatar
Francesc Guasch committed
93
94
    my $active = shift;

95
    my $name = new_domain_name();
96
97

    test_remove_domain($name);
98

99
#    diag("Creating domain $name");
100
101
    my $domain = $RAVADA->create_domain(name => $name, id_iso => search_id_iso('Alpine')
        , active => $active
102
        , id_owner => $USER->id
Francesc Guasch's avatar
Francesc Guasch committed
103
        , vm => $BACKEND
104
        , disk => 1024 * 1024
Francesc Guasch's avatar
Francesc Guasch committed
105
    );
106
107

    ok($domain,"Domain not created");
108
109
    my $exp_ref= 'Ravada::Domain::KVM';
    ok(ref $domain eq $exp_ref, "Expecting $exp_ref , got ".ref($domain))
110
111
        if $domain;

112
113
114
115
116
    my @cmd = ('virsh','desc',$name);
    my ($in,$out,$err);
    run3(\@cmd,\$in,\$out,\$err);
    ok(!$?,"@cmd \$?=$? , it should be 0 $err $out");

117
    my $row =  search_domain_db($domain->name);
118
119
    ok($row->{name} && $row->{name} eq $domain->name,"I can't find the domain at the db");

Francesc Guasch's avatar
Francesc Guasch committed
120
    my $domain2 = $RAVADA->search_domain($domain->name);
Francesc Guasch's avatar
Francesc Guasch committed
121
122
123
124
    ok($domain2->id eq $domain->id,"Expecting id = ".$domain->id." , got ".$domain2->id);
    ok($domain2->name eq $domain->name,"Expecting name = ".$domain->name." , got "
        .$domain2->name);

125
126
127
    return $domain;
}

joelalju's avatar
joelalju committed
128
129
130
131
sub test_new_domain_iso {
    my $active = shift;
    
    my $vm = rvd_back()->search_vm($BACKEND);
Francesc Guasch's avatar
Francesc Guasch committed
132
    my $iso = $vm->_search_iso(search_id_iso('Alpine'));
joelalju's avatar
joelalju committed
133
134
135
136
    my $name = new_domain_name();

    test_remove_domain($name);

137
#    diag("Creating domain $name");
joelalju's avatar
joelalju committed
138
139
    my $domain;
    eval {
Francesc Guasch's avatar
Francesc Guasch committed
140
141
      $domain = $RAVADA->create_domain(name => $name, id_iso => search_id_iso('alpine')
          , active => $active
joelalju's avatar
joelalju committed
142
143
        , id_owner => $USER->id , iso_file => $iso->{device}
        , vm => $BACKEND
144
        , disk => 1024 * 1024
joelalju's avatar
joelalju committed
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
        );
      };
    is($@,'') or return;
    
    ok($domain,"Domain not created");
    my $exp_ref= 'Ravada::Domain::KVM';
    ok(ref $domain eq $exp_ref, "Expecting $exp_ref , got ".ref($domain))
        if $domain;
        
    my @cmd = ('virsh','desc',$name);
    my ($in,$out,$err);
    run3(\@cmd,\$in,\$out,\$err);
    ok(!$?,"@cmd \$?=$? , it should be 0 $err $out");

    my $row =  search_domain_db($domain->name);
    ok($row->{name} && $row->{name} eq $domain->name,"I can't find the domain at the db");

    my $domain2 = $RAVADA->search_domain($domain->name);

    ok($domain2->id eq $domain->id,"Expecting id = ".$domain->id." , got ".$domain2->id);
    ok($domain2->name eq $domain->name,"Expecting name = ".$domain->name." , got "
        .$domain2->name);
    #TODO HOW TO COMPARE THE ISO OF TWO MACHINES    

    return $domain;
}

172
173
sub test_prepare_base {
    my $domain = shift;
174
    $domain->prepare_base(user_admin);
175

Francesc Guasch's avatar
Francesc Guasch committed
176
    my $sth = connector->dbh->prepare("SELECT is_base FROM domains WHERE name=? ");
177
    $sth->execute($domain->name);
Francesc Guasch's avatar
Francesc Guasch committed
178
179
180
181
    my ($is_base) =  $sth->fetchrow;
    ok($is_base
            ,"Expecting is_base=1 got "
            .(${is_base} or '<UNDEF>'));
182
183
184
    $sth->finish;
}

185

Francesc Guasch's avatar
Francesc Guasch committed
186
187
188
sub test_domain_inactive {
    my $domain = test_domain(0);
}
189
190
191

sub test_domain{

Francesc Guasch's avatar
Francesc Guasch committed
192
193
194
    my $active = shift;
    $active = 1 if !defined $active;

195
196
    my $vm = $RAVADA->search_vm('kvm');
    my $n_domains = scalar $vm->list_domains();
Francesc Guasch's avatar
Francesc Guasch committed
197
    my $domain = test_new_domain($active);
198

199
    if (ok($domain,"test domain not created")) {
200
        my @list = $vm->list_domains();
201
202
203
        ok(scalar(@list) == $n_domains + 1,"Found ".scalar(@list)." domains, expecting "
            .($n_domains+1)
            ." "
204
            .join(" * ", sort map { $_->name } @list)
205
        ) or exit;
Francesc Guasch's avatar
Francesc Guasch committed
206
        ok(!$domain->is_base,"Domain shouldn't be base ");
207

Francesc Guasch's avatar
Francesc Guasch committed
208
        # test list domains
209
        my @list_domains = $vm->list_domains();
Francesc Guasch's avatar
Francesc Guasch committed
210
        ok(@list_domains,"No domains in list");
211
        my $list_domains_data = $RAVADA->list_domains_data();
Francesc Guasch's avatar
Francesc Guasch committed
212
        ok($list_domains_data && $list_domains_data->[0],"No list domains data ");
Francesc Guasch's avatar
Francesc Guasch committed
213
        my $is_base = $list_domains_data->[0]->{is_base} if $list_domains_data;
Francesc Guasch's avatar
Francesc Guasch committed
214
        ok($is_base eq '0',"Mangled is base '$is_base', it should be 0 ");
Francesc Guasch's avatar
Francesc Guasch committed
215

216
217
218
        ok(!$domain->is_active  ,"domain should be inactive") if defined $active && $active==0;
        ok($domain->is_active   ,"domain should be active")   if defined $active && $active==1;

Francesc Guasch's avatar
Francesc Guasch committed
219
        # test prepare base
220
        test_prepare_base($domain);
Francesc Guasch's avatar
Francesc Guasch committed
221
        ok($domain->is_base,"Domain should be base");
222
 
223
        ok(test_domain_in_virsh($domain->name,$domain->name)," not in virsh list all");
224
        my $domain2;
225
        $vm->connect();
226
227
        eval { $domain2 = $vm->vm->get_domain_by_name($domain->name)};
        ok($domain2,"Domain ".$domain->name." missing in VM") or exit;
228

229
230
231
232
        test_remove_domain($domain->name);
    }
}

233
234
sub test_domain_in_virsh {
    my $name = shift;
235
236
    my $vm = $RAVADA->search_vm('kvm');

237
    $vm->connect();
238
    for my $domain ($vm->vm->list_all_domains) {
239
240
241
242
        if ( $domain->get_name eq $name ) {
            $vm->disconnect;
            return 1 
        }
243
    }
244
    $vm->disconnect();
245
246
247
248
249
250
251
252
253
    return 0;
}

sub test_domain_missing_in_db {
    # test when a domain is in the VM but not in the DB

    my $active = shift;
    $active = 1 if !defined $active;

254
    my $n_domains = scalar $RAVADA->list_domains();
255
    my $domain = test_new_domain($active);
256
    ok($RAVADA->list_domains > $n_domains,"There should be more than $n_domains");
257
258

    if (ok($domain,"test domain not created")) {
Francesc Guasch's avatar
Francesc Guasch committed
259

Francesc Guasch's avatar
Francesc Guasch committed
260
        my $sth = connector->dbh->prepare("DELETE FROM domains WHERE id=?");
261
262
        $sth->execute($domain->id);

263
        my $domain2 = $RAVADA->search_domain($domain->name);
264
265
        ok(!$domain2,"This domain should not show up in Ravada, it's not in the DB");

266
267
        my $vm = $RAVADA->search_vm('kvm');
        my $domain3;
268
        $vm->connect();
269
270
        eval { $domain3 = $vm->vm->get_domain_by_name($domain->name)};
        ok($domain3,"I can't find the domain in the VM") or return;
271

272
273
        my @list_domains = $RAVADA->list_domains;
        ok($RAVADA->list_domains == $n_domains,"There should be only $n_domains domains "
Francesc Guasch's avatar
Francesc Guasch committed
274
275
                                        .", there are ".scalar(@list_domains));

276
        test_remove_domain($domain->name, user_admin());
277
278
279
280
    }
}


281
sub test_domain_by_name {
282
283
284
285
286
    my $domain = test_new_domain();

    if (ok($domain,"test domain not created")) {
        test_remove_domain_by_name($domain->name);
    }
287
}
288

joelalju's avatar
joelalju committed
289
290
291
292
293
294
295
296
sub test_domain_with_iso {
  my $domain = test_new_domain_iso();
  
  if (ok($domain,"test domain not created")) {
      test_remove_domain_by_name($domain->name);
  }
}

297
298
299
300
301
302
sub test_prepare_import {
    my $domain = test_new_domain();

    if (ok($domain,"test domain not created")) {

        test_prepare_base($domain);
Francesc Guasch's avatar
Francesc Guasch committed
303
        ok($domain->is_base,"Domain should be base");
304

Francesc Guasch's avatar
Francesc Guasch committed
305
        test_remove_domain($domain->name);
306
307
308
309
310
311
    }

}

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

312
my $vm;
Francesc Guasch's avatar
Francesc Guasch committed
313
clean();
314
315

eval { $vm = $RAVADA->search_vm('kvm') } if $RAVADA;
316
SKIP: {
317
    my $msg = "SKIPPED test: No KVM backend found";
318
319
320
321
322
    if ($vm && $>) {
        $msg = "SKIPPED: Test must run as root";
        $vm = undef;
    }

323
324
325
    diag($msg)      if !$vm;
    skip $msg,10    if !$vm;

326
327
    use_ok("Ravada::Domain::$BACKEND");

328
329
330
test_vm_kvm();

remove_old_domains();
331
remove_old_disks();
Francesc Guasch's avatar
Francesc Guasch committed
332
test_domain();
333
test_remove_corrupt_clone($vm);
joelalju's avatar
joelalju committed
334
test_domain_with_iso();
335
test_domain_missing_in_db();
Francesc Guasch's avatar
Francesc Guasch committed
336
test_domain_inactive();
337
338
test_domain_by_name();
test_prepare_import();
339

340
};
Francesc Guasch's avatar
Francesc Guasch committed
341
clean();
342
done_testing();