[Libguestfs] [PATCH 3/8] ESX: Import guests from VMware's ESX server

1 Feb 2010

This change adds the ability to import a guest and its storage from VMware's ESX
server using the LibVirt connection.

An example command line:

virt-v2v -ic 'esx://yellow.marston/?no_verify=1' -op transfer RHEL5-64

This will import the guest RHEL5-64 from esx server yellow.marston, copying its
storage to a local pool called transfer.

Sys::VirtV2V::Connection is refactored to be a superclass. Subclasses are now
created explicitly by virt-v2v.pl rather than using a generic instantiate
mechanism.

Sys::VirtV2V::Connection::LibVirt knows explicitly about ESX, and will use the
new Sys::VirtV2V::Transfer::ESX to fetch its storage.

virt-v2v.pl is updated to reflect the other changes.
---
 MANIFEST                                 |    1 +
 lib/Sys/VirtV2V/Connection.pm            |  160 +++++++++-----
 lib/Sys/VirtV2V/Connection/LibVirt.pm    |  185 ++++++++++-------
 lib/Sys/VirtV2V/Connection/LibVirtXML.pm |   99 ++-------
 lib/Sys/VirtV2V/Transfer/ESX.pm          |  344 ++++++++++++++++++++++++++++++
 v2v/virt-v2v.pl                          |  140 ++++++++----
 6 files changed, 676 insertions(+), 253 deletions(-)
 create mode 100644 lib/Sys/VirtV2V/Transfer/ESX.pm

diff --git a/MANIFEST b/MANIFEST
index 7bfad76..3d6bf00 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -12,6 +12,7 @@ lib/Sys/VirtV2V/Connection.pm
 lib/Sys/VirtV2V/Connection/LibVirt.pm
 lib/Sys/VirtV2V/Connection/LibVirtXML.pm
 lib/Sys/VirtV2V/UserMessage.pm
+lib/Sys/VirtV2V/Transfer/ESX.pm
 MANIFEST			This list of files
 MANIFEST.SKIP
 META.yml
diff --git a/lib/Sys/VirtV2V/Connection.pm b/lib/Sys/VirtV2V/Connection.pm
index 31fbdb3..6a967d0 100644
--- a/lib/Sys/VirtV2V/Connection.pm
+++ b/lib/Sys/VirtV2V/Connection.pm
@@ -20,113 +20,163 @@ package Sys::VirtV2V::Connection;
 use strict;
 use warnings;
 
-use Module::Pluggable sub_name => 'modules',
-                      search_path => ['Sys::VirtV2V::Connection'],
-                      require => 1;
+use Sys::Virt;
 
-use Carp;
+use Locale::TextDomain 'virt-v2v';
 
 =pod
 
 =head1 NAME
 
-Sys::VirtV2V::Connection - Read a variety of guest metadata formats
+Sys::VirtV2V::Connection - Obtain domain metadata
 
 =head1 SYNOPSIS
 
- use Sys::VirtV2V::Connection;
+ use Sys::VirtV2V::Connection::LibVirt;
 
- $reader = Sys::VirtV2V::Connection->instantiate("libvirtxml", $uri,
-                                                     $config, @args);
- exit 1 unless($mdr->is_configured());
- $dom = $reader->get_dom();
+ $conn = Sys::VirtV2V::Connection::LibVirt->new($uri, $name, $pool);
+ $dom = $conn->get_dom();
+ @storage = $conn->get_local_storage();
 
 =head1 DESCRIPTION
 
-Sys::VirtV2V::Connection reads the metadata of a, possibly foreign,
-guest. It provides the DOM representation of an equivalent libvirt XML
-representation.
+Sys::VirtV2V::Connection describes a connection to a, possibly remote, source of
+guest metadata and storage. It is a virtual superclass and can't be instantiated
+directly. Use one of the subclasses:
 
-Sys::VirtV2V::Connection is an interface to various backends, each of
-which implement a consistent API. Sys::VirtV2V::Connection itself only
-implements methods to access backends.
+ Sys::VirtV2V::Connection::LibVirt
+ Sys::VirtV2V::Connection::LibVirtXML
 
 =head1 METHODS
 
 =over
 
-=item instantiate(name, $uri, $config, @args)
+=item get_local_storage
 
-=over
-
-=item name
+Return a list of the domain's storage devices. The returned list contains local
+paths.
 
-The name of the module to instantiate.
+=cut
 
-=item uri
+sub get_local_storage
+{
+    my $self = shift;
 
-A URI describing the target connection.
+    return @{$self->{storage}};
+}
 
-=item config
+=item get_dom()
 
-A parsed virt-v2v configuration file.
+Returns an XML::DOM::Document describing a libvirt configuration equivalent to
+the input.
 
-=item args
+Returns undef and displays an error if there was an error
 
-Backend-specific arguments describing where its data is located.
+=cut
 
-=back
+sub get_dom
+{
+    my $self = shift;
 
-Instantiate a backend instance with the given name.
+    return $self->{dom};
+}
 
-=cut
 
-sub instantiate
+# Iterate over returned storage. Transfer it and update DOM as necessary. To be
+# called by subclasses.
+sub _storage_iterate
 {
-    my $class = shift;
+    my $self = shift;
+
+    my ($transfer, $pool) = @_;
+
+    my $dom = $self->get_dom();
 
-    my ($name, $uri, $config, @args) = @_;
+    # Create a hash of guest devices to their paths
+    my @storage;
+    foreach my $disk ($dom->findnodes('/domain/devices/disk')) {
+        my ($source_e) = $disk->findnodes('source');
 
-    defined($name) or carp("instantiate called without name argument");
-    defined($uri)  or carp("instantiate called without uri argument");
-    defined($config) or carp("instantiate called without config argument");
+        my ($source) = $source_e->findnodes('@file | @dev');
+        defined($source) or die("source element has neither dev nor file: \n".
+                                $dom.toString());
 
-    foreach my $module ($class->modules()) {
-        if($module->get_name() eq $name) {
-            return $module->_new($uri, $config->{$name}, @args);
+        my ($target) = $disk->findnodes('target/@dev');
+        defined($target) or die("disk does not have a target device: \n".
+                                $dom.toString());
+
+        # If the disk is a floppy or a cdrom, blank its source
+        my $device = $disk->getAttribute('device');
+        if ($device eq 'floppy' || $device eq 'cdrom') {
+            $source_e->setAttribute($source->getName(), '');
         }
-    }
 
-    return undef;
-}
+        else {
+            my $path = $source->getValue();
 
-=back
+            if (defined($transfer)) {
+                # Die if transfer required and no output pool
+                die (user_message(__"No output pool was specified"))
+                    unless (defined($pool));
 
-=head1 BACKEND INTERFACE
+                # Fetch the remote storage
+                my $vol = $transfer->transfer($self, $path, $pool);
 
-=over
+                # Parse the XML description of the returned volume
+                my $voldom =
+                    new XML::DOM::Parser->parse($vol->get_xml_description());
 
-=item CLASS->get_name()
+                # Find any existing driver element.
+                my ($driver) = $disk->findnodes('driver');
 
-Return the module's name.
+                # Create a new driver element if none exists
+                unless (defined($driver)) {
+                    $driver =
+                        $disk->getOwnerDocument()->createElement("driver");
+                    $disk->appendChild($driver);
+                }
+                $driver->setAttribute('name', 'qemu');
 
-=item is_configured()
+                # Get the volume format for passing to the qemu driver
+                my ($format) =
+                    $voldom->findnodes('/volume/target/format/@type');
 
-Return 1 if the module has been suffiently configured to proceed.
-Return 0 and display an error message otherwise.
+                $format = $format->getValue() if (defined($format));
 
-=item get_dom()
+                # Auto-detect if no format is specified explicitly
+                $format ||= 'auto';
 
-Returns an XML::DOM::Document describing a libvirt configuration equivalent to
-the input.
+                $driver->setAttribute('type', $format);
 
-Returns undef and displays an error if there was an error
+                # Remove the @file or @dev attribute before adding a new one
+                $source_e->removeAttributeNode($source);
+
+                $path = $vol->get_path();
+
+                # Set @file or @dev as appropriate
+                if ($vol->get_info()->{type} ==
+                    Sys::Virt::StorageVol::TYPE_FILE)
+                {
+                    $disk->setAttribute('type', 'file');
+                    $source_e->setAttribute('file', $path);
+                } else {
+                    $disk->setAttribute('type', 'block');
+                    $source_e->setAttribute('dev', $path);
+                }
+            }
+
+            push(@storage, $path);
+        }
+    }
+
+    $self->{storage} = \@storage;
+}
 
 =back
 
 =head1 COPYRIGHT
 
-Copyright (C) 2009 Red Hat Inc.
+Copyright (C) 2009,2010 Red Hat Inc.
 
 =head1 LICENSE
 
diff --git a/lib/Sys/VirtV2V/Connection/LibVirt.pm b/lib/Sys/VirtV2V/Connection/LibVirt.pm
index d3aa80d..59e4913 100644
--- a/lib/Sys/VirtV2V/Connection/LibVirt.pm
+++ b/lib/Sys/VirtV2V/Connection/LibVirt.pm
@@ -20,10 +20,17 @@ package Sys::VirtV2V::Connection::LibVirt;
 use strict;
 use warnings;
 
+use Sys::VirtV2V::Connection;
+our @ISA = ("Sys::VirtV2V::Connection");
+
+use Net::Netrc;
+use URI;
 use XML::DOM;
 
 use Sys::Virt;
 
+use Sys::VirtV2V;
+use Sys::VirtV2V::Transfer::ESX;
 use Sys::VirtV2V::UserMessage qw(user_message);
 
 use Locale::TextDomain 'virt-v2v';
@@ -36,107 +43,133 @@ Sys::VirtV2V::Connection::LibVirt - Read libvirt metadata from libvirtd
 
 =head1 SYNOPSIS
 
- use Sys::VirtV2V::Connection;
+ use Sys::VirtV2V::Connection::LibVirt;
 
- $reader = Sys::VirtV2V::Connection->instantiate
-    ("libvirt", "xen+ssh://xenserver.example.com/", $config, @args);
- $dom = $reader->get_dom();
+ $conn = Sys::VirtV2V::Connection::LibVirt->new
+    ("xen+ssh://xenserver.example.com/", $name, $pool);
+ $dom = $conn->get_dom();
 
 =head1 DESCRIPTION
 
-Sys::VirtV2V::Connection::LibVirt is a backend for
+Sys::VirtV2V::Connection::LibVirt is an implementation of
 Sys::VirtV2V::Connection which reads a guest's libvirt XML directly from a
 libvirt connection.
 
 =head1 METHODS
 
-See BACKEND INTERFACE in L<Sys::VirtV2V::Connection> for a detailed
-description of its exported methods.
-
 =over
 
-=cut
+=item new(uri, name, pool)
 
-use constant NAME => "libvirt";
+Create a new Sys::VirtV2V::Connection::LibVirt. Domain I<name> will be
+downloaded from I<uri>. Remote storage will be copied to a new volume, which
+will be create in <pool>.
+
+=cut
 
-sub _new
+sub new
 {
     my $class = shift;
 
-    my ($uri, $config, @args) = @_;
+    my ($uri, $name, $pool) = @_;
 
     my $self = {};
 
     bless($self, $class);
 
-    my @vmm_params = (auth => 1);
-    push(@vmm_params, url => $uri) if defined($uri);
-    my $vmm = Sys::Virt->new(@vmm_params);
+    $self->{uri} = URI->new($uri);
+    $self->{name} = $name;
 
-    $self->{vmm} = $vmm;
-    $self->_handle_args(@args);
+    # Parse uri authority for hostname and username
+    $self->{uri}->authority() =~ /^(?:([^:]*)(?::([^@]*))?@)?(.*)$/
+        or die(user_message(__x("Unable to parse URI authority: {auth}",
+                                auth => $self->{uri}->authority())));
 
-    return $self;
-}
+    my $username = $self->{username} = $1;
+    my $hostname = $self->{hostname} = $3;
 
-sub _handle_args
-{
-    my $self = shift;
+    print STDERR user_message(__("WARNING: Specifying a password in the ".
+                                 "connection URI is not supported. It has ".
+                                 "been ignored.")) if (defined($2));
 
-    # The first argument is the name of a libvirt domain
-    $self->{name} = shift;
+    # Look for credentials in .netrc if the URI contains a hostname
+    if (defined($hostname)) {
+        if (defined($username)) {
+            my $mach = Net::Netrc->lookup($hostname, $username);
+            $self->{password} = $mach->password if (defined($mach));
+        }
 
-    # Warn if we were given more than 1 argument
-    if(scalar(@_) > 0) {
-        print STDERR user_message
-            (__x("WARNING: {modulename} only takes a single domain name.",
-                 modulename => NAME));
-    }
-}
+        else {
+            my $mach = Net::Netrc->lookup($hostname);
 
-=item Sys::VirtV2V::Connection::LibVirtXML->get_name()
+            if (defined($mach)) {
+                $self->{username} = $mach->login;
+                $self->{password} = $mach->password;
+            }
+        }
+    }
 
-See BACKEND INTERFACE in L<Sys::VirtV2V::Connection> for details.
+    my $sourcevmm;
+    eval {
+        $sourcevmm = Sys::Virt->new(
+            uri => $uri,
+            readonly => 1,
+            auth => 1,
+            credlist => [
+                Sys::Virt::CRED_AUTHNAME,
+                Sys::Virt::CRED_PASSPHRASE
+            ],
+            callback => sub {
+                my $creds = shift;
+
+                foreach my $cred (@$creds) {
+                    if ($cred->{type} == Sys::Virt::CRED_AUTHNAME) {
+                        $cred->{result} = $self->{username};
+                    }
+
+                    elsif ($cred->{type} == Sys::Virt::CRED_PASSPHRASE) {
+                        $cred->{result} = $self->{password};
+                    }
+
+                    else { die($cred->{type}, "\n"); }
+                }
+            }
+        );
+    };
+    die(user_message(__x("Failed to connect to {uri}: {error}",
+                         uri => $uri,
+                         error => $@->stringify()))) if ($@);
 
-=cut
+    $self->{sourcevmm} = $sourcevmm;
 
-sub get_name
-{
-    my $class = shift;
+    $self->_check_shutdown();
 
-    return NAME;
-}
+    $self->_get_dom();
 
-=item is_configured()
+    my $transfer;
+    if ($self->{uri}->scheme eq "esx") {
+        $transfer = "Sys::VirtV2V::Transfer::ESX";
+    }
 
-See BACKEND INTERFACE in L<Sys::VirtV2V::Connection> for details.
+    $self->_storage_iterate($transfer, $pool);
 
-=cut
+    return $self;
+}
 
-sub is_configured
+sub _check_shutdown
 {
     my $self = shift;
 
     my $vmm = $self->{vmm};
-    my $name = $self->{name};
-
-    # Check the given domain exists
-    my $domain = _get_domain($vmm, $name);
-
-    # Don't continue if it isn't
-    return 0 unless(defined($domain));
+    my $domain = $self->_get_domain();
 
     # Check the domain is shutdown
-    unless ($domain->get_info()->{state} == Sys::Virt::Domain::STATE_SHUTOFF) {
-        print STDERR user_message
-            (__x("Guest {name} is currently {state}. ".
-                 "It must be shut down first.",
-                 state => _state_string($domain->get_info()->{state}),
-                 name => $name));
-        return 0;
-    }
-
-    return 1;
+    die(user_message(__x("Guest {name} is currently {state}. It must be ".
+                         "shut down first.",
+                         state => _state_string($domain->get_info()->{state}),
+                         name => $self->{name})))
+        unless ($domain->get_info()->{state} ==
+                Sys::Virt::Domain::STATE_SHUTOFF);
 }
 
 sub _state_string
@@ -164,30 +197,30 @@ sub _state_string
 
 sub _get_domain
 {
-    my ($vmm, $name) = @_;
+    my $self = shift;
+
+    return $self->{domain} if (defined($self->{domain}));
+
+    my $vmm = $self->{sourcevmm};
+    my $name = $self->{name};
 
     # Lookup the domain
     my $domain;
     eval {
         $domain = $vmm->get_domain_by_name($name);
     };
+    die($@) if ($@);
 
-    # Warn and exit if we didn't find it
-    unless($domain) {
-        print STDERR user_message
-            (__x("{name} isn't a valid guest name", name => $name));
-    }
+    # Check we found it
+    die(user_message(__x("{name} isn't a valid guest name", name => $name)))
+        unless($domain);
+
+    $self->{domain} = $domain;
 
     return $domain;
 }
 
-=item get_dom()
-
-See BACKEND INTERFACE in L<Sys::VirtV2V::Connection> for details.
-
-=cut
-
-sub get_dom
+sub _get_dom
 {
     my $self = shift;
 
@@ -195,13 +228,15 @@ sub get_dom
     my $name = $self->{name};
 
     # Lookup the domain
-    my $domain = _get_domain($vmm, $name);
+    my $domain = $self->_get_domain();
 
     # Warn and exit if we didn't find it
     return undef unless(defined($domain));
 
     my $xml = $domain->get_xml_description();
-    return new XML::DOM::Parser->parse($xml);
+
+    my $dom = new XML::DOM::Parser->parse($xml);
+    $self->{dom} = $dom;
 }
 
 =back
diff --git a/lib/Sys/VirtV2V/Connection/LibVirtXML.pm b/lib/Sys/VirtV2V/Connection/LibVirtXML.pm
index c05aa0f..6867a9b 100644
--- a/lib/Sys/VirtV2V/Connection/LibVirtXML.pm
+++ b/lib/Sys/VirtV2V/Connection/LibVirtXML.pm
@@ -20,6 +20,8 @@ package Sys::VirtV2V::Connection::LibVirtXML;
 use strict;
 use warnings;
 
+our @ISA = ("Sys::VirtV2V::Connection");
+
 use XML::DOM;
 use XML::DOM::XPath;
 
@@ -35,34 +37,33 @@ Sys::VirtV2V::Connection::LibVirtXML - Read libvirt XML from a file
 
 =head1 SYNOPSIS
 
- use Sys::VirtV2V::Connection;
+ use Sys::VirtV2V::Connection::LibVirtXML;
 
- $reader = Sys::VirtV2V::Connection->instantiate("libvirtxml", undef,
-                                                     $config, @args);
- $dom = $reader->get_dom();
+ $conn = Sys::VirtV2V::Connection::LibVirtXML->new($config, $path);
+ $dom = $conn->get_dom();
 
 =head1 DESCRIPTION
 
-Sys::VirtV2V::Connection::LibVirtXML is a backend for
+Sys::VirtV2V::Connection::LibVirtXML is an implementation of
 Sys::VirtV2V::Connection which reads libvirt XML guest descriptions from a
 file.
 
 =head1 METHODS
 
-See BACKEND INTERFACE in L<Sys::VirtV2V::Connection> for a detailed
-description of its exported methods.
-
 =over
 
-=cut
+=item new(config, path)
 
-use constant NAME => "libvirtxml";
+Create a new LibVirtXML connection. Configuration for transforming the metadata
+is taken from I<config>, and the metadata itself is read from I<path>.
+
+=cut
 
-sub _new
+sub new
 {
     my $class = shift;
 
-    my ($uri, $config, @args) = @_;
+    my ($config, $path) = @_;
 
     my %obj = ();
     my $self = \%obj;
@@ -87,77 +88,22 @@ sub _new
             }
 
             else {
-                print STDERR user_message
-                    (__x("WARNING: unknown configuration directive ".
-                         "{directive} in {name} section.",
-                         directive => $directive, name => NAME));
-                $self->{invalidconfig} = 1;
+                die(__x("WARNING: unknown configuration directive ".
+                        "{directive} in {name} section.",
+                        directive => $directive, name => 'libvirtxml'));
             }
         }
     }
 
-    $self->_handle_args(@args);
-
-    return $self;
-}
-
-sub _handle_args
-{
-    my $self = shift;
-
-    # The first argument is the libvirt xml file's path
-    $self->{path} = shift;
-
-    # Warn if we were given more than 1 argument
-    if(scalar(@_) > 0) {
-        print STDERR user_message
-            (__x("WARNING: {modulename} only takes a single filename.",
-                 modulename => NAME));
-    }
-}
-
-=item Sys::VirtV2V::Connection::LibVirtXML->get_name()
-
-See BACKEND INTERFACE in L<Sys::VirtV2V::Connection> for details.
-
-=cut
-
-sub get_name
-{
-    my $class = shift;
-
-    return NAME;
-}
-
-=item is_configured()
-
-See BACKEND INTERFACE in L<Sys::VirtV2V::Connection> for details.
-
-=cut
-
-sub is_configured
-{
-    my $self = shift;
-
-    if(!defined($self->{path})) {
-        print STDERR user_message
-            (__x("You must specify a filename when using {modulename}",
-                 modulename => NAME));
-        return 0;
-    }
+    $self->_get_dom($path);
 
-    return 0 if(exists($self->{invalidconfig}));
+    # No transfer methods defined yet
+    $self->_storage_iterate(undef, undef);
 
-    return 1;
+    return $self;
 }
 
-=item get_dom()
-
-See BACKEND INTERFACE in L<Sys::VirtV2V::Connection> for details.
-
-=cut
-
-sub get_dom
+sub _get_dom
 {
     my $self = shift;
 
@@ -212,7 +158,7 @@ sub get_dom
 
 =head1 COPYRIGHT
 
-Copyright (C) 2009 Red Hat Inc.
+Copyright (C) 2009,2010 Red Hat Inc.
 
 =head1 LICENSE
 
@@ -220,7 +166,6 @@ Please see the file COPYING.LIB for the full license.
 
 =head1 SEE ALSO
 
-L<Sys::VirtV2V::Connection(3)>,
 L<virt-v2v(1)>,
 L<v2v-snapshot(1)>,
 L<http://libguestfs.org/>.
diff --git a/lib/Sys/VirtV2V/Transfer/ESX.pm b/lib/Sys/VirtV2V/Transfer/ESX.pm
new file mode 100644
index 0000000..353c10d
--- /dev/null
+++ b/lib/Sys/VirtV2V/Transfer/ESX.pm
@@ -0,0 +1,344 @@
+# Sys::VirtV2V::Transfer::ESX
+# Copyright (C) 2010 Red Hat Inc.
+#
+# This library is free software; you can redistribute it and/or
+# modify it under the terms of the GNU Lesser General Public
+# License as published by the Free Software Foundation; either
+# version 2 of the License, or (at your option) any later version.
+#
+# This library is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+# Lesser General Public License for more details.
+#
+# You should have received a copy of the GNU Lesser General Public
+# License along with this library; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+package Sys::VirtV2V::Transfer::ESX::UA;
+
+use strict;
+use warnings;
+
+use Sys::Virt::Error;
+
+use Sys::VirtV2V;
+
+use Sys::VirtV2V::UserMessage qw(user_message);
+
+use Locale::TextDomain 'virt-v2v';
+
+# This is a gross hack to bring sanity to Net::HTTPS's SSL handling. Net::HTTPS
+# can use either Net::SSL or IO::Socket::SSL, depending on which is available at
+# runtime. It does not expose which of these it is using, or provide any common
+# interface for configuring them. Neither of these libraries will verify a peer
+# certificate by default. The configuration required to ensure certificates are
+# verified is custom to the driver in use. If the wrong driver is configured, it
+# will silently do nothing.
+#
+# To try to fix this situation, we hardcode here that we want Net::SSL. In the
+# _new constructor, we check that Net::SSL was actually used, and die() if it
+# wasn't. We subsequently only include configuration for Net::SSL.
+BEGIN {
+    use Net::HTTPS;
+
+    $Net::HTTPS::SSL_SOCKET_CLASS = "Net::SSL";
+}
+
+use LWP::UserAgent;
+our @ISA = ("LWP::UserAgent");
+
+our %handles;
+
+sub new {
+    my $class = shift;
+
+    my ($server, $username, $password, $pool, $verify) = @_;
+
+    my $self = $class->SUPER::new(
+        agent => 'virt-v2v/'.$Sys::VirtV2V::VERSION,
+        protocols_allowed => [ 'https' ]
+    );
+    $self->show_progress(1);
+
+    $self->add_handler(response_header => sub {
+        my ($response, $self, $h) = @_;
+
+        if ($response->is_success) {
+            $self->verify_certificate($response) if ($verify);
+            $self->create_volume($response);
+        }
+    });
+
+    $self->{_v2v_server}   = $server;
+    $self->{_v2v_pool}     = $pool;
+    $self->{_v2v_username} = $username;
+    $self->{_v2v_password} = $password;
+
+    if ($verify) {
+        # Leave HTTPS_CA_DIR alone if it is already set
+        # Setting HTTPS_CA_DIR to the empty string results in it using the
+        # compiled-in default paths
+        $ENV{HTTPS_CA_DIR} = "" unless (exists($ENV{HTTPS_CA_DIR}));
+    } else {
+        # Unset HTTPS_CA_DIR if it is already set
+        delete($ENV{HTTPS_CA_DIR});
+    }
+
+    die("Invalid configuration of Net::HTTPS")
+        unless(Net::HTTPS->isa('Net::SSL'));
+
+    return $self;
+}
+
+sub get_volume
+{
+    my $self = shift;
+
+    my ($path) = @_;
+
+    # Need to turn this:
+    #  [yellow:storage1] win2k3r2-32/win2k3r2-32.vmdk
+    # into this:
+    #  https://yellow.rhev.marston/folder/win2k3r2-32/win2k3r2-32-flat.vmdk? \
+    #  dcPath=ha-datacenter&dsName=yellow:storage1
+
+    $path =~ /^\[(.*)\]\s+(.*)\.vmdk$/
+        or die("Failed to parse ESX path: $path");
+    my $datastore = $1;
+    my $vmdk = $2;
+
+    my $url = URI->new("https://".$self->{_v2v_server});
+    $url->path("/folder/$vmdk-flat.vmdk");
+    $url->query_form(dcPath => "ha-datacenter", dsName => $datastore);
+
+    # Replace / with _ so the vmdk name can be used as a volume name
+    $self->{_v2v_volname} = $vmdk;
+    $self->{_v2v_volname} =~ s,/,_,g;
+
+    # Check to see if this volume already exists
+    eval {
+        my $pool = $self->{_v2v_pool};
+        $self->{_v2v_vol} = $pool->get_volume_by_name($self->{_v2v_volname});
+    };
+
+    # The above command should generate VIR_ERR_NO_STORAGE_VOL because the
+    # volume doesn't exist
+    unless($@ && $@->code == Sys::Virt::Error::ERR_NO_STORAGE_VOL) {
+        unless ($@) {
+            print STDERR user_message(__x("WARNING: storage volume {name} ".
+                                          "already exists in the target ".
+                                          "pool. NOT fetching it again. ".
+                                          "Delete the volume and retry to ".
+                                          "download again.",
+                                          name => $self->{_v2v_volname}));
+            return $self->{_v2v_vol};
+        }
+
+        # We got an error, but not the one we expected
+        die(user_message(__x("Unexpected error accessing storage pool: ",
+                             "{error}", error => $@->stringify())));
+    }
+
+    my $r = $self->SUPER::get($url,
+                              ':content_cb' => sub { $self->handle_data(@_); },
+                              ':read_size_hint' => 64 * 1024);
+
+    if ($r->is_success) {
+        # It reports success even if one of the callbacks died
+        my $died = $r->header('X-Died');
+        die($died) if (defined($died));
+
+        # Close the volume file descriptor
+        close($self->{_v2v_volfh});
+        return $self->{_v2v_vol};
+    }
+
+    if ($r->code == 401) {
+        die(user_message(__x("Authentication error connecting to ".
+                             "{server}. Used credentials for {username} ".
+                             "from .netrc.",
+                             server => $self->{_v2v_server},
+                             username => $self->{_v2v_username})))
+    }
+
+    die(user_message(__x("Failed to connect to ESX server: {error}",
+                         error => $r->status_line)));
+}
+
+sub get_basic_credentials
+{
+    my $self = shift;
+
+    my ($realm, $uri, $isproxy) = @_; # Not interested in any of these things
+                                      # because we only ever contact a single
+                                      # server in a single context
+
+    return ($self->{_v2v_username}, $self->{_v2v_password});
+}
+
+sub handle_data
+{
+    my $self = shift;
+
+    my ($data, $response) = @_;
+
+    my $volfh = $self->{_v2v_volfh};
+
+    syswrite($volfh, $data)
+        or die(user_message(__x("Error writing to {path}: {error}",
+                                path => $self->{_v2v_volpath},
+                                error => $!)));
+}
+
+sub create_volume
+{
+    my $self = shift;
+
+    my ($response) = @_;
+
+    my $pool = $self->{_v2v_pool};
+
+    # Create a volume in the target storage pool of the correct size
+    my $name = $self->{_v2v_volname};
+    die("create_volume called, but _v2v_volname is not set")
+        unless (defined($name));
+
+    my $size = $response->content_length();
+
+    my $vol_xml = "
+        <volume>
+            <name>$name</name>
+            <capacity>$size</capacity>
+        </volume>
+    ";
+
+    my $volume;
+    eval {
+        $volume = $pool->create_volume($vol_xml);
+    };
+    die(user_message(__x("Failed to create storage volume: {error}",
+                         error => $@->stringify()))) if ($@);
+    $self->{_v2v_vol} = $volume;
+
+    # Open the volume for writing
+    open(my $volfh, '>', $volume->get_path())
+        or die(user_message(__x("Error opening storage volume {path} ".
+                                "for writing: {error}", error => $!)));
+
+    $self->{_v2v_volfh} = $volfh;
+}
+
+sub verify_certificate
+{
+    my $self = shift;
+
+    my ($r) = @_;
+
+    # No point in trying to verify headers if the request failed anyway
+    return unless ($r->is_success);
+
+    my $subject = $r->header('Client-SSL-Cert-Subject');
+    die(user_message(__"Server response didn't include an SSL subject"))
+        unless ($subject);
+
+    $subject =~ /\/CN=([^\/]*)/
+        or die(user_message(__x("SSL Certification Subject doesn't contain a ".
+                                "common name: {subject}",
+                                subject => $subject)));
+    my $cn = $1;
+
+    $self->{_v2v_server} =~ /(^|\.)\Q$cn\E$/
+        or die(user_message(__x("Server {server} presented an SSL certificate ".
+                                "for {commonname}",
+                                server => $self->{_v2v_server},
+                                commonname => $cn)));
+}
+
+package Sys::VirtV2V::Transfer::ESX;
+
+use Sys::Virt;
+
+use Sys::VirtV2V::UserMessage qw(user_message);
+
+use Locale::TextDomain 'virt-v2v';
+
+=pod
+
+=head1 NAME
+
+Sys::VirtV2V::Transfer::ESX - Transfer guest storage from an ESX server
+
+=head1 SYNOPSIS
+
+ use Sys::VirtV2V::Transfer::ESX;
+
+ $vol = Sys::VirtV2V::Transfer::ESX->transfer($conn, $path, $pool);
+
+=head1 DESCRIPTION
+
+Sys::VirtV2V::Transfer::ESX retrieves guest storage devices from an ESX server.
+
+=head1 METHODS
+
+=over
+
+=item transfer(conn, path, pool)
+
+Transfer <path> from a remote ESX server. Server and authentication details will
+be taken from <conn>. Storage will be copied to a new volume created in <pool>.
+
+=cut
+
+sub transfer
+{
+    my $class = shift;
+
+    my ($conn, $path, $pool) = @_;
+
+    my $uri      = $conn->{uri};
+    my $username = $conn->{username};
+    my $password = $conn->{password};
+
+    die("URI not defined for connection")      unless (defined($uri));
+
+    die(user_message(__x("Authentication is required to connect to ".
+                         "{server} and no credentials were found in ".
+                         ".netrc.",
+                         server => $conn->{hostname})))
+        unless (defined($username));
+
+    # Look for no_verify in the URI
+    my %query = $uri->query_form;
+
+    my $noverify = 0;
+    $noverify = 1 if (exists($query{no_verify}) && $query{no_verify} eq "1");
+
+    # Initialise a user agent
+    my $ua = Sys::VirtV2V::Transfer::ESX::UA->new($conn->{hostname},
+                                                  $username,
+                                                  $password,
+                                                  $pool);
+
+    return $ua->get_volume($path);
+}
+
+=back
+
+=head1 COPYRIGHT
+
+Copyright (C) 2009, 2010 Red Hat Inc.
+
+=head1 LICENSE
+
+Please see the file COPYING.LIB for the full license.
+
+=head1 SEE ALSO
+
+L<virt-v2v(1)>,
+L<v2v-snapshot(1)>,
+L<http://libguestfs.org/>.
+
+=cut
+
+1;
diff --git a/v2v/virt-v2v.pl b/v2v/virt-v2v.pl
index 82f16ce..b097ccd 100755
--- a/v2v/virt-v2v.pl
+++ b/v2v/virt-v2v.pl
@@ -33,7 +33,8 @@ use Sys::Guestfs::Lib qw(open_guest get_partitions inspect_all_partitions
 use Sys::VirtV2V;
 use Sys::VirtV2V::GuestOS;
 use Sys::VirtV2V::Converter;
-use Sys::VirtV2V::Connection;
+use Sys::VirtV2V::Connection::LibVirt;
+use Sys::VirtV2V::Connection::LibVirtXML;
 use Sys::VirtV2V::UserMessage qw(user_message);
 
 =encoding utf8
@@ -133,12 +134,20 @@ Guest argument is the path to an XML file describing a libvirt domain.
 
 =cut
 
-my $input_uri;
+my $input_uri = "qemu:///system";
 
 =item B<-ic URI>
 
 Specifies the connection to use when using the libvirt input method. If omitted,
-then we connect to the default libvirt hypervisor.
+this defaults to qemu:///system.
+
+=cut
+
+my $input_transport;
+
+=item B<-it method>
+
+Species the transport method used to obtain raw storage from the source guest.
 
 =cut
 
@@ -151,9 +160,18 @@ ommitted, this defaults to qemu:///system.
 
 =cut
 
+my $output_pool;
+
+=item B<-op pool>
+
+Specifies the pool which will be used to create new storage for the converted
+guest.
+
+=cut
+
 my $config_file;
 
-=item B<-f file>, B<--config file>
+=item B<-f file>
 
 Load the virt-v2v configuration from I<file>. There is no default.
 
@@ -189,6 +207,7 @@ GetOptions ("help|?"      => sub {
             "i=s"         => \$input_method,
             "ic=s"        => \$input_uri,
             "oc=s"        => \$output_uri,
+            "op=s"        => \$output_pool,
             "f|config=s"  => \$config_file
 ) or pod2usage(2);
 
@@ -208,33 +227,89 @@ if(defined($config_file)) {
     }
 }
 
+# Connect to target libvirt
+my $vmm = Sys::Virt->new(
+    auth => 1,
+    uri => $output_uri
+);
+
 # Get an appropriate Connection
-my $mdr = Sys::VirtV2V::Connection->instantiate($input_method, $input_uri,
-                                                    $config, @ARGV);
-if(!defined($mdr)) {
-    print STDERR user_message __x("{input} is not a valid input method",
-                                  input => $input_method);
+my $conn;
+eval {
+    if ($input_method eq "libvirtxml") {
+        my $path = shift(@ARGV) or
+            pod2usage({ -message => user_message(__"You must specify a filename"),
+                        -exitval => 1 });
+
+        # Warn if we were given more than 1 argument
+        if(scalar(@_) > 0) {
+            print STDERR user_message
+                (__x("WARNING: {modulename} only takes a single filename.",
+                     modulename => 'libvirtxml'));
+        }
+
+        $conn = Sys::VirtV2V::Connection::LibVirtXML->new($config, $path);
+    }
+
+    elsif ($input_method eq "libvirt") {
+        my $name = shift(@ARGV) or
+            pod2usage({ -message => user_message(__"You must specify a guest"),
+                        -exitval => 1 });
+
+        # Get a handle to the output pool if one is defined
+        my $pool;
+        if (defined($output_pool)) {
+            eval {
+                $pool = $vmm->get_storage_pool_by_name($output_pool);
+            };
+
+            if ($@) {
+                print STDERR user_message
+                    (__x("Output pool {poolname} is not a valid local ".
+                         "storage pool",
+                         poolname => $output_pool));
+                exit(1);
+            }
+        }
+
+        $conn = Sys::VirtV2V::Connection::LibVirt->new($input_uri, $name,
+                                                       $pool);
+
+        # Warn if we were given more than 1 argument
+        if(scalar(@_) > 0) {
+            print STDERR user_message
+                (__x("WARNING: {modulename} only takes a single domain name.",
+                     modulename => 'libvirt'));
+        }
+    }
+
+    else {
+        print STDERR user_message __x("{input} is not a valid input method",
+                                      input => $input_method);
+        exit(1);
+    }
+};
+if ($@) {
+    print STDERR $@;
     exit(1);
 }
 
-# Check Connection is properly initialised
-exit 1 unless($mdr->is_configured());
-
 # Configure GuestOS ([files] and [deps] sections)
 Sys::VirtV2V::GuestOS->configure($config);
 
+
 ###############################################################################
 ## Start of processing
 
 # Get a libvirt configuration for the guest
-my $dom = $mdr->get_dom();
+my $dom = $conn->get_dom();
 exit(1) unless(defined($dom));
 
-# Get a list of the guest's storage devices
-my @devices = get_guest_devices($dom);
+# Get a list of the guest's transfered storage devices
+my @storage = $conn->get_local_storage();
 
-# Open a libguestfs handle on the guest's devices
-my $g = get_guestfs_handle(@devices);
+# Open a libguestfs handle on the guest's storage devices
+my $g = get_guestfs_handle(@storage);
 
 # Inspect the guest
 my $os = inspect_guest($g);
@@ -242,11 +317,6 @@ my $os = inspect_guest($g);
 # Instantiate a GuestOS instance to manipulate the guest
 my $guestos = Sys::VirtV2V::GuestOS->instantiate($g, $os);
 
-# Connect to target libvirt
-my @vmm_params = (auth => 1);
-push(@vmm_params, uri => $output_uri) if(defined($output_uri));
-my $vmm = Sys::Virt->new(@vmm_params);
-
 # Modify the guest and its metadata for the target hypervisor
 Sys::VirtV2V::Converter->convert($vmm, $guestos, $dom, $os);
 
@@ -255,15 +325,14 @@ $g->sync();
 
 $vmm->define_domain($dom->toString());
 
+exit(0);
 
 ###############################################################################
 ## Helper functions
 
 sub get_guestfs_handle
 {
-    my @params = \@_; # Initialise parameters with list of devices
-
-    my $g = open_guest(@params, rw => 1);
+    my $g = open_guest(\@_, rw => 1);
 
     # Mount the transfer iso if GuestOS needs it
     my $transferiso = Sys::VirtV2V::GuestOS->get_transfer_iso();
@@ -328,27 +397,6 @@ sub inspect_guest
     return $os;
 }
 
-sub get_guest_devices
-{
-    my $dom = shift;
-
-    my @devices;
-    foreach my $source ($dom->findnodes('/domain/devices/disk/source')) {
-        my $attrs = $source->getAttributes();
-
-        # Get either dev or file, whichever is defined
-        my $attr = $attrs->getNamedItem("dev");
-        $attr = $attrs->getNamedItem("file") if(!defined($attr));
-
-        defined($attr) or die("source element has neither dev nor file: ".
-                              $source.toString());
-
-        push(@devices, $attr->getValue());
-    }
-
-    return @devices;
-}
-
 =head1 PREPARING TO RUN VIRT-V2V
 
 =head2 Backup the guest
-- 
1.6.6

    

[Libguestfs] [PATCH 3/8] ESX: Import guests from VMware's ESX server

Matthew Booth