70_network.t 2.91 KB
Newer Older
Francesc Guasch's avatar
Francesc Guasch committed
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
use warnings;
use strict;

use Carp qw(carp confess cluck);
use Data::Dumper;
use JSON::XS;
use POSIX qw(WNOHANG);
use Test::More;

no warnings "experimental::signatures";
use feature qw(signatures);

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

init();

############################################################
sub test_list_nats($vm) {

    my @exp_nat =   grep { defined $_ && !/^Name$/ }
                    map { /^\s+(\w+)\s*/; $1 }
                    split /\n/,`virsh net-list`;

    my $req = Ravada::Request->list_network_interfaces(
             uid => user_admin->id
           ,type => 'nat'
        ,vm_type => $vm->type
    );
    rvd_back->_process_requests_dont_fork();
    is($req->status,'done');
    is($req->error,'');
    is($req->output,"[\"$exp_nat[0]\"]");

    my $nats = rvd_front->list_network_interfaces(
           user => user_admin
          ,type => 'nat'
       ,vm_type => $vm->type
    );
    ok($nats);

}

sub _remove_qemu_bridges($vm, $bridges) {
    my @nat = $vm->list_network_interfaces('nat');

    my %bridges = map { $_ => 1 } @$bridges;
    for my $nat ( @nat ) {
        my $nat_bridge = `virsh net-info $nat| egrep "^Bridge:" | awk '{ print \$2 }'`;
        chomp $nat_bridge;
        chomp $nat_bridge;
        delete $bridges{$nat_bridge}
    }
    return keys %bridges;
}

sub test_list_bridges($vm) {

    is(rvd_front->{_networks_bridge},undef);

    my $req = Ravada::Request->list_network_interfaces(
             uid => user_admin->id
           ,type => 'bridge'
        ,vm_type => $vm->type
    );
    rvd_back->_process_requests_dont_fork();
    is($req->status,'done');
    is($req->error,'');

70
    my @exp_bridges = sort(_expected_bridges($vm));
Francesc Guasch's avatar
Francesc Guasch committed
71
72
73
74
75
76
77
78
79
80
81
    is($req->output,encode_json(\@exp_bridges));

    my $bridges = rvd_front->list_network_interfaces(
           user => user_admin
          ,type => 'bridge'
       ,vm_type => $vm->type
      );
    ok($bridges);

    SKIP: {
        skip("No system bridges found",1) if !scalar @exp_bridges;
82
        like($req->output, qr/\["[\w\d]+".*\]/);
Francesc Guasch's avatar
Francesc Guasch committed
83
84
85
    }
}
sub _expected_bridges($vm) {
86
87
    my $brctl = `which brctl`;
    chomp $brctl;
88
    return undef if !$brctl;
89

Francesc Guasch's avatar
Francesc Guasch committed
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
    my @exp_bridges =   grep { defined $_ && $_ ne 'bridge' }
    map { /(^\w+)\s*/; $1 }
    split /\n/,`brctl show`;
    @exp_bridges = _remove_qemu_bridges($vm, \@exp_bridges);

    return @exp_bridges;
}

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

for my $vm_name (qw(KVM)) {
    my $vm;
    my $msg = "SKIPPED: virtual manager $vm_name not found";
    eval {
        $vm= rvd_back->search_vm($vm_name)  if rvd_back();

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

    };

    SKIP: {
        diag($msg)      if !$vm;
        skip($msg,10)   if !$vm;
        diag("Testing requests with $vm_name");

        test_list_nats($vm);
        test_list_bridges($vm);
    }


}

clean();
done_testing();