30_hardware.t 40.3 KB
Newer Older
1
2
3
4
5
use warnings;
use strict;

use Carp qw(carp confess cluck);
use Data::Dumper;
6
use Hash::Util qw(lock_hash);
7
use POSIX qw(WNOHANG);
Francesc Guasch's avatar
Francesc Guasch committed
8
use Sys::Virt;
9
use Test::More;
Francesc Guasch's avatar
Francesc Guasch committed
10
use YAML qw(Dump);
11

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

15
16
17
18
19
20
use_ok('Ravada');
use_ok('Ravada::Request');

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

Francesc Guasch's avatar
Francesc Guasch committed
21
init();
22
23
24
25
26

my $USER = create_user("foo","bar", 1);

rvd_back();
$Ravada::CAN_FORK = 1;
Francesc Guasch's avatar
Francesc Guasch committed
27
my $BASE;
28

29
my $TEST_TIMESTAMP = 0;
30
my $TLS;
31

32
########################################################################
33
34
35
36
37
38
39
40
41
42
43
#
sub _download_alpine64 {
    my $id_iso = search_id_iso('Alpine%64');

    my $req = Ravada::Request->download(
             id_iso => $id_iso
    );
    wait_request();
    is($req->error, '');
    is($req->status,'done') or exit;
}
44

45
46
sub _driver_field($hardware) {
    my $driver_field = 'driver';
47
48
49
    $driver_field = 'type'  if $hardware eq 'video';
    $driver_field = 'model' if $hardware =~ /sound/;
    $driver_field = 'mode'  if $hardware eq 'cpu';
50
51
52
    return $driver_field;
}

Francesc Guasch's avatar
Francesc Guasch committed
53
sub test_add_hardware_request_drivers {
54
55
56
	my $vm = shift;
	my $domain = shift;
	my $hardware = shift;
Francesc Guasch's avatar
Francesc Guasch committed
57

58
59
    my $driver_field = _driver_field($hardware);

Francesc Guasch's avatar
Francesc Guasch committed
60
    my $domain_f = Ravada::Front::Domain->open($domain->id);
Francesc Guasch's avatar
Francesc Guasch committed
61
    my $info0 = $domain->info(user_admin);
Francesc Guasch's avatar
Francesc Guasch committed
62

Francesc Guasch's avatar
Francesc Guasch committed
63
    my $options = $info0->{drivers}->{$hardware};
Francesc Guasch's avatar
Francesc Guasch committed
64

Francesc Guasch's avatar
Francesc Guasch committed
65
66
67
    for my $remove ( 1,0 ) {
        test_remove_almost_all_hardware($vm, $domain, $hardware);
        for my $driver (@$options) {
68
            $driver = lc($driver);
Francesc Guasch's avatar
Francesc Guasch committed
69
70
71
            diag("Testing new $hardware $driver remove=$remove");

            my $info0 = $domain->info(user_admin);
72
73
            my @dev0 = sort map { $_->{$driver_field} }
                        grep { !exists $_->{is_secondary} || !$_->{is_secondary} }
74
                        @{$info0->{hardware}->{$hardware}};
75
            test_add_hardware_request($vm, $domain, $hardware, { $driver_field => $driver} );
Francesc Guasch's avatar
Francesc Guasch committed
76
77

            my $info1 = $domain->info(user_admin);
78
            my @dev1 = sort map { $_->{$driver_field} } @{$info1->{hardware}->{$hardware}};
Francesc Guasch's avatar
Francesc Guasch committed
79
80
81
82
83
84
85
86

            if ( scalar @dev1 == scalar(@dev0)) {
                my $different = 0;
                for ( 0 .. scalar(@dev1)-1) {
                    $different++ if $dev1[$_] ne $dev0[$_];
                }
                ok($different, "Expecting different $hardware ") or die Dumper(\@dev0, \@dev1);
            } else {
87
88
                ok(scalar(@dev1) > scalar(@dev0)) or die Dumper(\@dev1,\@dev0);
                # it is ok because number of devs increased
Francesc Guasch's avatar
Francesc Guasch committed
89
90
91
            }
            my $driver_short = _get_driver_short_name($domain, $hardware,$driver);

92
93
94
95
96
97
98
99
            if ($hardware eq 'video' ) {
                my ($new) = grep {$_->{$driver_field} eq $driver_short }
                    @{$info1->{hardware}->{$hardware}};
                ok($new,"Expecting a $hardware $driver_short");
            } else {
                is($info1->{hardware}->{$hardware}->[-1]->{$driver_field}, $driver_short) or confess( $domain->name
                    , Dumper($info1->{hardware}->{$hardware}))
            }
Francesc Guasch's avatar
Francesc Guasch committed
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117

            test_display_data($domain , $driver) if $hardware eq 'display';

            test_remove_hardware($vm, $domain, $hardware
                , scalar(@{$info1->{hardware}->{$hardware}})-1)
            if $remove || $hardware eq 'disk' && $driver eq 'usb';
        }
    }

    #    test_add_hardware_request($vm, $domain, $hardware) if $hardware =~ 'display';
}

sub _get_driver_short_name($domain,$hardware, $option) {

    return $option unless $hardware eq 'display';

    my $driver = $domain->drivers($hardware);
    my ($selected)
118
    = grep { lc($_->{name}) eq lc($option) || lc($_->{value}) eq lc($option)}
Francesc Guasch's avatar
Francesc Guasch committed
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
    $driver->get_options;

    return $selected->{value};
}

sub test_display_data($domain, $driver) {

    $domain->start(user => user_admin);
    wait_request(debug => 0);
    my $hardware = $domain->info(user_admin)->{hardware};
    $driver = _get_driver_short_name($domain, 'display', $driver);
    my @displays = @{$hardware->{display}};

    my ($display) = grep { $_->{driver} eq $driver } @displays;
    ok($display) or die "Display $driver not found ".Dumper(\@displays);

    test_display_builtin_ports($domain, $display) if $display->{is_builtin};

    $domain->shutdown(user => user_admin, timeout => 20);
    wait_request(debug => 0);
}

sub test_display_builtin_ports_kvm($domain, $display) {
    my $driver = $display->{driver};
    my $xml = XML::LibXML->load_xml( string => $domain->xml_description);
    my $path = "/domain/devices/graphics\[\@type='$driver']";
    my ($graphic) = $xml->findnodes($path);
    die "Error: $path not found in ".$domain->name if !$graphic;

    my $port = $graphic->getAttribute('port');
    is($port, $display->{port});
}
Francesc Guasch's avatar
Francesc Guasch committed
151

Francesc Guasch's avatar
Francesc Guasch committed
152
153
154
155
sub test_display_builtin_ports_void($domain, $display) {
    my $hardware = $domain->_value('hardware');
    my ($graphic) = grep { $_->{driver} eq $display->{driver} } @{$hardware->{display}};
    die "Error: display not found in ".Dumper($hardware) if !$graphic;
Francesc Guasch's avatar
Francesc Guasch committed
156

Francesc Guasch's avatar
Francesc Guasch committed
157
158
    is($display->{port}, $graphic->{port});
}
Francesc Guasch's avatar
Francesc Guasch committed
159

Francesc Guasch's avatar
Francesc Guasch committed
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
sub test_display_builtin_ports($domain, $display){
    return test_display_builtin_ports_kvm($domain,$display) if $domain->type eq 'KVM';
    return test_display_builtin_ports_void($domain,$display) if $domain->type eq 'Void';
    confess "TODO";
}

sub test_display_db($domain, $n_expected) {
    my $sth = connector->dbh->prepare("SELECT * FROM domain_displays "
        ." WHERE id_domain = ?"
    );
    $sth->execute($domain->id);

    my @row;
    while ( my $row = $sth->fetchrow_hashref) {
        push @row,($row);
        is($domain->_is_display_builtin(undef,$row), $row->{is_builtin}) or
        die Dumper($domain->name, $row);
Francesc Guasch's avatar
Francesc Guasch committed
177
    }
Francesc Guasch's avatar
Francesc Guasch committed
178

179
    is(scalar(@row),$n_expected) or confess Dumper($domain->name, \@row);
Francesc Guasch's avatar
Francesc Guasch committed
180
181
182
183
184
185
186
187

    my @displays = $domain->_get_controller_display();
    is(scalar @displays, @row);

    my $n_expected_non_builtin = scalar(grep { $_->{is_builtin} == 0 } @displays);

    my @ports = $domain->list_ports();
    is(scalar(@ports),$n_expected_non_builtin) or die Dumper(\@displays,\@ports);
Francesc Guasch's avatar
Francesc Guasch committed
188
189
}

190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
sub _remove_other_video_primary($domain) {
    my @list_hardware = $domain->get_controller('video');
    my $removed = 0;
    for my $index (reverse 0 .. scalar(@list_hardware)-1 ) {
        next if $list_hardware[$index]->{type} !~ /vmvga|cirrus/;
        Ravada::Request->remove_hardware(
            name => 'video'
            ,id_domain => $domain->id
            ,index => $index
            ,uid => user_admin->id
        );
        $removed++;
    }
    wait_request() if $removed;
}

Francesc Guasch's avatar
Francesc Guasch committed
206
sub test_add_hardware_request($vm, $domain, $hardware, $data={}) {
Francesc Guasch's avatar
Francesc Guasch committed
207

208
209
    $domain = Ravada::Domain->open($domain->id);

Francesc Guasch's avatar
Francesc Guasch committed
210
    confess if !ref($data) || ref($data) ne 'HASH';
211

212
213
214
215
    if ($hardware eq 'video' && exists $data->{type} &&  $data->{type} eq 'cirrus') {
        _remove_other_video_primary($domain);
    }

216
217
    my $date_changed = $domain->_data('date_changed');

Francesc Guasch's avatar
Francesc Guasch committed
218
    my @list_hardware1 = $domain->get_controller($hardware);
219
    @list_hardware1 = map { $_->{file} } @list_hardware1 if $hardware eq 'disk';
220

Francesc Guasch's avatar
Francesc Guasch committed
221
	my $numero = scalar(@list_hardware1);
222
223
224

    while (($hardware =~ /display/ && $numero > 0 ) || ($hardware eq 'usb' && $numero > 3) || ($hardware =~ /video/ && $numero > 0)) {
        my $n_old = $numero;
225
        test_remove_hardware($vm, $domain, $hardware, 0);
226
        $domain = Ravada::Domain->open($domain->id);
227
        @list_hardware1 = $domain->get_controller($hardware);
Francesc Guasch's avatar
Francesc Guasch committed
228
	    $numero = scalar(@list_hardware1);
229
        last if $n_old == 1 && scalar(@list_hardware1)==1 && $hardware eq 'video';
230
    }
Francesc Guasch's avatar
Francesc Guasch committed
231
232
233
234
    test_display_db($domain,0) if $hardware eq 'display';

    $data = { driver => 'spice' } if !keys %$data && $hardware eq 'display';

235
236
237
238
239
240
241
242
243
244
    if ($hardware eq 'video') {
        Ravada::Request->change_hardware(uid => $USER->id
            ,id_domain => $domain->id
            ,hardware => $hardware
            ,index => 0
            ,data => { driver => 'qxl'}
        );
        wait_request();
    }

245
246
247
248
249
	my $req;
	eval {
		$req = Ravada::Request->add_hardware(uid => $USER->id
                , id_domain => $domain->id
                , name => $hardware
Francesc Guasch's avatar
Francesc Guasch committed
250
                , number => $numero+1
Francesc Guasch's avatar
Francesc Guasch committed
251
                , data => $data
252
253
254
            );
	};
	is($@,'') or return;
Francesc Guasch's avatar
Francesc Guasch committed
255
    $USER->unread_messages();
256
	ok($req, 'Request');
257
    sleep 1 if !$TEST_TIMESTAMP;
Francesc Guasch's avatar
Francesc Guasch committed
258
    wait_request(debug => 0);
259
    is($req->status(),'done');
Francesc Guasch's avatar
Francesc Guasch committed
260
    is($req->error(),'') or exit;
261
262
263
264
    my $n = 1;
    $n++ if $TLS && $hardware eq 'display' && $data->{driver} =~ /spice|vnc/
    && $domain->is_active();
    test_display_db($domain,$n) if $hardware eq 'display';
Francesc Guasch's avatar
Francesc Guasch committed
265
266
267
268

    {
    my $domain_f = Ravada::Front::Domain->open($domain->id);
    my @list_hardware2 = $domain_f->get_controller($hardware);
269
    is(scalar @list_hardware2 , scalar(@list_hardware1) + $n
Francesc Guasch's avatar
Francesc Guasch committed
270
        ,"Adding hardware $hardware $numero\n"
271
            .Dumper($domain->name,$data,\@list_hardware2, \@list_hardware1))
Francesc Guasch's avatar
Francesc Guasch committed
272
            or exit;
Francesc Guasch's avatar
Francesc Guasch committed
273
274
275
276
277
    }

    {
        my $domain_2 = Ravada::Front::Domain->open($domain->id);
        my @list_hardware2 = $domain_2->get_controller($hardware);
278
        is(scalar @list_hardware2 , scalar(@list_hardware1) + $n
Francesc Guasch's avatar
Francesc Guasch committed
279
            ,"Adding hardware $numero\n"
Francesc Guasch's avatar
Francesc Guasch committed
280
                .Dumper(\@list_hardware2, \@list_hardware1)) or exit;
Francesc Guasch's avatar
Francesc Guasch committed
281
    }
282
    $domain = Ravada::Domain->open($domain->id);
283
284
    my @list_hardware3 = $domain->get_controller($hardware);
    is(scalar(@list_hardware3), $numero+$n) or exit;
Francesc Guasch's avatar
Francesc Guasch committed
285
    my $info = $domain->info(user_admin);
286
    is(scalar(@{$info->{hardware}->{$hardware}}), $numero+$n) or exit;
287
    my $new_hardware = $info->{hardware}->{$hardware}->[$numero-1];
Francesc Guasch's avatar
Francesc Guasch committed
288
    if ( $hardware eq 'disk' && $new_hardware->{name} !~ /\.iso$/) {
289
        my $name = $domain->name;
Francesc Guasch's avatar
Francesc Guasch committed
290
        like($new_hardware->{name}, qr/$name-.*vd[a-z].*\.\w+$/) or die Dumper($new_hardware);
291
    }
292
293
294
    if (!$TEST_TIMESTAMP++) {
        isnt($domain->_data('date_changed'), $date_changed);
    }
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
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
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
    return $domain;
}

sub _remove_hardware_video($domain) {
    my $info = $domain->info(user_admin);
    my $video = $info->{hardware}->{video};
    for my $n ( reverse 0 .. scalar(@$video)-1 ) {
        next if $video->[$n]->{type} =~ /qxl/;
        Ravada::Request->remove_hardware(
            name => 'video'
            ,index => $n
            ,id_domain => $domain->id
            ,uid => user_admin->id
        );
    }
    wait_request();
}

sub test_video_primary($domain) {
    my $req = Ravada::Request->add_hardware(
            name => 'video'
            ,uid => user_admin->id
            ,id_domain => $domain->id
            ,data => { 'driver' => 'qxl','primary' => 'yes'}
    );
    wait_request();

    my $driver = $domain->drivers('video');
    for my $option ( $driver->get_options ) {
        _remove_hardware_video($domain);
        my $option_value = lc($option->{name});
        my $info = $domain->info(user_admin);
        my $video = $info->{hardware}->{video};
        my $n;
        for ( 0 .. scalar(@$video)-1 ) {
            $n = $_;
            last if !exists $video->[$n]->{primary}
            || $video->[$n]->{primary} !~ /yes/;
        }
        die "Error: I can't find a non primary video ".Dumper($video)
        if !defined $n;

        my @args = (
            uid => user_admin->id
            ,id_domain => $domain->id
            ,hardware => 'video'
            ,index => $n
        );
        diag($domain->name." $option_value");
        $req = Ravada::Request->change_hardware(
            @args
            ,data => { driver => $option_value}
        );
        wait_request();
    }
}

sub _remove_all_video_but_one($domain, $keep = 'virtio') {
    my $info = $domain->info(user_admin);
    my $video = $info->{hardware}->{video};

    for my $n ( reverse 0 .. scalar(@$video)-1 ) {
        confess Dumper($info->{hardware}) if !exists $video->[$n]->{type};
        next if $video->[$n]->{type} eq $keep;
        Ravada::Request->remove_hardware(name => 'video'
            ,uid => user_admin->id
            ,id_domain => $domain->id
            ,index => $n
        );
    }
    wait_request();

    $info = $domain->info(user_admin);
    $video = $info->{hardware}->{video};

    my $n;
    for ( 0 .. scalar(@$video)-1 ) {
        $n = $_;
        last if $video->[$n]->{type} eq $keep
    }
    return $n if defined $n;

    my $req = Ravada::Request->change_hardware(
        hardware => 'video'
        ,uid => user_admin->id
        ,id_domain => $domain->id
        ,data => { 'type' => $keep }
        ,index => 0
    );
    wait_request();

    $info = $domain->info(user_admin);
    $video = $info->{hardware}->{video};

    for ( 0 .. scalar(@$video)-1 ) {
        $n = $_;
        last if $video->[$n]->{type} eq 'virtio'
    }

    die "Error: I can't find video virtio ".Dumper($video)
    if !defined $n;

    return $n;
}

sub test_video_vgamem($domain) {
    my $n = _remove_all_video_but_one($domain, 'qxl');
    my @args = (
        uid => user_admin->id
        ,id_domain => $domain->id
        ,hardware => 'video'
        ,index => $n
    );
    for my $field ( 'vgamem', 'ram' ) {
        for my $type ( 'cirrus', 'qxl','vga', 'virtio','vmvga') {
            Ravada::Request->change_hardware(
                @args
                ,data => { type => 'qxl'
                    ,$field => '16384'
                }
            );
            wait_request( debug => 0);
            my $req = Ravada::Request->change_hardware(
                @args
                ,data => { type => $type
                    ,$field => '16384'
                }
            );
            wait_request( debug => 0);
        }
    }
}

sub test_video_virtio_3d_change_type($domain) {
    my $n = _remove_all_video_but_one($domain);
    my $req = Ravada::Request->change_hardware(
        uid => user_admin->id
        ,id_domain => $domain->id
        ,hardware => 'video'
        ,index => $n
        ,data => { type => 'virtio'
            , acceleration => { accel3d => 'yes'}
        }
    );
    wait_request( debug => 0);

    $req = Ravada::Request->change_hardware(
        uid => user_admin->id
        ,id_domain => $domain->id
        ,hardware => 'video'
        ,index => $n
        ,data => { type => 'cirrus'
            , acceleration => { accel3d => 'yes'}
        }
    );
    wait_request(debug => 0);
}

sub test_video_virtio_3d($domain) {
    my $n = _remove_all_video_but_one($domain);

    my $req = Ravada::Request->change_hardware(
        uid => user_admin->id
        ,id_domain => $domain->id
        ,hardware => 'video'
        ,index => $n
        ,data => { type => 'virtio'
            , acceleration => { accel3d => 'yes'}
        }
    );
    wait_request( debug => 0);

    _test_kvm_accel3d($domain, 'yes');
    $req = Ravada::Request->change_hardware(
        uid => user_admin->id
        ,id_domain => $domain->id
        ,hardware => 'video'
        ,index => $n
        ,data => { type => 'virtio'
            , acceleration => { accel3d => 'no'}
        }
    );
    wait_request( debug => 0);
    _test_kvm_accel3d($domain,'no');
}

sub _test_kvm_accel3d($domain,$value) {
    return if $domain->type ne 'KVM';
    my $xml = XML::LibXML->load_xml(
            string => $domain->domain->get_xml_description()
    );
    my $path = "/domain/devices/video/model/acceleration";
    my ($acceleration ) = $xml->findnodes($path);
    ok($acceleration,"Expecting $path in ".$domain->name)
        or exit;
    is($acceleration->getAttribute('accel3d'), $value)
        or die $domain->name;
}

sub test_add_video($domain) {
    my $data = { type => 'virtio', heads => 1 };
    test_video_vgamem($domain);
    test_video_virtio_3d_change_type($domain);
    test_video_virtio_3d($domain);
    test_add_hardware_request($domain->_vm,$domain,'video',$data);
    test_video_primary($domain);
Francesc Guasch's avatar
Francesc Guasch committed
501
502
503
504
505
}

sub test_add_cdrom($domain) {
    my $n = 0;
    for my $device ( $domain->list_volumes_info ) {
506
        if ($device->info->{device} eq 'cdrom') {
Francesc Guasch's avatar
Francesc Guasch committed
507
508
509
510
511
512
            test_remove_hardware($domain->_vm, $domain, 'disk', $n);
        }
        $n++;
    }

    my $data = { device => 'cdrom' , boot => 2 };
Francesc Guasch's avatar
Francesc Guasch committed
513
    my $file_iso = "/var/tmp/test_30_hardware.iso";
Francesc Guasch's avatar
Francesc Guasch committed
514
515
516
517
518
519
520
521
    if ($domain->type eq 'KVM') {
        eval { $domain->_set_boot_hd(1) };
        is(''.$@,'') or exit;
        eval { $domain->_set_boot_hd(0) };
        is(''.$@,'') or exit;
        my $iso = $domain->_vm->_search_iso(search_id_iso('Alpine'));
        $data->{file} = $iso->{device};
    } else {
522
        $data->{boot} = 2;
Francesc Guasch's avatar
Francesc Guasch committed
523
    }
Francesc Guasch's avatar
Francesc Guasch committed
524
    $data->{file} = $file_iso if !$data->{file};
Francesc Guasch's avatar
Francesc Guasch committed
525
526
527
528
529
530
531
    my $found = 0;
    test_add_hardware_request($domain->_vm, $domain,'disk', $data);

    test_cdrom_kvm($domain) if $domain->type eq 'KVM';
    #############
    # test device cdrom just added
    for my $device ( $domain->list_volumes_info ) {
532
        if ($device->info->{device} eq 'cdrom') {
Francesc Guasch's avatar
Francesc Guasch committed
533
            $found++;
534
535
            like($device->info->{name}, qr/\.iso/,$domain->type." ".$domain->name) or exit;
            is($device->info->{boot}, 2, $domain->name) or die Dumper($device->info);
Francesc Guasch's avatar
Francesc Guasch committed
536
537
        }
    }
Francesc Guasch's avatar
Francesc Guasch committed
538
    unlink $file_iso;
Francesc Guasch's avatar
Francesc Guasch committed
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
566
567
568
569
570
571
572
573
574

}

sub test_cdrom_kvm($domain) {
    diag("Testing cdrom KVM ");
    #########
    # test XML without boot
    {
        my $xml = XML::LibXML->load_xml(
            string => $domain->domain->get_xml_description()
        );
        my ($boot) = $xml->findnodes('/os/boot');
        ok(!$boot) or do {
            my ($os) = $xml->findnodes('/os');
            die $os->toString();
        };
    }
    #########
    # test XML inactive without boot
    {
        my $xml = XML::LibXML->load_xml(
            string => $domain->domain->get_xml_description(Sys::Virt::Domain::XML_INACTIVE)
        );
        my ($boot) = $xml->findnodes('/os/boot');
        ok(!$boot) or do {
            my ($os) = $xml->findnodes('/os');
            die $os->toString();
        };
    }
}

sub test_add_disk($domain) {
    test_add_cdrom($domain);
}

sub test_add_hardware_custom($domain, $hardware) {
Francesc Guasch's avatar
Francesc Guasch committed
575
    return if $hardware =~ /cpu|features/i;
Francesc Guasch's avatar
Francesc Guasch committed
576
577
    my %sub = (
        disk => \&test_add_disk
Francesc Guasch's avatar
Francesc Guasch committed
578
        ,display => sub {}
Francesc Guasch's avatar
Francesc Guasch committed
579
580
        ,usb => sub {}
        ,mock => sub {}
Francesc Guasch's avatar
Francesc Guasch committed
581
        ,network => sub {}
582
583
        ,video => \&test_add_video
        ,sound => sub {}
Francesc Guasch's avatar
Francesc Guasch committed
584
585
586
587
    );

    my $exec = $sub{$hardware} or die "No custom add $hardware";
    return $exec->($domain);
588
589
}

590
591
592
593
594
sub _set_three_devices($domain, $hardware) {
    my %drivers = map { $_ => 1 } @{$domain->info(user_admin)->{drivers}->{$hardware}};
    my $info_hw = $domain->info(user_admin)->{hardware};
    my $items = [];
    $items = $info_hw->{$hardware};
595

Francesc Guasch's avatar
Francesc Guasch committed
596
    my $driver_field = _driver_field($hardware);
597

598
    for my $item (@$items) {
599
600
601
        next if !ref($item);
        confess Dumper($item) if !exists $item->{$driver_field};
        delete $drivers{$item->{$driver_field}} if ref($item);
602
603
604
605
606
607
    }
    for (1 .. 3-scalar(@$items)) {
        my @driver;
        if ($hardware eq 'display') {
            my ($driver) = keys %drivers;
            delete $drivers{$driver};
608
            @driver =( data => { $driver_field => $driver } );
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
        }

        Ravada::Request->add_hardware(
            uid => user_admin->id
            ,id_domain => $domain->id
            ,name => $hardware
            ,@driver
        );
    }
    wait_request(debug => 0);
}

sub test_remove_hardware_by_index_network_kvm($vm, $hardware) {
    return if $hardware ne 'network' || $vm->type ne 'KVM';

    my $domain = create_domain($vm);
    _set_three_devices($domain, $hardware);

    my $info_hw1 = $domain->info(user_admin)->{hardware};
    my $items1 = [];
    $items1 = $info_hw1->{$hardware};

    $domain->_remove_device(1,"interface", type => qr'(bridge|network)');
    my $info_hw2 = $domain->info(user_admin)->{hardware};
    my $items2 = [];
    $items2 = $info_hw2->{$hardware};

    is($items2->[0]->{name},$items1->[0]->{name});
    is($items2->[1]->{name},$items1->[2]->{name});

    remove_domain($domain);
}


sub test_remove_hardware_by_index($vm, $hardware) {
    return if $hardware eq 'usb';

    my $domain = create_domain($vm);
    _set_three_devices($domain, $hardware);
    my $info_hw1 = $domain->info(user_admin)->{hardware};
    my $items1 = [];
    $items1 = $info_hw1->{$hardware};

    Ravada::Request->remove_hardware(
        uid => user_admin->id
        ,id_domain => $domain->id
        ,name => $hardware
        ,index => 1
    );
    wait_request();
    my $info_hw2 = $domain->info(user_admin)->{hardware};
    my $items2 = [];
    $items2 = $info_hw2->{$hardware};
662
663
664
    my $name_field = 'name';
    $name_field = 'driver'  if $hardware eq 'display';
    $name_field = 'model'   if $hardware eq 'sound';
Francesc Guasch's avatar
Francesc Guasch committed
665
    $name_field = '_name'   if ref($items2->[0]) && !exists $items2->[0]->{$name_field};
666
667
668
    if (!ref($items2->[0])) {
        is($items2->[0], $items1->[0]);
        is($items2->[1], $items1->[2]);
669
670
671
672
673
    } elsif ($hardware ne 'video') {
        die "Error: no $name_field in ".Dumper($items2) if !exists $items2->[0]->{$name_field};

        is($items2->[0]->{$name_field},$items1->[0]->{$name_field});
        is($items2->[1]->{$name_field},$items1->[2]->{$name_field});
674
675
676
677
678
    }

    $domain->remove(user_admin);
}

679
sub test_remove_hardware($vm, $domain, $hardware, $index) {
Francesc Guasch's avatar
Francesc Guasch committed
680
681
682
683
684

    $domain->shutdown_now(user_admin)   if $domain->is_active;
    $domain = Ravada::Domain->open($domain->id);
    my @list_hardware1 = $domain->get_controller($hardware);

Francesc Guasch's avatar
Francesc Guasch committed
685
686
687
688
689
    confess "Error: I can't remove $hardware $index, only ".scalar(@list_hardware1)
        ."\n"
        .Dumper(\@list_hardware1)
            if $index > scalar @list_hardware1;

690
	my $req;
Francesc Guasch's avatar
Francesc Guasch committed
691
	{
692
693
694
695
696
697
698
699
		$req = Ravada::Request->remove_hardware(uid => $USER->id
				, id_domain => $domain->id
				, name => $hardware
				, index => $index
			);
	};
	is($@, '') or return;
	ok($req, 'Request');
700
    wait_request(debug => 0);
701
	is($req->status(), 'done');
Francesc Guasch's avatar
Francesc Guasch committed
702
	is($req->error(), '') or exit;
Francesc Guasch's avatar
Francesc Guasch committed
703

704
705
706
707
    # there is no poing in checking if removed because
    # a new video device will be created when there is none
    return if $hardware eq 'video' && scalar(@list_hardware1)==1;

708
709
    my $n = 1;
    $n++ if $hardware eq 'display' && grep({ $_->{driver} =~ /-tls/ } @list_hardware1);
Francesc Guasch's avatar
Francesc Guasch committed
710
711
712
    {
        my $domain2 = Ravada::Domain->open($domain->id);
        my @list_hardware2 = $domain2->get_controller($hardware);
713
        is(scalar @list_hardware2 , scalar(@list_hardware1) - $n
Francesc Guasch's avatar
Francesc Guasch committed
714
        ,"Removing hardware $hardware\[$index] ".$domain->name."\n"
Francesc Guasch's avatar
Francesc Guasch committed
715
716
717
718
719
            .Dumper(\@list_hardware2, \@list_hardware1)) or exit;
    }
    {
        my $domain_f = Ravada::Front::Domain->open($domain->id);
        my @list_hardware2 = $domain_f->get_controller($hardware);
720
        is(scalar @list_hardware2 , scalar(@list_hardware1) - $n
Francesc Guasch's avatar
Francesc Guasch committed
721
722
723
        ,"Removing hardware $index ".$domain->name."\n"
            .Dumper(\@list_hardware2, \@list_hardware1)) or exit;
    }
724
    test_volume_removed($list_hardware1[$index]) if $hardware eq 'disk';
725
    test_display_removed($domain, $list_hardware1[$index], $index)   if $hardware eq 'display';
726
727
728
729
}

sub test_volume_removed($disk) {
    my $file = $disk->{file};
Francesc Guasch's avatar
Francesc Guasch committed
730
    return if !$file;
731
    ok(! -e $file,"Expecting $file removed") unless $file =~ /\.iso$/;
Francesc Guasch's avatar
Francesc Guasch committed
732
733
}

734
sub test_display_removed($domain, $display, $index) {
Francesc Guasch's avatar
Francesc Guasch committed
735
736
737
738
    my $hardware = $domain->info(user_admin)->{hardware}->{display};
    ok(! grep({ $_->{driver} eq $display->{driver} } @$hardware),
        "Expecting no $display->{driver} in hardware ") or die Dumper($hardware);
    if ($display->{driver} eq 'spice' || $display->{is_builtin}) {
739
        # TODO check display removed from XML
Francesc Guasch's avatar
Francesc Guasch committed
740
    }
741
742
743
744
745
    my $display2;
    eval { $display2 = $domain->_get_display_by_index($index) };
    like($@,qr/not found/);
    ok(!$display2,"Expecting display $index removed from DB ".$domain->name) or exit;

Francesc Guasch's avatar
Francesc Guasch committed
746
747
}

Francesc Guasch's avatar
Francesc Guasch committed
748
749
750
751
sub test_remove_almost_all_hardware {
	my $vm = shift;
	my $domain = shift;
	my $hardware = shift;
Francesc Guasch's avatar
Francesc Guasch committed
752
753
    my $n_keep = 2;
    $n_keep = 0 if $hardware eq 'display' || $hardware eq 'disk';
Francesc Guasch's avatar
Francesc Guasch committed
754

Francesc Guasch's avatar
Francesc Guasch committed
755
756
    #TODO test remove hardware out of bounds
    my $total_hardware = scalar($domain->get_controller($hardware));
Francesc Guasch's avatar
Francesc Guasch committed
757
758
759
    return if !defined $total_hardware || $total_hardware <= $n_keep;
    for my $index ( reverse 0 .. $total_hardware-1) {
        diag("removing $hardware $index");
Francesc Guasch's avatar
Francesc Guasch committed
760
        test_remove_hardware($vm, $domain, $hardware, $index);
Francesc Guasch's avatar
Francesc Guasch committed
761
        $domain->list_volumes() if $hardware eq 'disk';
Francesc Guasch's avatar
Francesc Guasch committed
762
763
764
    }
}

Francesc Guasch's avatar
Francesc Guasch committed
765
766
767
sub test_front_hardware {
    my ($vm, $domain, $hardware ) = @_;

Francesc Guasch's avatar
Francesc Guasch committed
768
    $domain->list_volumes();
Francesc Guasch's avatar
Francesc Guasch committed
769
770
771
772
773
    my $domain_f = Ravada::Front::Domain->open($domain->id);

        my @controllers = $domain_f->get_controller($hardware);
        ok(scalar @controllers,"[".$vm->type."] Expecting $hardware controllers ".$domain->name
            .Dumper(\@controllers))
Francesc Guasch's avatar
Francesc Guasch committed
774
                or confess;
Francesc Guasch's avatar
Francesc Guasch committed
775
776
777
778
779

        my $info = $domain_f->info(user_admin);
        ok(exists $info->{hardware},"Expecting \$info->{hardware}") or next;
        ok(exists $info->{hardware}->{$hardware},"Expecting \$info->{hardware}->{$hardware}");
        is_deeply($info->{hardware}->{$hardware},[@controllers]);
780
781
}

Francesc Guasch's avatar
Francesc Guasch committed
782
783
784
785
786
787
sub test_change_disk_field($vm, $domain, $field='capacity') {
    my $domain_f = Ravada::Front::Domain->open($domain->id);
    my $info = $domain_f->info(user_admin);

    my $hardware = 'disk';

Francesc Guasch's avatar
Francesc Guasch committed
788
    my $index;
789
790
791
792
793
    for my $count ( 0 .. scalar(@{$info->{hardware}->{$hardware}}) -1 ) {
        if ( exists $info->{hardware}->{$hardware}->[$count]->{$field} ) {
            $index = $count;
            last;
        }
Francesc Guasch's avatar
Francesc Guasch committed
794
    }
795
796
797
798
799
800
801
    confess "Device without $field in ".$domain->name
        ."\n".Dumper($info->{hardware}->{$hardware})
        if !defined $index;

    my $device = $info->{hardware}->{$hardware}->[$index];
    confess "Device without $field in ".$domain->name."\n".Dumper($device)
        if !exists $device->{$field};
Francesc Guasch's avatar
Francesc Guasch committed
802
    my $capacity = Ravada::Utils::size_to_number(
803
        $info->{hardware}->{$hardware}->[$index]->{$field}
Francesc Guasch's avatar
Francesc Guasch committed
804
805
806
807
    );
    ok(defined $capacity,"Expecting some $field") or exit;
    my $new_capacity = int(( $capacity +1 ) * 2);
    isnt($new_capacity, $capacity) or exit;
808
    isnt( $info->{hardware}->{$hardware}->[$index]->{$field}, $new_capacity );
Francesc Guasch's avatar
Francesc Guasch committed
809
810

    my $file = $info->{hardware}->{$hardware}->[$index]->{file};
811
812
    ok($file) or die Dumper($info->{hardware}->{$hardware}->[$index]);

Francesc Guasch's avatar
Francesc Guasch committed
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
    my @volumes = $domain->list_volumes();
    is($volumes[$index], $file) or exit;

    my $req = Ravada::Request->change_hardware(
        id_domain => $domain->id
        ,hardware => 'disk'
           ,index => $index
            ,data => { $field=> $new_capacity }
             ,uid => user_admin->id
    );

    rvd_back->_process_requests_dont_fork();

    is($req->status,'done');
    is($req->error, '',"Changing $field from $capacity to $new_capacity") or exit;

    my $domain_b = Ravada::Domain->open($domain->id);
    my $info_b = $domain_b->info(user_admin);
    $domain_f = Ravada::Front::Domain->open($domain->id);
    $info = $domain_f->info(user_admin);

    my $found_capacity
835
    = Ravada::Utils::size_to_number($info->{hardware}->{$hardware}->[$index]->{$field});
Francesc Guasch's avatar
Francesc Guasch committed
836
837
838
839
840
841
842
843
844
    is( int($found_capacity/1024)
        ,int($new_capacity/1024), $domain_b->name." $field \n"
        .Dumper($info->{hardware}->{$hardware}->[$index]) ) or exit;
    is( $info->{hardware}->{$hardware}->[$index]->{file}, $file);
}

sub test_change_usb($vm, $domain) {
}

Francesc Guasch's avatar
Francesc Guasch committed
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
sub test_cdrom($domain, $index, $file_new) {
    my $req = Ravada::Request->change_hardware(
            id_domain => $domain->id
            ,hardware =>'disk'
            ,index => $index
            ,data => { file => $file_new }
            ,uid => user_admin->id
        );

    rvd_back->_process_requests_dont_fork();

    is($req->status,'done');
    is($req->error, '') or exit;

    my $domain2 = Ravada::Domain->open($domain->id);
    my $info = $domain2->info(user_admin);

    my $cdrom2 = $info->{hardware}->{disk}->[$index];
    if ($file_new) {
        is ($cdrom2->{file}, $file_new);
    } else {
        ok(!exists $cdrom2->{file},"[".$domain->type."] Expecting no file. ".Dumper($cdrom2));
    }

}
sub test_change_disk_cdrom($vm, $domain) {
    my ($index,$cdrom) = _search_cdrom($domain);
    ok($cdrom) or exit;
    ok(defined $cdrom->{file},"Expecting file field in ".Dumper($cdrom));

    my $file_old = $cdrom->{file};
Francesc Guasch's avatar
Francesc Guasch committed
876
    my $file_new = '/tmp/test-".base_domain_name.".iso';
Francesc Guasch's avatar
Francesc Guasch committed
877
878
879
880
881
882
883
    open my $out,'>',$file_new or die "$! $file_new";
    print $out Dump({ data => $$ });
    close $out;

    test_cdrom($domain, $index, $file_new);
    test_cdrom($domain, $index, '');
    test_cdrom($domain, $index, $file_old);
Francesc Guasch's avatar
Francesc Guasch committed
884
    unlink $file_new or die "$! $file_new";
Francesc Guasch's avatar
Francesc Guasch committed
885
886
887
888
889
}

sub _search_cdrom($domain) {
    my $count=0;
    for my $device ( $domain->list_volumes_info ) {
890
        return ($count,$device) if ($device->info()->{device} eq 'cdrom');
Francesc Guasch's avatar
Francesc Guasch committed
891
892
893
894
895
896
897
        $count++;
    }
}

sub _search_disk($domain) {
    my $count=0;
    for my $device ( $domain->list_volumes_info ) {
Francesc Guasch's avatar
Francesc Guasch committed
898
        return $count if ($device->info->{device} eq 'disk');
Francesc Guasch's avatar
Francesc Guasch committed
899
900
        $count++;
    }
Francesc Guasch's avatar
Francesc Guasch committed
901
    return 0;
Francesc Guasch's avatar
Francesc Guasch committed
902
903
904
}


Francesc Guasch's avatar
Francesc Guasch committed
905
906
sub test_change_disk($vm, $domain) {
    test_change_disk_field($vm, $domain, 'capacity');
Francesc Guasch's avatar
Francesc Guasch committed
907
    test_change_disk_cdrom($vm, $domain);
Francesc Guasch's avatar
Francesc Guasch committed
908
909
}

Francesc Guasch's avatar
Francesc Guasch committed
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
sub test_change_network_bridge($vm, $domain, $index) {
    SKIP: {
    my @bridges = $vm->list_network_interfaces('bridge');

    skip("No bridges found in this system",6) if !scalar @bridges;
    my $info = $domain->info(user_admin);
    is ($info->{hardware}->{network}->[$index]->{type}, 'NAT') or exit;

    ok(scalar @bridges,"No network bridges defined in this host") or return;

    diag("Testing network bridge ".$bridges[0]);
    my $req = Ravada::Request->change_hardware(
        id_domain => $domain->id
        ,hardware => 'network'
           ,index => $index
            ,data => { type => 'bridge', bridge => $bridges[0]}
             ,uid => user_admin->id
    );

    rvd_back->_process_requests_dont_fork();

    is($req->status,'done');
    is($req->error, '');

    my $domain_f = Ravada::Front::Domain->open($domain->id);
    $info = $domain_f->info(user_admin);
936
937
    is ($info->{hardware}->{network}->[$index]->{type}, 'bridge', $domain->name)
        or die Dumper($info->{hardware}->{network});
Francesc Guasch's avatar
Francesc Guasch committed
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
    is ($info->{hardware}->{network}->[$index]->{bridge}, $bridges[0] );

    }
}

sub test_change_network_nat($vm, $domain, $index) {
    my $info = $domain->info(user_admin);

    my @nat = $vm->list_network_interfaces( 'nat');
    ok(scalar @nat,"No NAT network defined in this host") or return;

    diag("Testing network NAT ".$nat[0]);
    my $req = Ravada::Request->change_hardware(
        id_domain => $domain->id
        ,hardware => 'network'
           ,index => $index
            ,data => { type => 'NAT', network => $nat[0]}
             ,uid => user_admin->id
    );

    rvd_back->_process_requests_dont_fork();

    is($req->status,'done');
    is($req->error, '');

    my $domain_f = Ravada::Front::Domain->open($domain->id);
    $info = $domain_f->info(user_admin);
    is ($info->{hardware}->{network}->[$index]->{type}, 'NAT');
    is ($info->{hardware}->{network}->[$index]->{network}, $nat[0] );

}

sub test_change_network($vm, $domain) {
    my $domain_f = Ravada::Front::Domain->open($domain->id);
    my $info = $domain_f->info(user_admin);

    my $hardware = 'network';

    my $index = int(scalar(@{$info->{hardware}->{$hardware}}) / 2);

    test_change_network_bridge($vm, $domain, $index);
    test_change_network_nat($vm, $domain, $index);
Francesc Guasch's avatar
Francesc Guasch committed
980
    _test_change_defaults($domain,'network');
Francesc Guasch's avatar
Francesc Guasch committed
981
982
}

Francesc Guasch's avatar
Francesc Guasch committed
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
sub _test_change_defaults($domain,$hardware) {
    my @args = (
        hardware => $hardware
        ,id_domain => $domain->id
        ,uid => user_admin->id
        ,index => 0
    );
    my $req = Ravada::Request->change_hardware(
        @args
        ,data => {}
    );
    wait_request();

}

sub _test_change_cpu($vm, $domain) {
    _test_change_defaults($domain,'cpu');
}
For faster browsing, not all history is shown. View entire blame