The TCK module requires stuff in the NetworkHelpers and also vica-verca. This circular dependancy causes import problems, when trying to use the functions in NetworkHelpers from the TCK module. Signed-off-by: Daniel P. Berrangé <berrange@xxxxxxxxxx> --- MANIFEST | 1 - lib/Sys/Virt/TCK.pm | 71 +++++++++++++++++++++- lib/Sys/Virt/TCK/NetworkHelpers.pm | 72 ----------------------- scripts/domain/180-interface-parameters.t | 1 - scripts/nwfilter/100-ping-still-working.t | 1 - scripts/nwfilter/210-no-mac-spoofing.t | 1 - scripts/nwfilter/220-no-ip-spoofing.t | 1 - scripts/nwfilter/230-no-mac-broadcast.t | 1 - scripts/nwfilter/240-no-arp-spoofing.t | 1 - scripts/nwfilter/300-vsitype.t | 1 - 10 files changed, 70 insertions(+), 81 deletions(-) delete mode 100644 lib/Sys/Virt/TCK/NetworkHelpers.pm diff --git a/MANIFEST b/MANIFEST index 9338981..79f93c0 100644 --- a/MANIFEST +++ b/MANIFEST @@ -8,7 +8,6 @@ lib/Sys/Virt/TCK/Capabilities.pm lib/Sys/Virt/TCK/DomainBuilder.pm lib/Sys/Virt/TCK/Hooks.pm lib/Sys/Virt/TCK/NetworkBuilder.pm -lib/Sys/Virt/TCK/NetworkHelpers.pm lib/Sys/Virt/TCK/SELinux.pm lib/Sys/Virt/TCK/StoragePoolBuilder.pm lib/Sys/Virt/TCK/StorageVolBuilder.pm diff --git a/lib/Sys/Virt/TCK.pm b/lib/Sys/Virt/TCK.pm index 1a835bd..60bd136 100644 --- a/lib/Sys/Virt/TCK.pm +++ b/lib/Sys/Virt/TCK.pm @@ -34,6 +34,7 @@ use IO::Uncompress::Bunzip2 qw(bunzip2); use XML::XPath; use Carp qw(cluck carp); use Fcntl qw(O_RDONLY SEEK_END); +use NetAddr::IP qw(:lower); use Test::More; use Sub::Uplevel qw(uplevel); @@ -41,7 +42,9 @@ use base qw(Exporter); our @EXPORT = qw(ok_error ok_domain ok_domain_snapshot ok_pool ok_volume ok_network ok_interface ok_node_device - xpath err_not_implemented); + xpath err_not_implemented get_first_macaddress + get_first_interface_target_dev get_network_ip + get_ip_from_leases shutdown_vm_gracefully); our $VERSION = 'v0.1.0'; @@ -1230,4 +1233,70 @@ sub get_host_network_device { return $self->config("host_network_devices/[$devindex]", undef); } +sub get_first_macaddress { + my $dom = shift; + my $mac = xpath($dom, "string(/domain/devices/interface[1]/mac/\@address)"); + utf8::encode($mac); + return $mac; +} + +sub get_first_interface_target_dev { + my $dom = shift; + my $targetdev = xpath($dom, "string(/domain/devices/interface[1]/target/\@dev)"); + return $targetdev; +} + +sub get_network_ip { + my $conn = shift; + my $netname = shift; + diag "getting ip for network $netname"; + my $net = $conn->get_network_by_name($netname); + my $net_ip = xpath($net, "string(/network/ip[1]/\@address"); + my $net_mask = xpath($net, "string(/network/ip[1]/\@netmask"); + my $net_prefix = xpath($net, "string(/network/ip[1]/\@prefix"); + my $ip; + + if ($net_mask) { + $ip = NetAddr::IP->new($net_ip, $net_mask); + } elsif ($net_prefix) { + $ip = NetAddr::IP->new("$net_ip/$net_mask"); + } else { + $ip = NetAddr::IP->new("$net_ip"); + } + return $ip; +} + + +sub get_ip_from_leases{ + my $conn = shift; + my $netname = shift; + my $mac = shift; + + my $net = $conn->get_network_by_name($netname); + if ($net->can('get_dhcp_leases')) { + my @leases = $net->get_dhcp_leases($mac); + return @leases ? @leases[0]->{'ipaddr'} : undef; + } + + my $tmp = `grep $mac /var/lib/libvirt/dnsmasq/default.leases`; + my @fields = split(/ /, $tmp); + my $ip = $fields[2]; + return $ip; +} + + +sub shutdown_vm_gracefully { + my $dom = shift; + + my $target = time() + 30; + $dom->shutdown; + while ($dom->is_active()) { + sleep(1); + diag ".. waiting for virtual machine to shutdown.. "; + $dom->destroy() if time() > $target; + } + sleep(1); + diag ".. shutdown complete.. "; +} + 1; diff --git a/lib/Sys/Virt/TCK/NetworkHelpers.pm b/lib/Sys/Virt/TCK/NetworkHelpers.pm deleted file mode 100644 index 50ade0f..0000000 --- a/lib/Sys/Virt/TCK/NetworkHelpers.pm +++ /dev/null @@ -1,72 +0,0 @@ -use Sys::Virt::TCK qw(xpath); -use NetAddr::IP qw(:lower); -use strict; -use utf8; - -sub get_first_macaddress { - my $dom = shift; - my $mac = xpath($dom, "string(/domain/devices/interface[1]/mac/\@address)"); - utf8::encode($mac); - return $mac; -} - -sub get_first_interface_target_dev { - my $dom = shift; - my $targetdev = xpath($dom, "string(/domain/devices/interface[1]/target/\@dev)"); - return $targetdev; -} - -sub get_network_ip { - my $conn = shift; - my $netname = shift; - diag "getting ip for network $netname"; - my $net = $conn->get_network_by_name($netname); - my $net_ip = xpath($net, "string(/network/ip[1]/\@address"); - my $net_mask = xpath($net, "string(/network/ip[1]/\@netmask"); - my $net_prefix = xpath($net, "string(/network/ip[1]/\@prefix"); - my $ip; - - if ($net_mask) { - $ip = NetAddr::IP->new($net_ip, $net_mask); - } elsif ($net_prefix) { - $ip = NetAddr::IP->new("$net_ip/$net_mask"); - } else { - $ip = NetAddr::IP->new("$net_ip"); - } - return $ip; -} - - -sub get_ip_from_leases{ - my $conn = shift; - my $netname = shift; - my $mac = shift; - - my $net = $conn->get_network_by_name($netname); - if ($net->can('get_dhcp_leases')) { - my @leases = $net->get_dhcp_leases($mac); - return @leases ? @leases[0]->{'ipaddr'} : undef; - } - - my $tmp = `grep $mac /var/lib/libvirt/dnsmasq/default.leases`; - my @fields = split(/ /, $tmp); - my $ip = $fields[2]; - return $ip; -} - - -sub shutdown_vm_gracefully { - my $dom = shift; - - my $target = time() + 30; - $dom->shutdown; - while ($dom->is_active()) { - sleep(1); - diag ".. waiting for virtual machine to shutdown.. "; - $dom->destroy() if time() > $target; - } - sleep(1); - diag ".. shutdown complete.. "; -} - -1; diff --git a/scripts/domain/180-interface-parameters.t b/scripts/domain/180-interface-parameters.t index 66c7ed6..b3f0c19 100644 --- a/scripts/domain/180-interface-parameters.t +++ b/scripts/domain/180-interface-parameters.t @@ -33,7 +33,6 @@ use warnings; use Test::More tests => 10; use Sys::Virt::TCK; -use Sys::Virt::TCK::NetworkHelpers; use Test::Exception; use File::stat; diff --git a/scripts/nwfilter/100-ping-still-working.t b/scripts/nwfilter/100-ping-still-working.t index 12f2c7c..a88eb02 100644 --- a/scripts/nwfilter/100-ping-still-working.t +++ b/scripts/nwfilter/100-ping-still-working.t @@ -30,7 +30,6 @@ use warnings; use Test::More tests => 4; use Sys::Virt::TCK; -use Sys::Virt::TCK::NetworkHelpers; use Test::Exception; use File::Spec::Functions qw(catfile catdir rootdir); diff --git a/scripts/nwfilter/210-no-mac-spoofing.t b/scripts/nwfilter/210-no-mac-spoofing.t index 95b1499..87c19e7 100644 --- a/scripts/nwfilter/210-no-mac-spoofing.t +++ b/scripts/nwfilter/210-no-mac-spoofing.t @@ -29,7 +29,6 @@ use warnings; use Test::More tests => 5; use Sys::Virt::TCK; -use Sys::Virt::TCK::NetworkHelpers; use Test::Exception; use Net::OpenSSH; diff --git a/scripts/nwfilter/220-no-ip-spoofing.t b/scripts/nwfilter/220-no-ip-spoofing.t index a1da6eb..bacb861 100644 --- a/scripts/nwfilter/220-no-ip-spoofing.t +++ b/scripts/nwfilter/220-no-ip-spoofing.t @@ -29,7 +29,6 @@ use warnings; use Test::More tests => 4; use Sys::Virt::TCK; -use Sys::Virt::TCK::NetworkHelpers; use Test::Exception; use Net::OpenSSH; diff --git a/scripts/nwfilter/230-no-mac-broadcast.t b/scripts/nwfilter/230-no-mac-broadcast.t index 4254e7c..b518a81 100644 --- a/scripts/nwfilter/230-no-mac-broadcast.t +++ b/scripts/nwfilter/230-no-mac-broadcast.t @@ -29,7 +29,6 @@ use warnings; use Test::More tests => 4; use Sys::Virt::TCK; -use Sys::Virt::TCK::NetworkHelpers; use Test::Exception; use Net::OpenSSH; use File::Spec::Functions qw(catfile catdir rootdir); diff --git a/scripts/nwfilter/240-no-arp-spoofing.t b/scripts/nwfilter/240-no-arp-spoofing.t index 882a385..77b36d2 100644 --- a/scripts/nwfilter/240-no-arp-spoofing.t +++ b/scripts/nwfilter/240-no-arp-spoofing.t @@ -29,7 +29,6 @@ use warnings; use Test::More tests => 4; use Sys::Virt::TCK; -use Sys::Virt::TCK::NetworkHelpers; use Test::Exception; use Net::OpenSSH; use File::Spec::Functions qw(catfile catdir rootdir); diff --git a/scripts/nwfilter/300-vsitype.t b/scripts/nwfilter/300-vsitype.t index 90d237f..3af9d4f 100644 --- a/scripts/nwfilter/300-vsitype.t +++ b/scripts/nwfilter/300-vsitype.t @@ -29,7 +29,6 @@ use warnings; use Test::More; use Sys::Virt::TCK; -use Sys::Virt::TCK::NetworkHelpers; use Test::Exception; use File::Spec::Functions qw(catfile catdir rootdir); -- 2.17.0 -- libvir-list mailing list libvir-list@xxxxxxxxxx https://www.redhat.com/mailman/listinfo/libvir-list