From: Richard W.M. Jones Date: Fri, 12 Jun 2015 11:01:35 +0000 (+0100) Subject: Now working for vCenter sources. X-Git-Url: http://git.annexia.org/?a=commitdiff_plain;h=4c0091361124997c5e808e701f7770bbc0009655;p=virt-v2v-test-transfers.git Now working for vCenter sources. --- diff --git a/run-transfer-tests.pl b/run-transfer-tests.pl index ee019fd..b119640 100755 --- a/run-transfer-tests.pl +++ b/run-transfer-tests.pl @@ -15,13 +15,27 @@ # along with this program; if not, write to the Free Software # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. +#use experimental 'smartmatch'; use warnings; use strict; use Getopt::Long; use Pod::Usage; + +use Scalar::Util qw(looks_like_number); +use File::Temp; +use IO::String; + +use XML::XPath; +use XML::XPath::XMLParser; +use URI; +use URI::Escape; + +use Sys::Virt; use Sys::Guestfs; +$| = 1; + =head1 NAME run-transfer-tests.pl - Run virt-v2v transfer tests @@ -44,10 +58,15 @@ instance: run-transfer-tests.pl -c xen+ssh://root@xenserver' --all -Use a different version of libguestfs and virt-v2v: +Use a different version of libguestfs: /path/to/libguestfs/run run-transfer-tests.pl [etc] +When connecting to vCenter and Xen, you may need to set the libguestfs +backend to C: + + export LIBGUESTFS_BACKEND=direct run-transfer-tests.pl -c vpx://... [etc] + =head1 DESCRIPTION C is a script which tests the transfer side of @@ -149,24 +168,314 @@ die "$progname: you must supply the libvirt URI (-c parameter)\n" unless defined $conn; die "$progname: you must use --all or --tests=...\n" unless $all || @tests > 0; +die "$progname: you cannot use --all and --tests=... options together\n" + if $all && @tests > 0; + +# Connect to hypervisor. +my $vmm = Sys::Virt->new (uri => $conn, auth => 1); + +# Get list of guests. +if (@guests == 0) { + my @doms = $vmm->list_domains (); + push @guests, $_->get_name foreach @doms; + die "$progname: no guests found on the source hypervisor\n" + unless @guests > 0; +} + +my $guest; +foreach $guest (@guests) { + my $dom = $vmm->get_domain_by_name ($guest) + or die "$progname: $guest: guest not found\n"; + my $domxml = $dom->get_xml_description (); + my $xp = XML::XPath->new (xml => $domxml); + + # Find all non-removable disks and map them to qemu URIs. + # Code copied from virt-v2v Input_libvirt_* modules. + my @nodes = $xp->find ('//devices/disk[@device="disk"]')->get_nodelist; + my $node; + my @original_disks; + foreach $node (@nodes) { + my $filename = $xp->find ('./source/@dev', $node); + unless ($filename) { + $filename = $xp->find ('./source/@file', $node); + next unless $filename + } + my $format = $xp->find ('./driver/@type', $node); + if ($format) { $format->to_literal } else { undef $format } + push @original_disks, [$filename, $format]; + } + + if (@original_disks == 0) { + warn "$progname: $guest: guest seems to have no non-removable non-network disks, skipping\n"; + next; + } + + my $uri = URI->new ($conn); + + if ($uri->scheme eq "vpx" || $uri->scheme eq "esx") { + my $disk; + foreach $disk (@original_disks) { + if ($disk->[0] =~ /^\[(.*?)\] (.*)\.vmdk$/) { + my $datastore = $1; + my $path = $2; + + my $datacenter = get_datacenter ($uri); + + my ($user, $server, $port); + if ($uri->authority =~ /^(.*)@(.*):(\d+)$/) { + $user = $1; + $server = $2; + $port = $3; + } elsif ($uri->authority =~ /^(.*)@(.*)$/) { + $user = $1; + $server = $2; + $port = 443; + } elsif ($uri->authority =~ /^(.*):(\d+)$/) { + $server = $1; + $port = $2; + } else { + $server = $uri->authority; + $port = 443; + } + + my $url = + sprintf ("https://%s:%s/folder/%s-flat.vmdk?dcPath=%s&dsName=%s", + $server, $port, + uri_escape ($path), uri_escape ($datacenter), + uri_escape ($datastore)); + + my $cookie = get_session_cookie ($url, $user); + + my @json_params = ( + ["file.driver", "https"], + ["file.url", $url], + ["file.timeout", 600], + # XXX In virt-v2v itself, this changes: + ["file.readahead", 64*1024*1024], + ["file.sslverify", "off"], + ["file.cookie", $cookie], + ); + + $disk->[0] = "json: " . json_to_string (@json_params); + } + } + } + elsif ($uri->scheme eq "xen+ssh") { + my $disk; + foreach $disk (@original_disks) { + my ($user, $server, $port); + if ($uri->authority =~ /^(.*)@(.*):(\d+)$/) { + $user = $1; + $server = $2; + $port = $3; + } elsif ($uri->authority =~ /^(.*):(\d+)$/) { + $server = $1; + $port = $2; + } else { + $server = $uri->authority; + $port = 22; + } + + my @json_params = ( + [ "file.driver", "ssh" ], + [ "file.path", $disk->[0] ], + [ "file.host", $server ], + [ "file.host_key_check", "no" ], + [ "file.port", $port ] + ); + if ($user) { + push @json_params, [ "file.user", $user ]; + } + + $disk->[0] = "json: " . json_to_string (@json_params); + } + } + # else probably an error? XXX + + # Create overlay disks. + my @overlays; + foreach (@original_disks) { + my $overlay = File::Temp->new (UNLINK => 0); + my @cmd = ("qemu-img", "create", "-q", "-f", "qcow2", + "-b", $_->[0]); + if ($_->[1]) { + push @cmd, "-o", "backing_fmt=".$_->[1]; + } + push @cmd, $overlay; + #print (join (" ", @cmd), "\n"); + system (@cmd) == 0 or die "qemu-img: $!"; + push @overlays, $overlay; + } + +=head1 TESTS + +=head2 inspect + +Open the guest and run libguestfs inspection on it. + +This tests libguestfs, C, and the curl or ssh block driver. +=cut + if ($all || "inspect" ~~ @tests) { + print "test: $guest: inspect\n"; + my $g = Sys::Guestfs->new (); + foreach (@overlays) { + $g->add_drive ($_, format => "qcow2", + readonly => 1, + discard => "besteffort", copyonread => 1); + } + $g->launch (); + my @roots = $g->inspect_os (); + die "$progname: $guest: no operating system found in guest\n" + if @roots == 0; + } +=head2 trim +Open the guest and fstrim it. +Note this only tests that the fstrim doesn't break dramatically (eg. +cause qemu to crash), not that it is effective. +This tests C, and the curl or ssh block driver. +=cut + if ($all || "trim" ~~ @tests) { + print "test: $guest: trim\n"; + my $g = Sys::Guestfs->new (); + foreach (@overlays) { + $g->add_drive ($_, format => "qcow2", + readonly => 1, + discard => "besteffort", copyonread => 1); + } + $g->launch (); + my %fses = $g->list_filesystems (); + foreach (sort keys %fses) { + eval { $g->fstrim ($_); } + } + } +=head2 copy +Copy the whole disk image of the guest. +This tests C, and the curl or ssh block driver. - +=cut + if ($all || "copy" ~~ @tests) { + print "test: $guest: copy\n"; + + foreach (@overlays) { + my $tmp = File::Temp->new (UNLINK => 0); + my @cmd = ("qemu-img", "convert", "-p", $_, $tmp->filename); + system (@cmd) == 0 or die "qemu-img convert: $!"; + unlink ($tmp); + } + } + + # Delete the overlays. + unlink ($_) foreach @overlays; +} + +# Helper function to extract the vCenter datacenter from a URI. +sub get_datacenter +{ + my $uri = shift; + my $default_dc = "ha-datacenter"; + + if ($uri->scheme eq "vpx") { + my $path = $uri->path; + $path =~ s{/[^/]*$}{}; + $path =~ s{^/}{}; + if ($path ne "") { + return $path; + } else { + return $default_dc; + } + } + else { + return $default_dc; + } +} + +# Get the session cookie from vCenter. +sub get_session_cookie +{ + my $url = shift; + my $user = shift; + + # Pass parameters to curl securely through a config file. + my $config_file = File::Temp->new (UNLINK => 1); + print $config_file "head\n"; + print $config_file "silent\n"; + print $config_file "url = \"$url\"\n"; + if ($user) { + print $config_file "user = \"", $user, "\"\n"; + } + print $config_file "insecure\n"; + flush $config_file; + my $cmd = "curl -q --config " . $config_file->filename; + #system ("cat", $config_file->filename); + #print $cmd, "\n"; + open PIPE, "$cmd |" or die "curl: $!"; + my $cookie; + while () { + if (m|^HTTP/401|) { + die "$progname: incorrect username or password\n"; + } + if (m|^HTTP/404|) { + die "$progname: URL not found\n"; + } + if (m|^Set-Cookie: (.*)|) { + my $rest; + ($cookie, $rest) = split /;/, $1, 2; + } + } + die "$progname: session cookie could not be read from remote vCenter\n" + unless defined $cookie; + return $cookie; +} + +# Convert list to JSON string. +sub json_to_string +{ + my $ret; + my $io = IO::String->new ($ret); + + print $io "{\n"; + my $needs_comma = 0; + my $kv; + foreach $kv (@_) { + if ($needs_comma) { + print $io ",\n"; + } + $needs_comma = 1; + + my $key = $kv->[0]; + my $value = $kv->[1]; + + print $io "\"$key\": "; + if (looks_like_number ($value)) { + print $io $value; + } else { + $value =~ s{"}{\\"}g; + print $io "\"$value\""; + } + } + print $io "\n}\n"; + + return $ret +} =head1 SEE ALSO L, -L +L, +L, +L, +L =head1 AUTHOR