1. Patchew
  2. Libvirt
  3. View series

[libvirt] [tck PATCH] Add script testing network bandwidth functionality

Daniel P. Berrangé posted 1 patch 5 years, 1 month ago
Failed in applying to current master (apply log)
lib/Sys/Virt/TCK/DomainBuilder.pm      |  10 ++
lib/Sys/Virt/TCK/NetworkBuilder.pm     |  20 ++++
scripts/networks/400-guest-bandwidth.t | 147 +++++++++++++++++++++++++
3 files changed, 177 insertions(+)
create mode 100644 scripts/networks/400-guest-bandwidth.t
[libvirt] [tck PATCH] Add script testing network bandwidth functionality
Posted by Daniel P. Berrangé 5 years, 1 month ago 
Signed-off-by: Daniel P. Berrangé <berrange@redhat.com>
---
 lib/Sys/Virt/TCK/DomainBuilder.pm      |  10 ++
 lib/Sys/Virt/TCK/NetworkBuilder.pm     |  20 ++++
 scripts/networks/400-guest-bandwidth.t | 147 +++++++++++++++++++++++++
 3 files changed, 177 insertions(+)
 create mode 100644 scripts/networks/400-guest-bandwidth.t

diff --git a/lib/Sys/Virt/TCK/DomainBuilder.pm b/lib/Sys/Virt/TCK/DomainBuilder.pm
index 399534c..45336b5 100644
--- a/lib/Sys/Virt/TCK/DomainBuilder.pm
+++ b/lib/Sys/Virt/TCK/DomainBuilder.pm
@@ -466,6 +466,16 @@ sub as_xml {
             $w->emptyTag("model",
                          type => $interface->{model});
         }
+	if ($interface->{bandwidth}) {
+	    $w->startTag("bandwidth");
+	    if ($interface->{bandwidth}->{"in"}) {
+		$w->emptyTag("inbound", %{$interface->{bandwidth}->{"in"}});
+	    }
+	    if ($interface->{bandwidth}->{"out"}) {
+		$w->emptyTag("outbound", %{$interface->{bandwidth}->{"out"}});
+	    }
+	    $w->endTag("bandwidth");
+	}
         if ($interface->{filterref}) {
             $w->startTag("filterref",
                          filter => $interface->{filterref});
diff --git a/lib/Sys/Virt/TCK/NetworkBuilder.pm b/lib/Sys/Virt/TCK/NetworkBuilder.pm
index ad0cab8..446cc4f 100644
--- a/lib/Sys/Virt/TCK/NetworkBuilder.pm
+++ b/lib/Sys/Virt/TCK/NetworkBuilder.pm
@@ -87,6 +87,15 @@ sub ipaddr {
     return $self;
 }
 
+sub bandwidth {
+    my $self = shift;
+    my %bw = @_;
+
+    $self->{bandwidth} = \%bw;
+
+    return $self;
+}
+
 sub dhcp_range {
     my $self = shift;
     my $start = shift;
@@ -114,6 +123,17 @@ sub as_xml {
     $w->emptyTag("bridge", %{$self->{bridge}})
         if $self->{bridge};
 
+    if ($self->{bandwidth}) {
+	$w->startTag("bandwidth");
+	if ($self->{bandwidth}->{"in"}) {
+	    $w->emptyTag("inbound", %{$self->{bandwidth}->{"in"}});
+	}
+	if ($self->{bandwidth}->{"out"}) {
+	    $w->emptyTag("outbound", %{$self->{bandwidth}->{"out"}});
+	}
+	$w->endTag("bandwidth");
+    }
+
     if (exists $self->{forward}) {
 	$w->startTag("forward", %{$self->{forward}});
 	foreach (@{$self->{interfaces}}) {
diff --git a/scripts/networks/400-guest-bandwidth.t b/scripts/networks/400-guest-bandwidth.t
new file mode 100644
index 0000000..3a865fd
--- /dev/null
+++ b/scripts/networks/400-guest-bandwidth.t
@@ -0,0 +1,147 @@
+# -*- perl -*-
+#
+# Copyright (C) 2019 Red Hat, Inc.
+#
+# This program is free software; You can redistribute it and/or modify
+# it under the GNU General Public License as published by the Free
+# Software Foundation; either version 2, or (at your option) any
+# later version
+#
+# The file "LICENSE" distributed along with this file provides full
+# details of the terms and conditions
+#
+
+=pod
+
+=head1 NAME
+
+network/400-guest-bandwidth.t - guest with bandwidth limits
+
+=head1 DESCRIPTION
+
+This test case validates that a guest is connected a network
+can have bandwidth limits set
+
+=cut
+
+use strict;
+use warnings;
+
+use Test::More tests => 8;
+use Test::Exception;
+
+use Sys::Virt::TCK;
+
+my $tck = Sys::Virt::TCK->new();
+my $conn = eval { $tck->setup(); };
+BAIL_OUT "failed to setup test harness: $@" if $@;
+END { $tck->cleanup if $tck; }
+
+my %subnet = Sys::Virt::TCK->find_free_ipv4_subnet();
+
+SKIP: {
+    skip "No available IPv4 subnet", 4 unless defined $subnet{address};
+
+    my $netbuilder = Sys::Virt::TCK::NetworkBuilder->new(name => "tck");
+    $netbuilder->bridge("tck");
+    $netbuilder->ipaddr($subnet{address}, $subnet{netmask});
+    $netbuilder->dhcp_range($subnet{dhcpstart}, $subnet{dhcpend});
+    my $netxml = $netbuilder->as_xml();
+
+    diag "Creating a new transient network";
+    diag $netxml;
+    my $net;
+    ok_network(sub { $net = $conn->create_network($netxml) }, "created transient network object");
+
+    my $dombuilder = $tck->generic_domain(name => "tck");
+    $dombuilder->interface(type => "network",
+		  source => "tck",
+		  model => "virtio",
+		  mac => "52:54:00:11:11:11",
+		  bandwidth => {
+		      in => {
+			  average => 1000,
+			  peak => 5000,
+			  floor => 2000,
+			  burst => 1024,
+		      },
+		      out => {
+			  average => 128,
+			  peak => 256,
+			  burst => 256,
+		      },
+		  });
+    my $domxml = $dombuilder->as_xml();
+
+    diag "Creating a new transient domain";
+    diag $domxml;
+    my $dom;
+    ok_error(sub { $dom = $conn->create_domain($domxml) }, "Unsupported op requesting bandwidth",
+	     Sys::Virt::Error::ERR_OPERATION_UNSUPPORTED);
+
+    diag "Destroying the transient network";
+    $net->destroy;
+
+    $netbuilder->bandwidth(
+	in => {
+	    average => 1000,
+	    peak => 5000,
+	    burst => 1024,
+	},
+	out => {
+	    average => 128,
+	    peak => 256,
+	    burst => 256,
+	});
+
+    $netxml = $netbuilder->as_xml();
+
+    diag "Creating a new transient network";
+    diag $netxml;
+    ok_network(sub { $net = $conn->create_network($netxml) }, "created transient network object");
+
+    ok_domain(sub { $dom = $conn->create_domain($domxml) }, "created transient domain object");
+
+    lives_ok(sub {
+	$dom->set_interface_parameters(
+	    "52:54:00:11:11:11",
+	    {
+		Sys::Virt::Domain::BANDWIDTH_IN_AVERAGE => 1000,
+		Sys::Virt::Domain::BANDWIDTH_IN_PEAK => 5000,
+		Sys::Virt::Domain::BANDWIDTH_IN_FLOOR => 4000,
+		Sys::Virt::Domain::BANDWIDTH_IN_BURST => 1024,
+		Sys::Virt::Domain::BANDWIDTH_OUT_AVERAGE => 128,
+		Sys::Virt::Domain::BANDWIDTH_OUT_PEAK => 256,
+		Sys::Virt::Domain::BANDWIDTH_OUT_BURST => 256,
+	    })});
+    
+    ok_error(sub {
+	$dom->set_interface_parameters(
+	    "52:54:00:11:11:11",
+	    {
+		Sys::Virt::Domain::BANDWIDTH_IN_AVERAGE => 1000,
+		Sys::Virt::Domain::BANDWIDTH_IN_PEAK => 5000,
+		Sys::Virt::Domain::BANDWIDTH_IN_FLOOR => 40000,
+		Sys::Virt::Domain::BANDWIDTH_IN_BURST => 1024,
+		Sys::Virt::Domain::BANDWIDTH_OUT_AVERAGE => 128,
+		Sys::Virt::Domain::BANDWIDTH_OUT_PEAK => 256,
+		Sys::Virt::Domain::BANDWIDTH_OUT_BURST => 256,
+	    }) }, "Canot overcommit bandwidth",
+	Sys::Virt::Error::ERR_OPERATION_INVALID);
+    
+    diag "Destroying the transient guest";
+    $dom->destroy;
+
+    diag "Checking that transient domain has gone away";
+    ok_error(sub { $conn->get_domain_by_name("tck") }, "NO_DOMAIN error raised from missing domain",
+	     Sys::Virt::Error::ERR_NO_DOMAIN);
+
+    diag "Destroying the transient network";
+    $net->destroy;
+
+    diag "Checking that transient network has gone away";
+    ok_error(sub { $conn->get_network_by_name("tck") }, "NO_network error raised from missing network",
+	     Sys::Virt::Error::ERR_NO_NETWORK);
+}
+
+# end
-- 
2.20.1

--
libvir-list mailing list
libvir-list@redhat.com
https://www.redhat.com/mailman/listinfo/libvir-list
Re: [libvirt] [tck PATCH] Add script testing network bandwidth functionality
Posted by Laine Stump 5 years, 1 month ago 
On 2/26/19 1:07 PM, Daniel P. Berrangé wrote:
> Signed-off-by: Daniel P. Berrangé <berrange@redhat.com>
> ---
>   lib/Sys/Virt/TCK/DomainBuilder.pm      |  10 ++
>   lib/Sys/Virt/TCK/NetworkBuilder.pm     |  20 ++++
>   scripts/networks/400-guest-bandwidth.t | 147 +++++++++++++++++++++++++


You forgot to add the test file to MANIFEST :-)


Other than that,


Reviewed-by: Laine Stump <laine@laine.org>


(the test could be made more thorough by checking that the bandwidth had 
actually been set (by checking the output of whatever appropriate tc 
command, and maybe even by doing a netcat from host to guest and making 
sure it stays below the limit), but this is a lot better than what we 
were testing before!)

>   3 files changed, 177 insertions(+)
>   create mode 100644 scripts/networks/400-guest-bandwidth.t
>
> diff --git a/lib/Sys/Virt/TCK/DomainBuilder.pm b/lib/Sys/Virt/TCK/DomainBuilder.pm
> index 399534c..45336b5 100644
> --- a/lib/Sys/Virt/TCK/DomainBuilder.pm
> +++ b/lib/Sys/Virt/TCK/DomainBuilder.pm
> @@ -466,6 +466,16 @@ sub as_xml {
>               $w->emptyTag("model",
>                            type => $interface->{model});
>           }
> +	if ($interface->{bandwidth}) {
> +	    $w->startTag("bandwidth");
> +	    if ($interface->{bandwidth}->{"in"}) {
> +		$w->emptyTag("inbound", %{$interface->{bandwidth}->{"in"}});
> +	    }
> +	    if ($interface->{bandwidth}->{"out"}) {
> +		$w->emptyTag("outbound", %{$interface->{bandwidth}->{"out"}});
> +	    }
> +	    $w->endTag("bandwidth");
> +	}
>           if ($interface->{filterref}) {
>               $w->startTag("filterref",
>                            filter => $interface->{filterref});
> diff --git a/lib/Sys/Virt/TCK/NetworkBuilder.pm b/lib/Sys/Virt/TCK/NetworkBuilder.pm
> index ad0cab8..446cc4f 100644
> --- a/lib/Sys/Virt/TCK/NetworkBuilder.pm
> +++ b/lib/Sys/Virt/TCK/NetworkBuilder.pm
> @@ -87,6 +87,15 @@ sub ipaddr {
>       return $self;
>   }
>   
> +sub bandwidth {
> +    my $self = shift;
> +    my %bw = @_;
> +
> +    $self->{bandwidth} = \%bw;
> +
> +    return $self;
> +}
> +
>   sub dhcp_range {
>       my $self = shift;
>       my $start = shift;
> @@ -114,6 +123,17 @@ sub as_xml {
>       $w->emptyTag("bridge", %{$self->{bridge}})
>           if $self->{bridge};
>   
> +    if ($self->{bandwidth}) {
> +	$w->startTag("bandwidth");
> +	if ($self->{bandwidth}->{"in"}) {
> +	    $w->emptyTag("inbound", %{$self->{bandwidth}->{"in"}});
> +	}
> +	if ($self->{bandwidth}->{"out"}) {
> +	    $w->emptyTag("outbound", %{$self->{bandwidth}->{"out"}});
> +	}
> +	$w->endTag("bandwidth");
> +    }
> +
>       if (exists $self->{forward}) {
>   	$w->startTag("forward", %{$self->{forward}});
>   	foreach (@{$self->{interfaces}}) {
> diff --git a/scripts/networks/400-guest-bandwidth.t b/scripts/networks/400-guest-bandwidth.t
> new file mode 100644
> index 0000000..3a865fd
> --- /dev/null
> +++ b/scripts/networks/400-guest-bandwidth.t
> @@ -0,0 +1,147 @@
> +# -*- perl -*-
> +#
> +# Copyright (C) 2019 Red Hat, Inc.
> +#
> +# This program is free software; You can redistribute it and/or modify
> +# it under the GNU General Public License as published by the Free
> +# Software Foundation; either version 2, or (at your option) any
> +# later version
> +#
> +# The file "LICENSE" distributed along with this file provides full
> +# details of the terms and conditions
> +#
> +
> +=pod
> +
> +=head1 NAME
> +
> +network/400-guest-bandwidth.t - guest with bandwidth limits
> +
> +=head1 DESCRIPTION
> +
> +This test case validates that a guest is connected a network
> +can have bandwidth limits set
> +
> +=cut
> +
> +use strict;
> +use warnings;
> +
> +use Test::More tests => 8;
> +use Test::Exception;
> +
> +use Sys::Virt::TCK;
> +
> +my $tck = Sys::Virt::TCK->new();
> +my $conn = eval { $tck->setup(); };
> +BAIL_OUT "failed to setup test harness: $@" if $@;
> +END { $tck->cleanup if $tck; }
> +
> +my %subnet = Sys::Virt::TCK->find_free_ipv4_subnet();
> +
> +SKIP: {
> +    skip "No available IPv4 subnet", 4 unless defined $subnet{address};
> +
> +    my $netbuilder = Sys::Virt::TCK::NetworkBuilder->new(name => "tck");
> +    $netbuilder->bridge("tck");
> +    $netbuilder->ipaddr($subnet{address}, $subnet{netmask});
> +    $netbuilder->dhcp_range($subnet{dhcpstart}, $subnet{dhcpend});
> +    my $netxml = $netbuilder->as_xml();
> +
> +    diag "Creating a new transient network";
> +    diag $netxml;
> +    my $net;
> +    ok_network(sub { $net = $conn->create_network($netxml) }, "created transient network object");
> +
> +    my $dombuilder = $tck->generic_domain(name => "tck");
> +    $dombuilder->interface(type => "network",
> +		  source => "tck",
> +		  model => "virtio",
> +		  mac => "52:54:00:11:11:11",
> +		  bandwidth => {
> +		      in => {
> +			  average => 1000,
> +			  peak => 5000,
> +			  floor => 2000,
> +			  burst => 1024,
> +		      },
> +		      out => {
> +			  average => 128,
> +			  peak => 256,
> +			  burst => 256,
> +		      },
> +		  });
> +    my $domxml = $dombuilder->as_xml();
> +
> +    diag "Creating a new transient domain";
> +    diag $domxml;
> +    my $dom;
> +    ok_error(sub { $dom = $conn->create_domain($domxml) }, "Unsupported op requesting bandwidth",
> +	     Sys::Virt::Error::ERR_OPERATION_UNSUPPORTED);
> +
> +    diag "Destroying the transient network";
> +    $net->destroy;
> +
> +    $netbuilder->bandwidth(
> +	in => {
> +	    average => 1000,
> +	    peak => 5000,
> +	    burst => 1024,
> +	},
> +	out => {
> +	    average => 128,
> +	    peak => 256,
> +	    burst => 256,
> +	});
> +
> +    $netxml = $netbuilder->as_xml();
> +
> +    diag "Creating a new transient network";
> +    diag $netxml;
> +    ok_network(sub { $net = $conn->create_network($netxml) }, "created transient network object");
> +
> +    ok_domain(sub { $dom = $conn->create_domain($domxml) }, "created transient domain object");
> +
> +    lives_ok(sub {
> +	$dom->set_interface_parameters(
> +	    "52:54:00:11:11:11",
> +	    {
> +		Sys::Virt::Domain::BANDWIDTH_IN_AVERAGE => 1000,
> +		Sys::Virt::Domain::BANDWIDTH_IN_PEAK => 5000,
> +		Sys::Virt::Domain::BANDWIDTH_IN_FLOOR => 4000,
> +		Sys::Virt::Domain::BANDWIDTH_IN_BURST => 1024,
> +		Sys::Virt::Domain::BANDWIDTH_OUT_AVERAGE => 128,
> +		Sys::Virt::Domain::BANDWIDTH_OUT_PEAK => 256,
> +		Sys::Virt::Domain::BANDWIDTH_OUT_BURST => 256,
> +	    })});
> +
> +    ok_error(sub {
> +	$dom->set_interface_parameters(
> +	    "52:54:00:11:11:11",
> +	    {
> +		Sys::Virt::Domain::BANDWIDTH_IN_AVERAGE => 1000,
> +		Sys::Virt::Domain::BANDWIDTH_IN_PEAK => 5000,
> +		Sys::Virt::Domain::BANDWIDTH_IN_FLOOR => 40000,
> +		Sys::Virt::Domain::BANDWIDTH_IN_BURST => 1024,
> +		Sys::Virt::Domain::BANDWIDTH_OUT_AVERAGE => 128,
> +		Sys::Virt::Domain::BANDWIDTH_OUT_PEAK => 256,
> +		Sys::Virt::Domain::BANDWIDTH_OUT_BURST => 256,
> +	    }) }, "Canot overcommit bandwidth",
> +	Sys::Virt::Error::ERR_OPERATION_INVALID);
> +
> +    diag "Destroying the transient guest";
> +    $dom->destroy;
> +
> +    diag "Checking that transient domain has gone away";
> +    ok_error(sub { $conn->get_domain_by_name("tck") }, "NO_DOMAIN error raised from missing domain",
> +	     Sys::Virt::Error::ERR_NO_DOMAIN);
> +
> +    diag "Destroying the transient network";
> +    $net->destroy;
> +
> +    diag "Checking that transient network has gone away";
> +    ok_error(sub { $conn->get_network_by_name("tck") }, "NO_network error raised from missing network",
> +	     Sys::Virt::Error::ERR_NO_NETWORK);
> +}
> +
> +# end


--
libvir-list mailing list
libvir-list@redhat.com
https://www.redhat.com/mailman/listinfo/libvir-list
Re: [libvirt] [tck PATCH] Add script testing network bandwidth functionality
Posted by Daniel P. Berrangé 5 years, 1 month ago 
On Tue, Feb 26, 2019 at 06:44:18PM -0500, Laine Stump wrote:
> On 2/26/19 1:07 PM, Daniel P. Berrangé wrote:
> > Signed-off-by: Daniel P. Berrangé <berrange@redhat.com>
> > ---
> >   lib/Sys/Virt/TCK/DomainBuilder.pm      |  10 ++
> >   lib/Sys/Virt/TCK/NetworkBuilder.pm     |  20 ++++
> >   scripts/networks/400-guest-bandwidth.t | 147 +++++++++++++++++++++++++
> 
> 
> You forgot to add the test file to MANIFEST :-)
> 
> 
> Other than that,
> 
> 
> Reviewed-by: Laine Stump <laine@laine.org>
> 
> 
> (the test could be made more thorough by checking that the bandwidth had
> actually been set (by checking the output of whatever appropriate tc
> command, and maybe even by doing a netcat from host to guest and making sure
> it stays below the limit), but this is a lot better than what we were
> testing before!)

Yes, I was wondering about checking tc in some way.

This new script already found some nice bugs in my network refactor patches
which proves its worth.


Regards,
Daniel
-- 
|: https://berrange.com      -o-    https://www.flickr.com/photos/dberrange :|
|: https://libvirt.org         -o-            https://fstop138.berrange.com :|
|: https://entangle-photo.org    -o-    https://www.instagram.com/dberrange :|

--
libvir-list mailing list
libvir-list@redhat.com
https://www.redhat.com/mailman/listinfo/libvir-list

Patchew 2.1-devel-0870f84

© 2016 - 2024 Red Hat, Inc.