Refactor list networks (#1372)

* refactor: removed not best practice return undef

* test: do not test LXC by now

* refactor(backend): generic list networks

lib/Ravada/VM.pm

@@ -1854,6 +1854,82 @@ sub _new_free_port($self) {
     return $free_port;
 }
 
+sub list_network_interfaces($self, $type) {
+    my $sub = {
+        nat => \&_list_nat_interfaces
+        ,bridge => \&_list_bridges
+    };
+
+    my $cmd = $sub->{$type} or confess "Error: Unknown interface type $type";
+    return $cmd->($self);
+}
+
+sub _list_nat_interfaces($self) {
+
+    my @cmd = ( '/usr/bin/virsh','net-list');
+    my ($out,$err) = $self->run_command(@cmd);
+
+    my @lines = split /\n/,$out;
+    shift @lines;
+    shift @lines;
+
+    my @networks;
+    for (@lines) {
+        /\s*(.*?)\s+.*/;
+        push @networks,($1) if $1;
+    }
+    return @networks;
+}
+
+sub _get_nat_bridge($self, $net) {
+    my @cmd = ( '/usr/bin/virsh','net-info', $net);
+    my ($out,$err) = $self->run_command(@cmd);
+
+    for my $line (split /\n/, $out) {
+        my ($bridge) = $line =~ /^Bridge:\s+(.*)/;
+        return $bridge if $bridge;
+    }
+}
+
+sub _list_qemu_bridges($self) {
+    my %bridge;
+    my @networks = $self->_list_nat_interfaces();
+    for my $net (@networks) {
+        my $nat_bridge = $self->_get_nat_bridge($net);
+        $bridge{$nat_bridge}++;
+    }
+    return keys %bridge;
+}
+
+sub _which($self, $command) {
+    return $self->{_which}->{$command} if exists $self->{_which} && exists $self->{_which}->{$command};
+    my @cmd = ( '/bin/which',$command);
+    my ($out,$err) = $self->run_command(@cmd);
+    chomp $out;
+    $self->{_which}->{$command} = $out;
+    return $out;
+}
+
+sub _list_bridges($self) {
+
+    my %qemu_bridge = map { $_ => 1 } $self->_list_qemu_bridges();
+
+    my @cmd = ( $self->_which('brctl'),'show');
+    my ($out,$err) = $self->run_command(@cmd);
+
+    die $err if $err;
+    my @lines = split /\n/,$out;
+    shift @lines;
+
+    my @networks;
+    for (@lines) {
+        my ($bridge, $interface) = /\s*(.*?)\s+.*\s(.*)/;
+        push @networks,($bridge) if $bridge && !$qemu_bridge{$bridge};
+    }
+    $self->{_bridges} = \@networks;
+    return @networks;
+}
+
 1;
 
 

lib/Ravada/VM/KVM.pm

@@ -77,9 +77,6 @@ our $CONNECTOR = \$Ravada::CONNECTOR;
 our $WGET = `which wget`;
 chomp $WGET;
 
-our $BRCTL = `which brctl`;
-chomp $BRCTL;
-
 our $CACHE_DOWNLOAD = 1;
 our $VERIFY_ISO = 1;
 
@@ -2311,76 +2308,6 @@ sub _fetch_dir_cert($self) {
     close $in;
 }
 
-sub list_network_interfaces($self, $type) {
-    my $sub = {
-        nat => \&_list_nat_interfaces
-        ,bridge => \&_list_bridges
-    };
-
-    my $cmd = $sub->{$type} or confess "Error: Unknown interface type $type";
-    return $cmd->($self);
-}
-
-sub _list_nat_interfaces($self) {
-
-    my ($in, $out, $err);
-    my @cmd = ( '/usr/bin/virsh','net-list');
-    run3(\@cmd, \$in, \$out, \$err);
-
-    my @lines = split /\n/,$out;
-    shift @lines;
-    shift @lines;
-
-    my @networks;
-    for (@lines) {
-        /\s*(.*?)\s+.*/;
-        push @networks,($1) if $1;
-    }
-    return @networks;
-}
-
-sub _get_nat_bridge($net) {
-    my ($in, $out, $err);
-    my @cmd = ( '/usr/bin/virsh','net-info', $net);
-    run3(\@cmd, \$in, \$out, \$err);
-
-    for my $line (split /\n/, $out) {
-        my ($bridge) = $line =~ /^Bridge:\s+(.*)/;
-        return $bridge if $bridge;
-    }
-}
-
-sub _list_qemu_bridges($self) {
-    my %bridge;
-    my @networks = $self->_list_nat_interfaces();
-    for my $net (@networks) {
-        my $nat_bridge = _get_nat_bridge($net);
-        $bridge{$nat_bridge}++;
-    }
-    return keys %bridge;
-}
-
-sub _list_bridges($self) {
-
-    return () if !-e $BRCTL;
-    my %qemu_bridge = map { $_ => 1 } $self->_list_qemu_bridges();
-
-    my @cmd = ( $BRCTL,'show');
-    my ($out,$err) = $self->run_command(@cmd);
-
-    die $err if $err;
-    my @lines = split /\n/,$out;
-    shift @lines;
-
-    my @networks;
-    for (@lines) {
-        my ($bridge, $interface) = /\s*(.*?)\s+.*\s(.*)/;
-        push @networks,($bridge) if $bridge && !$qemu_bridge{$bridge};
-    }
-    $self->{_bridges} = \@networks;
-    return @networks;
-}
-
 sub free_disk($self, $pool_name = undef ) {
     my $pool;
     if ($pool_name) {

t/request/70_network.t

@@ -36,6 +36,7 @@ sub test_list_nats($vm) {
            user => user_admin
           ,type => 'nat'
        ,vm_type => $vm->type
+       ,timeout => 1
     );
     ok($nats);
 
@@ -74,6 +75,7 @@ sub test_list_bridges($vm) {
            user => user_admin
           ,type => 'bridge'
        ,vm_type => $vm->type
+       ,timeout => 1
       );
     ok($bridges);