include APIs dom->block_resize dom->get_block_info dom->block_peek dom->get_interface_parameters dom->migrate_get_max_speed dom->set_interface_parameters con->is_alive --- scripts/domain/180-interface-parameters.t | 173 +++++++++++++++++++++++++++++ 1 files changed, 173 insertions(+), 0 deletions(-) create mode 100644 scripts/domain/180-interface-parameters.t diff --git a/scripts/domain/180-interface-parameters.t b/scripts/domain/180-interface-parameters.t new file mode 100644 index 0000000..6b30a30 --- /dev/null +++ b/scripts/domain/180-interface-parameters.t @@ -0,0 +1,173 @@ +# -*- perl -*- +# +# Copyright (C) 2012 Red Hat, Inc. +# Copyright (C) 2012 Kyla Zhang <weizhan(a)redhat.com&gt; +# +# 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 + +domain/180-interface-parameters.t - test interface set/get + +=head1 DESCRIPTION + +The test case validates that all following APIs work well include +dom->block_resize +dom->get_block_info +dom->block_peek +dom->get_interface_parameters +dom->migrate_get_max_speed +dom->set_interface_parameters +con->is_alive + +=cut + +use strict; +use warnings; + +use Test::More tests => 39; + +use Sys::Virt::TCK; +use Test::Exception; +use File::stat; + +my $tck = Sys::Virt::TCK->new(); +my $conn = eval { $tck->setup(); }; +BAIL_OUT "failed to setup test harness: $@" if $@; +END { + $tck->cleanup if $tck; +} + +# test is_alive +my $live = $conn->is_alive(); +ok($live > 0, "Connection is alive"); + +my $xml = $tck->generic_pool("dir")->as_xml; + +diag "Defining transient storage pool"; +my $pool; +ok_pool(sub { $pool = $conn->define_storage_pool($xml) }, "define transient storage pool"); +lives_ok(sub { $pool->build(0) }, "built storage pool"); +lives_ok(sub { $pool->create }, "started storage pool"); + +my $volallocxml = $tck->generic_volume("tck", "raw", 1024*1024*50)->allocation(1024*1024*50)->as_xml; +my ($vol, $path, $st); +ok_volume { $vol = $pool->create_volume($volallocxml) } "create fully allocated raw volume"; + +my $volallocxml2 = $tck->generic_volume("tck2", "raw", 1024*1024*50)->allocation(1024*1024)->as_xml; +my ($vol2, $path2, $st2); +ok_volume { $vol2 = $pool->create_volume($volallocxml2) } "create not fully allocated raw volume"; + +my $volallocxml3 = $tck->generic_volume("tck3", "qcow2", 1024*1024*50)->allocation(1024*1024)->as_xml; +my ($vol3, $path3, $st3); +ok_volume { $vol3 = $pool->create_volume($volallocxml3) } "create qcow2 volume"; + +$path = xpath($vol, "string(/volume/target/path)"); +$st = stat($path); +ok($st, "path $path exists"); +is($st->size, 1024*1024*50, "size is 50M"); + +$path2 = xpath($vol2, "string(/volume/target/path)"); +$st2 = stat($path2); +ok($st2, "path $path2 exists"); + +$path3 = xpath($vol3, "string(/volume/target/path)"); +$st3 = stat($path3); +ok($st3, "path $path3 exists"); + +diag "Generic guest with pervious created vol"; +my $disktype = "raw"; +my $dst = "vda"; +my $dst2 = "vdb"; +my $dst3 = "vdc"; +my $guest = $tck->generic_domain("tck"); +$guest->rmdisk(); +$guest->disk(format => { name => "qemu", type => $disktype }, type => "file", src => $path, dst => $dst); +$guest->disk(format => { name => "qemu", type => $disktype }, type => "file", src=> $path2, dst => $dst2); +$guest->disk(format => { name => "qemu", type => "qcow2" }, type => "file", src=> $path3, dst => $dst3); +$guest->interface(type => "network", source => "default", model => "virtio", mac => "52:54:00:22:22:22"); + +$xml = $guest->as_xml; +my $dom; +ok_domain(sub { $dom = $conn->create_domain($xml) }, "Create domain"); +$xml = $dom->get_xml_description(); +diag "$xml"; + +is($dom->get_block_info($dst2,0)->{capacity}, 1024*1024*50, "Get disk capacity info"); +is($dom->get_block_info($dst2,0)->{allocation}, 1024*1024, "Get disk allocation info"); +is($dom->get_block_info($dst2,0)->{physical}, 1024*1024, "Get disk physical info"); + + +is($dom->get_block_info($dst,0)->{capacity}, 1024*1024*50, "Get disk capacity info"); +is($dom->get_block_info($dst,0)->{allocation}, 1024*1024*50, "Get disk allocation info"); +is($dom->get_block_info($dst,0)->{physical}, 1024*1024*50, "Get disk physical info"); + +diag "Test block_resize"; +lives_ok(sub {$dom->block_resize($dst, 512*50)}, "resize to 512*50 KB"); +$st = stat($path); +is($st->size, 512*1024*50, "size is 25M"); + +is($dom->get_block_info($dst,0)->{capacity}, 1024*512*50, "Get disk capacity info"); +is($dom->get_block_info($dst,0)->{allocation}, 1024*512*50, "Get disk allocation info"); +is($dom->get_block_info($dst,0)->{physical}, 1024*512*50, "Get disk physical info"); + +lives_ok(sub {$dom->block_resize($dst, 1024*50)}, "resize to 1024*50 KB"); +$st = stat($path); +is($st->size, 1024*1024*50, "size is 50M"); + +my $date = "test"; +system("echo $date > $path"); +is($dom->block_peek($path,0,4,0), $date, "Get date from raw image"); + +#qcow2 file start with hexadecimal:0x51 0x46 0x49 (ASCII: "QFI") +is($dom->block_peek($path3,0,3,0), "QFI", "Get date from qcow2 image"); + +diag "Get migrate max speed"; +my $speed = $dom->migrate_get_max_speed(); +ok($speed, "Get migrate max speed $speed"); + +diag "Set migrate max speed"; +$speed = 10000; +lives_ok(sub {$dom->migrate_set_max_speed($speed)}, "Set max speed to $speed"); +my $get_speed = $dom->migrate_get_max_speed(); +is ($speed, $get_speed, "Get speed same as set"); + +diag "Set/Get interface parameters"; +my %params = (Sys::Virt::Domain::BANDWIDTH_IN_AVERAGE=>1000, Sys::Virt::Domain::BANDWIDTH_IN_PEAK=>1001, + Sys::Virt::Domain::BANDWIDTH_IN_BURST=>1002, Sys::Virt::Domain::BANDWIDTH_OUT_AVERAGE=>1003, + Sys::Virt::Domain::BANDWIDTH_OUT_PEAK=>1004, Sys::Virt::Domain::BANDWIDTH_OUT_BURST=>1005); +lives_ok(sub {$dom->set_interface_parameters("vnet0", \%params)}, "Set vnet0 parameters"); +for my $key (sort keys %params) { + diag "Set $key => $params{$key} "; +} + +my $param = $dom->get_interface_parameters("vnet0", 0); +my $in_average = $param->{Sys::Virt::Domain::BANDWIDTH_IN_AVERAGE}; +my $in_burst = $param->{Sys::Virt::Domain::BANDWIDTH_IN_BURST}; +my $in_peak = $param->{Sys::Virt::Domain::BANDWIDTH_IN_PEAK}; +my $out_average = $param->{Sys::Virt::Domain::BANDWIDTH_OUT_AVERAGE}; +my $out_burst = $param->{Sys::Virt::Domain::BANDWIDTH_OUT_BURST}; +my $out_peak = $param->{Sys::Virt::Domain::BANDWIDTH_OUT_PEAK}; +is($in_average, 1000, "Get inbound average 1000"); +is($in_burst, 1002, "Get inbound burst 1002"); +is($in_peak, 1001, "Get inbound peak 1001"); +is($out_average, 1003, "Get outbound average 1003"); +is($out_burst, 1005, "Get outbound burst 1005"); +is($out_peak, 1004, "Get outbound peak 1004"); + + +lives_ok(sub { $vol->delete(0) }, "deleted volume"); + +diag "Destroy domain"; +$dom->destroy; + +ok_error(sub { $conn->get_domain_by_name("tck") }, "NO_DOMAIN error raised from missing domain", 42); -- 1.7.7.6