Commit bc95c998 authored by Daniel P. Berrangé's avatar Daniel P. Berrangé

lib: merge NetworkHelpers module into main TCK module

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.
Reviewed-by: 's avatarLaine Stump <laine@laine.org>
Signed-off-by: 's avatarDaniel P. Berrangé <berrange@redhat.com>
parent a4b03d9f
......@@ -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
......
......@@ -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;
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;
......@@ -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;
......
......@@ -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);
......
......@@ -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;
......
......@@ -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;
......
......@@ -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);
......
......@@ -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);
......
......@@ -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);
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment