Merge branch 'main' into feature/750_uefi

Makefile.PL

@@ -34,6 +34,7 @@ WriteMakefile(
   },
   BUILD_REQUIRES => {
     'Test::Perl::Critic' => 0
+    ,'Test::Moose::More' => 0
   },
 
   test      => {TESTS => 't/*.t t/*/*.t'},

lib/Ravada/Domain/KVM.pm

@@ -1634,13 +1634,20 @@ sub _ip_agent($self) {
     return if $@ && $@ =~ /^libvirt error code: (74|86),/;
     warn $@ if $@;
 
+    my $found;
     for my $if (@ip) {
         next if $if->{name} =~ /^lo/;
         for my $addr ( @{$if->{addrs}} ) {
+
+            next unless $addr->{type} == 0 && $addr->{addr} !~ /^127\./;
+
+            $found = $addr->{addr} if !$found;
+
             return $addr->{addr}
-            if $addr->{type} == 0 && $addr->{addr} !~ /^127\./;
+            if $self->_vm->_is_ip_bridged($addr->{addr});
         }
     }
+    return $found;
 }
 
 #sub _ip_arp($self) {
@@ -1658,7 +1665,7 @@ sub ip($self) {
     return $ip[0]->{addrs}->[0]->{addr} if $ip[0];
 
 #    @ip = $self->_ip_arp();
-    return $ip[0]->{addrs}->[0]->{addr} if $ip[0];
+#    return $ip[0]->{addrs}->[0]->{addr} if $ip[0];
 
     return $self->_ip_agent();
 

lib/Ravada/VM/KVM.pm

@@ -2554,7 +2554,21 @@ sub list_machine_types($self) {
         $ret_types{$arch} = [sort @types];
     }
     return %ret_types;
+}
 
+sub _is_ip_bridged($self, $ip0) {
+    my $ip = NetAddr::IP->new($ip0);
+    for my $net ( $self->vm->list_networks ) {
+        my $xml = XML::LibXML->load_xml(string
+            => $net->get_xml_description());
+        my ($xml_ip) = $xml->findnodes("/network/ip");
+        next if !$xml_ip;
+        my $address = $xml_ip->getAttribute('address');
+        my $netmask = $xml_ip->getAttribute('netmask');
+        my $net = NetAddr::IP->new($address,$netmask);
+        return 1 if $ip->within($net);
+    }
+    return 0;
 }
 
 1;

t/kvm/b10_bridged.t

+use warnings;
+use strict;
+
+use Carp qw(confess);
+use Data::Dumper;
+use IPC::Run3;
+use JSON::XS;
+use Test::More;
+
+use lib 't/lib';
+use Test::Ravada;
+
+no warnings "experimental::signatures";
+use feature qw(signatures);
+
+########################################################################
+
+sub test_bridge($vm) {
+    for my $net ( $vm->vm->list_all_networks ) {
+        my $xml = XML::LibXML->load_xml(string
+            => $net->get_xml_description());
+        my ($xml_ip) = $xml->findnodes("/network/ip");
+        my $address = $xml_ip->getAttribute('address');
+        $address =~ s/\.\d+$/.4/;
+        is($vm->_is_ip_bridged($address),1);
+    }
+    is($vm->_is_ip_bridged("127.0.0.1"),0);
+}
+
+########################################################################
+clean();
+
+for my $vm_name ( 'KVM' ) {
+
+    SKIP: {
+        my $vm = rvd_back->search_vm($vm_name);
+
+        my $msg = "SKIPPED test: No $vm_name VM found ";
+        if ($vm && $>) {
+              $msg = "SKIPPED: Test must run as root";
+              $vm = undef;
+        }
+
+        diag($msg)      if !$vm;
+        skip $msg,10    if !$vm;
+
+        test_bridge($vm);
+    }
+}
+
+end();
+
+done_testing();