[Date Prev][Date Next]   [Thread Prev][Thread Next]   [Thread Index] [Date Index] [Author Index]

[Libguestfs] [PATCH] Initial drop of virt-v2v



This implements the structure and most of the functionality of the initial
virt-v2v tool.
---
 perl/lib/Sys/Guestfs/GuestOS.pm                   |   97 ++++
 perl/lib/Sys/Guestfs/GuestOS/RedHat.pm            |  506 +++++++++++++++++++++
 perl/lib/Sys/Guestfs/HVSource.pm                  |  132 ++++++
 perl/lib/Sys/Guestfs/HVSource/Xen/Linux.pm        |  141 ++++++
 perl/lib/Sys/Guestfs/HVTarget.pm                  |   89 ++++
 perl/lib/Sys/Guestfs/HVTarget/Linux.pm            |  239 ++++++++++
 perl/lib/Sys/Guestfs/MetadataReader.pm            |  147 ++++++
 perl/lib/Sys/Guestfs/MetadataReader/LibVirtXML.pm |  150 ++++++
 perl/lib/Sys/Guestfs/Storage.pm                   |  143 ++++++
 perl/lib/Sys/Guestfs/Storage/QCOW2.pm             |  180 ++++++++
 po/POTFILES.in                                    |   10 +
 v2v/STATUS                                        |   56 +++
 v2v/virt-v2v.pl                                   |  204 +++++++--
 13 files changed, 2062 insertions(+), 32 deletions(-)
 create mode 100644 perl/lib/Sys/Guestfs/GuestOS.pm
 create mode 100644 perl/lib/Sys/Guestfs/GuestOS/RedHat.pm
 create mode 100644 perl/lib/Sys/Guestfs/HVSource.pm
 create mode 100644 perl/lib/Sys/Guestfs/HVSource/Xen/Linux.pm
 create mode 100644 perl/lib/Sys/Guestfs/HVTarget.pm
 create mode 100644 perl/lib/Sys/Guestfs/HVTarget/Linux.pm
 create mode 100644 perl/lib/Sys/Guestfs/MetadataReader.pm
 create mode 100644 perl/lib/Sys/Guestfs/MetadataReader/LibVirtXML.pm
 create mode 100644 perl/lib/Sys/Guestfs/Storage.pm
 create mode 100644 perl/lib/Sys/Guestfs/Storage/QCOW2.pm
 create mode 100644 v2v/STATUS

diff --git a/perl/lib/Sys/Guestfs/GuestOS.pm b/perl/lib/Sys/Guestfs/GuestOS.pm
new file mode 100644
index 0000000..e359823
--- /dev/null
+++ b/perl/lib/Sys/Guestfs/GuestOS.pm
@@ -0,0 +1,97 @@
+# Sys::Guestfs::GuestOS
+# Copyright (C) 2009 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::Guestfs::GuestOS;
+
+use strict;
+use warnings;
+
+use Module::Pluggable::Ordered sub_name => 'modules',
+                               search_path => 'Sys::Guestfs::GuestOS',
+                               require => 1;
+
+use Carp;
+
+=pod
+
+=head1 NAME
+
+Sys::Guestfs::GuestOS - Guest OS specific queries and manipulation
+
+=head1 SYNOPSIS
+
+ use Sys::Guestfs::GuestOS;
+
+ $guestos = Sys::Guestfs::GuestOS->get_instance($os, $distro, $version)
+
+=head1 DESCRIPTION
+
+Sys::Guestfs::GuestOS provides a mechanism for querying and manipulating a
+specific guest operating system.
+
+Sys::Guestfs::GuestOS is an interface to various backends, each of
+which implement a consistent API. Sys::Guestfs::GuestOS itself only
+implements methods to access backends.
+
+=head1 METHODS
+
+=item instantiate(desc)
+
+Instantiate a GuestOS object capable of manipulating the os described by $desc.
+
+Returns a Sys::Guestfs::GuestOS object if one is found.
+Returns undef otherwise.
+
+=cut
+
+sub instantiate
+{
+    my $class = shift;
+
+    my ($g, $desc, $files) = @_;
+    defined($g) or carp("get_instance called without g argument");
+    defined($desc) or carp("get_instance called without desc argument");
+    defined($files) or carp("get_instance called without files argument");
+
+    foreach my $module ($class->modules()) {
+        return $module->new($g, $desc, $files) if($module->can_handle($desc));
+    }
+
+    return undef;
+}
+
+1;
+
+=head1 COPYRIGHT
+
+Copyright (C) 2009 Red Hat Inc.
+
+=head1 LICENSE
+
+Please see the file COPYING.LIB for the full license.
+
+=head1 SEE ALSO
+
+L<virt-inspector(1)>,
+L<Sys::Guestfs(3)>,
+L<guestfs(3)>,
+L<http://libguestfs.org/>,
+L<Sys::Virt(3)>,
+L<http://libvirt.org/>,
+L<guestfish(1)>.
+
+=cut
diff --git a/perl/lib/Sys/Guestfs/GuestOS/RedHat.pm b/perl/lib/Sys/Guestfs/GuestOS/RedHat.pm
new file mode 100644
index 0000000..9d7ca93
--- /dev/null
+++ b/perl/lib/Sys/Guestfs/GuestOS/RedHat.pm
@@ -0,0 +1,506 @@
+# Sys::Guestfs::GuestOS:RedHat
+# Copyright (C) 2009 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::Guestfs::GuestOS::RedHat;
+
+use strict;
+use warnings;
+
+use Carp;
+use Locale::TextDomain 'libguestfs';
+
+=pod
+
+=head1 NAME
+
+Sys::Guestfs::GuestOS::RedHat - Manipulate and query a Red Hat guest
+
+=head1 SYNOPSIS
+
+ use Sys::Guestfs::GuestOS;
+
+ $guestos = Sys::Guestfs::GuestOS->get_instance($os, $distro, $version)
+
+=head1 DESCRIPTION
+
+Sys::Guestfs::GuestOS provides a mechanism for querying and manipulating a
+specific guest operating system.
+
+Sys::Guestfs::GuestOS is an interface to various backends, each of
+which implement a consistent API. Sys::Guestfs::GuestOS itself only
+implements methods to access backends.
+
+=head1 METHODS
+
+=cut
+
+sub can_handle
+{
+    my $class = shift;
+
+    my $desc = shift;
+
+    return ($desc->{os} eq 'linux') && ($desc->{package_format} eq 'rpm');
+}
+
+sub new
+{
+    my $class = shift;
+
+    my $self = {};
+
+    # Guest handle
+    my $g = $self->{g} = shift;
+    carp("new called without guest handle") unless defined($g);
+
+    # Guest description
+    $self->{desc} = shift;
+    carp("new called without guest description") unless defined($self->{desc});
+
+    # Guest file map
+    $self->{files} = shift;
+    carp("new called without files description") unless defined($self->{files});
+
+    # Check how new modules should be configured. Possibilities, in descending
+    # order of preference, are:
+    #   modprobe.d/
+    #   modprobe.conf
+    #   modules.conf
+    #   conf.modules
+
+    # Note that we're checking in ascending order of preference so that the last
+    # discovered method will be chosen
+
+    # Files which the augeas Modprobe lens doesn't look for by default
+    my @modprobe_add = ();
+    foreach my $file qw(/etc/conf.modules /etc/modules.conf) {
+        if($g->exists($file)) {
+            push(@modprobe_add, $file);
+            $self->{modules} = $file;
+        }
+    }
+
+    if($g->exists("/etc/modprobe.conf")) {
+        $self->{modules} = "modprobe.conf";
+    }
+
+    # If the modprobe.d directory exists, create new entries in
+    # modprobe.d/libguestfs-added.conf
+    if($g->exists("/etc/modprobe.d")) {
+        $self->{modules} = "modprobe.d/libguestfs-added.conf";
+    }
+
+    die(__"Unable to find any valid modprobe configuration")
+        unless(defined($self->{modules}));
+
+    # Initialise augeas
+    eval {
+        $g->aug_close();
+        $g->aug_init("/", 1);
+
+        # Add files which exist, but the augeas Modprobe lens doesn't look for
+        # by default
+        if(scalar(@modprobe_add) > 0) {
+            foreach (@modprobe_add) {
+                $g->aug_set("/augeas/load/Modprobe/incl[last()+1]", $_);
+            }
+
+            # Make augeas pick up the new configuration
+            $g->aug_load();
+        }
+
+        # Add /boot/grub/grub.conf to the Grub lens
+        $g->aug_set("/augeas/load/Grub/incl[last()+1]", "/boot/grub/grub.conf");
+    };
+
+    # The augeas calls will die() on any error.
+    die($@) if($@);
+
+    bless($self, $class);
+
+    return $self;
+}
+
+sub enable_driver
+{
+    my $self = shift;
+    my ($device, $module) = @_;
+
+    my $g = $self->{g};
+
+    eval {
+        $g->aug_set("/files/etc/".$self->{modules}."/alias[last()+1]", $device);
+        $g->aug_set("/files/etc/".$self->{modules}."/alias[last()]/modulename",
+                    $module)
+    };
+
+    # Propagate augeas errors
+    die($@) if($@);
+}
+
+sub update_driver
+{
+    my $self = shift;
+    my ($device, $module) = @_;
+
+    # We expect the driver to have been discovered during inspection
+    my $desc = $self->{desc};
+    my $augeas = $desc->{modprobe_aliases}->{$device}->{augeas};
+
+    # Error if the driver isn't defined
+    die("$augeas isn't defined") unless defined($augeas);
+
+    my $g = $self->{g};
+    $augeas = $self->check_augeas_device($augeas, $device);
+
+    eval {
+        $g->aug_set($augeas."/modulename", $module);
+
+        # XXX: The following save should not be required, but is
+        # If this save is omitted, by the time save is called just before
+        # mkinitrd, these changes will have been lost.
+        $g->aug_save();
+    };
+
+    # Propagate augeas errors
+    die($@) if($@);
+}
+
+sub disable_driver
+{
+    my $self = shift;
+    my $device = shift;
+
+    # We expect the driver to have been discovered during inspection
+    my $desc = $self->{desc};
+    my $augeas = $desc->{modprobe_aliases}->{$device}->{augeas};
+
+    # Nothing to do if the driver isn't defined
+    return if(!defined($augeas));
+
+    my $g = $self->{g};
+
+    $augeas = $self->check_augeas_device($augeas, $device);
+    eval {
+        $g->aug_rm($augeas);
+    };
+
+    # Propagate augeas errors
+    die($@) if($@);
+}
+
+# We can't rely on the index in the augeas path because it will change if
+# something has been inserted or removed before it.
+# Look for the alias again in the same file which contained it on the first
+# pass.
+sub check_augeas_device
+{
+    my $self = shift;
+    my ($path, $device) = @_;
+
+    my $g = $self->{g};
+
+    $path =~ m{^(.*)/alias(?:\[\d+\])?$}
+        or die("Unexpected augeas modprobe alias path: $path");
+
+    my $augeas;
+    eval {
+        my @aliases = $g->aug_match($1."/alias");
+
+        foreach my $alias (@aliases) {
+            if($g->aug_get($alias) eq $device) {
+                $augeas = $alias;
+                last;
+            }
+        }
+    };
+
+    # Propagate augeas errors
+    die($@) if($@);
+
+    return $augeas if(defined($augeas));
+    die("Unable to find augeas path similar to $path for $device");
+}
+
+sub add_kernel
+{
+    my $self = shift;
+    my $kernel_arch = "i386"; # XXX: Need to get this from inspection!
+
+    my $g = $self->{g};
+
+    my $filename = $self->match_file('kernel', $kernel_arch);
+
+    # Inspect the rpm to work out what kernel version it contains
+    my $version;
+    foreach my $file ($g->command_lines(["rpm", "-qlp", $filename])) {
+        if($file =~ m{^/boot/vmlinuz-(.*)$}) {
+            $version = $1;
+            last;
+        }
+    }
+
+    die(__x"{filename} doesn't contain a valid kernel\n",
+            filename => $filename) if(!defined($version));
+
+    $self->install_rpm($filename);
+
+    # Make augeas reload so it'll find the new kernel
+    $g->aug_load();
+
+    return $version;
+}
+
+sub remove_kernel
+{
+    my $self = shift;
+    my $version = shift;
+
+    my $g = $self->{g};
+    eval {
+        # Work out which rpm contains the kernel
+        my $rpm = $g->command(["rpm", "-qf", "/boot/vmlinuz-".$version]);
+
+        $g->command(["rpm", "-e", $rpm]);
+    };
+
+    die($@) if($@);
+}
+
+sub add_application
+{
+    my $self = shift;
+    my $label = shift;
+    my $user_arch = "i386"; # XXX: Need to get this from inspection!
+
+    my $filename = $self->match_file($label, $user_arch);
+    $self->install_rpm($filename);
+}
+
+sub remove_application
+{
+    my $self = shift;
+    my $name = shift;
+
+    my $g = $self->{g};
+    eval {
+        $g->command(["rpm", "-e", $name]);
+    };
+    die($@) if($@);
+}
+
+sub match_file
+{
+    my $self = shift;
+    my ($label, $arch) = @_;
+
+    my $desc = $self->{desc};
+    my $distro = $desc->{distro};
+    my $major = $desc->{major_version};
+    my $minor = $desc->{minor_version};
+
+    my $files = $self->{files};
+
+    if(values(%$files) > 0) {
+        # Ensure that whatever file is returned is accessible
+        $self->ensure_transfer_mounted();
+
+        # Search for a matching entry in the file map, in descending order of
+        # specificity
+        for my $name ("$distro.$major.$minor.$arch.$label",
+                      "$distro.$major.$minor.$label",
+                      "$distro.$major.$arch.$label",
+                      "$distro.$major.$label",
+                      "$distro.$arch.$label",
+                      "$distro.$label") {
+            return $self->{transfer_mount}.'/'.$files->{$name}
+                if(defined($files->{$name}));
+        }
+    }
+
+    die (__x("No file given matching {label}\n", label =>
+        "$distro.$major.$minor.$arch.$label"));
+
+}
+
+# Internal use only
+sub install_rpm
+{
+    my $self = shift;
+    my $filename = shift;
+
+    my $g = $self->{g};
+    eval {
+        $g->command(["rpm", "-i", $filename]);
+    };
+
+    # Propagate command failure
+    die($@) if($@);
+}
+
+sub ensure_transfer_mounted
+{
+    my $self = shift;
+
+    # Return immediately if it's already mounted
+    return if(exists($self->{transfer_mount}));
+
+    my $g = $self->{g};
+
+    # Find the transfer device
+    my @devices = $g->list_devices();
+    my $transfer = $devices[$#devices];
+
+    $self->{transfer_mount} = $g->mkdtemp("/tmp/transferXXXXXX");
+    $g->mount_ro($transfer, $self->{transfer_mount});
+}
+
+sub remap_block_devices
+{
+    my $self = shift;
+    my %map = @_;
+
+    my $g = $self->{g};
+
+    # Iterate over fstab. Any entries with a spec in the the map, replace them
+    # with their mapped values
+    eval {
+        foreach my $spec ($g->aug_match('/etc/fstab/*/spec')) {
+            my $device = $g->aug_get($spec);
+            if(exists($map{$device})) {
+                $g->aug_set($spec, $map{$device});
+            }
+        }
+    };
+
+    # Propagate augeas failure
+    die($@) if($@);
+}
+
+sub prepare_bootable
+{
+    my $self = shift;
+
+    my $version = shift;
+    my @drivers = @_;
+
+    my $g = $self->{g};
+
+    # Find the grub entry for the given kernel
+    my $initrd;
+    my $found = 0;
+    eval {
+        foreach my $kernel
+                ($g->aug_match('/files/boot/grub/grub.conf/title/kernel')) {
+            if($g->aug_get($kernel) eq "/vmlinuz-$version") {
+                # Ensure it's the default
+                $kernel =~ m{/files/boot/grub/grub.conf/title(?:\[(\d+)\])?/kernel}
+                    or die($kernel);
+
+                my $aug_index;
+                if(defined($1)) {
+                    $aug_index = $1;
+                } else {
+                    $aug_index = 1;
+                }
+
+                $g->aug_set('/files/boot/grub/grub.conf/default',
+                            $aug_index - 1);
+
+                # Get the initrd for this kernel
+                $initrd = $g->aug_get("/files/boot/grub/grub.conf/title[$aug_index]/initrd");
+
+                $found = 1;
+                last;
+            }
+        }
+    };
+
+    # Propagate augeas failure
+    die($@) if($@);
+
+    if(!$found) {
+        die(__x"Didn't find a grub entry for kernel version {version}",
+               version => $version);
+    }
+
+    if(!defined($initrd)) {
+        print STDERR __x("WARNING: Kernel version {version} doesn't have an ".
+                         "initrd entry in grub", version => $version);
+    } else {
+        # Initrd as returned by grub is relative to /boot
+        $initrd = "/boot$initrd";
+
+        # Backup the original initrd
+        $g->mv("$initrd", "$initrd.pre-v2v");
+
+        # Create a new initrd which preloads the required drivers
+        my @preload_args = ();
+        foreach my $driver (@drivers) {
+            push(@preload_args, "--preload=$driver");
+        }
+
+        # mkinitrd reads configuration which we've probably changed
+        eval {
+            $g->aug_save();
+        };
+
+        if($@) {
+            foreach my $error ($g->aug_match('/augeas//error/*')) {
+                print STDERR "$error: ".$g->aug_get($error)."\n";
+            }
+            die($@);
+        }
+
+        $g->command(["/sbin/mkinitrd", @preload_args, $initrd, $version]);
+    }
+}
+
+sub DESTROY
+{
+    my $self = shift;
+
+    my $g = $self->{g};
+
+    # Remove the transfer mount point if it was used
+    if(defined($self->{transfer_mount})) {
+        $g->umount($self->{transfer_mount});
+        $g->rmdir($self->{transfer_mount});
+    }
+}
+
+1;
+
+=head1 COPYRIGHT
+
+Copyright (C) 2009 Red Hat Inc.
+
+=head1 LICENSE
+
+Please see the file COPYING.LIB for the full license.
+
+=head1 SEE ALSO
+
+L<virt-inspector(1)>,
+L<Sys::Guestfs(3)>,
+L<guestfs(3)>,
+L<http://libguestfs.org/>,
+L<Sys::Virt(3)>,
+L<http://libvirt.org/>,
+L<guestfish(1)>.
+
+=cut
diff --git a/perl/lib/Sys/Guestfs/HVSource.pm b/perl/lib/Sys/Guestfs/HVSource.pm
new file mode 100644
index 0000000..9f090ef
--- /dev/null
+++ b/perl/lib/Sys/Guestfs/HVSource.pm
@@ -0,0 +1,132 @@
+# Sys::Guestfs::HVSource
+# Copyright (C) 2009 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::Guestfs::HVSource;
+
+use strict;
+use warnings;
+
+use Module::Pluggable sub_name => 'modules',
+                      search_path => ['Sys::Guestfs::HVSource'],
+                      require => 1;
+use Carp;
+
+=pod
+
+=head1 NAME
+
+Sys::Guestfs::HVSource - Manipulate a guest based on its source Hypervisor
+
+=head1 SYNOPSIS
+
+ use Sys::Guestfs::HVSource;
+
+ Sys::Guestfs::HVSource->unconfigure_all();
+
+=head1 DESCRIPTION
+
+Sys::Guestfs::HVSource provides a mechanism for identifying hypervisor specific
+changes made to a guest operating system.
+
+=head1 METHODS
+
+=cut
+
+sub find_drivers
+{
+    my $class = shift;
+    
+    my $guestos = shift;
+    carp("find_drivers called without guestos argument")
+        unless defined($guestos);
+
+    my @drivers = ();
+    foreach my $module ($class->modules()) {
+        push(@drivers, $module->find_drivers($guestos));
+    }
+
+    return @drivers;
+}
+
+sub find_applications
+{
+    my $class = shift;
+
+    my $guestos = shift;
+    carp("find_applications called without guestos argument")
+        unless defined($guestos);
+
+    my @applications = ();
+    foreach my $module ($class->modules()) {
+        push(@applications, $module->find_drivers($guestos));
+    }
+
+    return @applications;
+}
+
+sub find_kernels
+{
+    my $class = shift;
+
+    my $guestos = shift;
+    carp("find_kernels called without guestos argument")
+        unless defined($guestos);
+
+    my @kernels = ();
+    foreach my $module ($class->modules()) {
+        push(@kernels, $module->find_drivers($guestos));
+    }
+
+    return @kernels;
+}
+
+sub find_metadata
+{
+    my $class = shift;
+
+    my $dom = shift;
+    carp("find_metadata called without dom argument") unless defined($dom);
+
+    my @nodes = ();
+    foreach my $module ($class->modules()) {
+        push(@nodes, $module->find_metadata($dom));
+    }
+
+    return @nodes;
+}
+
+1;
+
+=head1 COPYRIGHT
+
+Copyright (C) 2009 Red Hat Inc.
+
+=head1 LICENSE
+
+Please see the file COPYING.LIB for the full license.
+
+=head1 SEE ALSO
+
+L<virt-inspector(1)>,
+L<Sys::Guestfs(3)>,
+L<guestfs(3)>,
+L<http://libguestfs.org/>,
+L<Sys::Virt(3)>,
+L<http://libvirt.org/>,
+L<guestfish(1)>.
+
+=cut
diff --git a/perl/lib/Sys/Guestfs/HVSource/Xen/Linux.pm b/perl/lib/Sys/Guestfs/HVSource/Xen/Linux.pm
new file mode 100644
index 0000000..d19ab94
--- /dev/null
+++ b/perl/lib/Sys/Guestfs/HVSource/Xen/Linux.pm
@@ -0,0 +1,141 @@
+# Sys::Guestfs::HVSource::Xen::Linux
+# Copyright (C) 2009 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::Guestfs::HVSource::Xen::Linux;
+
+use strict;
+use warnings;
+
+use Locale::TextDomain 'libguestfs';
+
+use XML::DOM;
+use XML::DOM::XPath;
+
+=pod
+
+=head1 NAME
+
+Sys::Guestfs::HVSource::Xen::Linux - Unconfigure Xen/Linux changes
+
+=head1 SYNOPSIS
+
+ use Sys::Guestfs::HVSource;
+
+=head1 DESCRIPTION
+
+=cut
+
+sub find_drivers
+{
+    my $class = shift;
+
+    my $desc = shift;
+    carp("find_drivers called without desc argument")
+        unless defined($desc);
+
+    my $aliases = $desc->{modprobe_aliases};
+    return unless defined($aliases);
+
+    my @drivers = ();
+    foreach my $alias (keys(%$aliases)) {
+        my $modulename = $aliases->{$alias}->{modulename};
+
+        foreach my $xen_driver qw(xennet xen-vnif xenblk xen-vbd) {
+            if($modulename eq $xen_driver) {
+                push(@drivers, $alias);
+                last;
+            }
+        }
+    }
+
+    return @drivers;
+}
+
+sub find_applications
+{
+    my $class = shift;
+
+    my $desc = shift;
+    carp("find_applications called without desc argument")
+        unless defined($desc);
+
+    return ();
+}
+
+sub find_kernels
+{
+    my $class = shift;
+
+    my $desc = shift;
+    carp("find_kernels called without desc argument")
+        unless defined($desc);
+
+    return ();
+}
+
+sub find_metadata
+{
+    my $class = shift;
+
+    my $dom = shift;
+    defined($dom) or carp("find_metadata called without dom argument");
+
+    # List of nodes requiring changes if they exist and match a particular
+    # pattern
+    my @check_nodes = (
+        [ '/domain/@type', 'xen' ],
+        [ '/domain/os/loader', 'xen' ],
+        [ '/domain/devices/input/@bus', 'xen' ]
+    );
+
+    my @nodes = ();
+    foreach my $check_node (@check_nodes) {
+        my $xpath = $check_node->[0];
+        my $pattern = $check_node->[1];
+
+        foreach my $node ($dom->findnodes($xpath)) {
+            if($node->getValue() =~ m{$pattern}) {
+                push(@nodes, $xpath);
+            }
+        }
+    }
+
+    return @nodes;
+}
+
+1;
+
+=head1 COPYRIGHT
+
+Copyright (C) 2009 Red Hat Inc.
+
+=head1 LICENSE
+
+Please see the file COPYING.LIB for the full license.
+
+=head1 SEE ALSO
+
+L<Sys::Guestfs::MetadataReader(3)>,
+L<virt-inspector(1)>,
+L<Sys::Guestfs(3)>,
+L<guestfs(3)>,
+L<http://libguestfs.org/>,
+L<Sys::Virt(3)>,
+L<http://libvirt.org/>,
+L<guestfish(1)>.
+
+=cut
diff --git a/perl/lib/Sys/Guestfs/HVTarget.pm b/perl/lib/Sys/Guestfs/HVTarget.pm
new file mode 100644
index 0000000..92f5909
--- /dev/null
+++ b/perl/lib/Sys/Guestfs/HVTarget.pm
@@ -0,0 +1,89 @@
+# Sys::Guestfs::HVTarget
+# Copyright (C) 2009 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::Guestfs::HVTarget;
+
+use strict;
+use warnings;
+
+use Module::Pluggable::Ordered sub_name => 'modules',
+                               search_path => ['Sys::Guestfs::HVTarget'],
+                               require => 1;
+
+use Locale::TextDomain 'libguestfs';
+
+=pod
+
+=head1 NAME
+
+Sys::Guestfs::HVTarget - Manipulate a guest's storage during V2V migration
+
+=head1 SYNOPSIS
+
+ use Sys::Guestfs::HVTarget;
+
+=head1 DESCRIPTION
+
+=head1 METHODS
+
+=item configure(guestos, mdr, $desc)
+
+Instantiate a backend instance with the given name.
+
+=cut
+
+sub configure
+{
+    my $class = shift;
+
+    my ($guestos, $dom, $desc) = @_;
+    carp("configure called without guestos argument") unless defined($guestos);
+    carp("configure called without dom argument") unless defined($dom);
+    carp("configure called without desc argument") unless defined($desc);
+
+    # Find a module which can configure this guest and run it
+    foreach my $module ($class->modules()) {
+        if($module->can_handle($desc)) {
+            $module->configure($guestos, $dom, $desc);
+            return;
+        }
+    }
+
+    die(__"Unable to find a module to configure this guest");
+}
+
+1;
+
+=head1 COPYRIGHT
+
+Copyright (C) 2009 Red Hat Inc.
+
+=head1 LICENSE
+
+Please see the file COPYING.LIB for the full license.
+
+=head1 SEE ALSO
+
+L<virt-inspector(1)>,
+L<Sys::Guestfs(3)>,
+L<guestfs(3)>,
+L<http://libguestfs.org/>,
+L<Sys::Virt(3)>,
+L<http://libvirt.org/>,
+L<guestfish(1)>.
+
+=cut
diff --git a/perl/lib/Sys/Guestfs/HVTarget/Linux.pm b/perl/lib/Sys/Guestfs/HVTarget/Linux.pm
new file mode 100644
index 0000000..9e9c020
--- /dev/null
+++ b/perl/lib/Sys/Guestfs/HVTarget/Linux.pm
@@ -0,0 +1,239 @@
+# Sys::Guestfs::HVTarget::Linux
+# Copyright (C) 2009 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::Guestfs::HVTarget::Linux;
+
+use strict;
+use warnings;
+
+use Data::Dumper;
+use Locale::TextDomain 'libguestfs';
+
+use Sys::Guestfs::HVSource;
+
+use Carp;
+
+=pod
+
+=head1 NAME
+
+Sys::Guestfs::HVTarget::Linux - Configure a Linux guest for a target hypervisor
+
+=head1 SYNOPSIS
+
+ use Sys::Guestfs::HVTarget;
+
+=head1 DESCRIPTION
+
+=head1 METHODS
+
+=cut
+
+sub can_handle
+{
+    my $class = shift;
+
+    my $desc = shift;
+    carp("can_handle called without desc argument") unless defined($desc);
+
+    return ($desc->{os} eq 'linux');
+}
+
+sub configure
+{
+    my $class = shift;
+
+    my ($guestos, $dom, $desc) = @_;
+    carp("configure called without guestos argument") unless defined($guestos);
+    carp("configure called without dom argument") unless defined($dom);
+    carp("configure called without desc argument") unless defined($desc);
+
+    configure_drivers($guestos, $desc);
+    configure_applications($guestos, $desc);
+    configure_kernels($guestos, $desc);
+    configure_metadata($dom, $desc);
+}
+
+sub configure_drivers
+{
+    my ($guestos, $desc) = @_;
+    die("configure_drivers called without guestos argument")
+        unless defined($guestos);
+    die("configure_drivers called without desc argument")
+        unless defined($desc);
+
+    # Get a list of all old-hypervisor specific drivers which need to be
+    # replaced or removed
+    my %hvs_drivers;
+    foreach my $driver (Sys::Guestfs::HVSource->find_drivers($guestos)) {
+        $hvs_drivers{$driver} = undef;
+    }
+
+    # Go through all drivers looking for network or scsi devices
+    my $drivers = $desc->{modprobe_aliases};
+
+    foreach my $driver (keys(%$drivers)) {
+        # Replace network drivers with virtio_net
+        if($driver =~ /^eth\d+$/) {
+            # Make a note that we updated an old-HV specific driver
+            if(exists($hvs_drivers{$driver})) {
+                $hvs_drivers{$driver} = "virtio_net";
+            }
+
+            $guestos->update_driver($driver, "virtio_net");
+
+            print STDERR __x("Replaced {driver} driver with virtio_net\n",
+                      driver => $driver);
+        }
+
+        # Replace block drivers with virtio_blk
+        if($driver =~ /^scsi_hostadapter/) {
+            # Make a note that we updated an old-HV specific driver
+            if(exists($hvs_drivers{$driver})) {
+                $hvs_drivers{$driver} = "virtio_blk";
+            }
+
+            $guestos->update_driver($driver, "virtio_blk");
+
+            print STDERR __x("Replaced {driver} driver with virtio_blk\n",
+                      driver => $driver);
+        }
+    }
+
+    # Warn if any old-HV specific drivers weren't updated
+    foreach my $driver (keys(%hvs_drivers)) {
+        if(!defined($hvs_drivers{$driver})) {
+            print STDERR __x("WARNING: Don't know how to update {driver}, ".
+                             "which loads the {module} module.\n",
+                             driver => $driver,
+                             module => $drivers->{$driver}->{modulename});
+        }
+    }
+}
+
+sub configure_applications
+{
+    my ($guestos, $desc) = @_;
+    die("configure_applications called without guestos argument")
+        unless defined($guestos);
+    die("configure_applications called without desc argument")
+        unless defined($desc);
+
+    my @hvs_apps = Sys::Guestfs::HVSource->find_applications($guestos);
+}
+
+sub configure_kernels
+{
+    my ($guestos, $desc) = @_;
+    die("configure_kernels called without guestos argument")
+        unless defined($guestos);
+    die("configure_kernels called without desc argument")
+        unless defined($desc);
+
+    my %kernels;
+
+    # Look for installed kernels with virtio support
+    foreach my $kernel (@{$desc->{kernels}}) {
+        my %checklist = (
+            "virtio_blk" => undef,
+            "virtio_pci" => undef,
+            "virtio_net" => undef
+        );
+
+        foreach my $driver ($kernel->{modules}) {
+            if(exists($checklist{$driver})) {
+                $checklist{$driver} = 1;
+            }
+        }
+
+        my $virtio = 1;
+        foreach my $driver (keys(%checklist)) {
+            if(!defined($checklist{$driver})) {
+                $virtio = 0;
+                last;
+            }
+        }
+
+        if($virtio) {
+            $kernels{$kernel->{version}} = 1;
+        } else {
+            $kernels{$kernel->{version}} = 0;
+        }
+    }
+
+    # Remove old-HV kernels
+    foreach my $kernel (Sys::Guestfs::HVSource->find_kernels($guestos)) {
+        # Remove the kernel from our cache
+        delete($kernels{$kernel});
+
+        # Uninstall the kernel from the guest
+        $guestos->remove_kernel($kernel);
+    }
+
+    # Find the highest versioned, virtio capable, installed kernel
+    my $boot_kernel;
+    foreach my $kernel (sort {$b cmp $a} (keys(%kernels))) {
+        if($kernels{$kernel}) {
+            if($kernels{$kernel}) {
+                $boot_kernel = $kernel;
+                last;
+            }
+        }
+    }
+
+    # If none of the installed kernels are appropriate, install a new one
+    if(!defined($boot_kernel)) {
+        $boot_kernel = $guestos->add_kernel();
+    }
+
+    $guestos->prepare_bootable($boot_kernel,
+                               "virtio_pci", "virtio_blk", "virtio_net");
+}
+
+sub configure_metadata
+{
+    my ($dom, $desc) = @_;
+
+    die("configure_metadata called without dom argument")
+        unless defined($dom);
+    die("configure_metadata called without desc argument")
+        unless defined($desc);
+
+    my @hvs_metadata = Sys::Guestfs::HVSource->find_metadata($dom);
+}
+
+1;
+
+=head1 COPYRIGHT
+
+Copyright (C) 2009 Red Hat Inc.
+
+=head1 LICENSE
+
+Please see the file COPYING.LIB for the full license.
+
+=head1 SEE ALSO
+
+L<virt-inspector(1)>,
+L<Sys::Guestfs(3)>,
+L<guestfs(3)>,
+L<http://libguestfs.org/>,
+L<Sys::Virt(3)>,
+L<http://libvirt.org/>,
+L<guestfish(1)>.
+
+=cut
diff --git a/perl/lib/Sys/Guestfs/MetadataReader.pm b/perl/lib/Sys/Guestfs/MetadataReader.pm
new file mode 100644
index 0000000..2aa0bff
--- /dev/null
+++ b/perl/lib/Sys/Guestfs/MetadataReader.pm
@@ -0,0 +1,147 @@
+# Sys::Guestfs::MetadataReader
+# Copyright (C) 2009 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::Guestfs::MetadataReader;
+
+use strict;
+use warnings;
+
+use Module::Pluggable sub_name => 'modules',
+                      search_path => ['Sys::Guestfs::MetadataReader'],
+                      require => 1;
+
+=pod
+
+=head1 NAME
+
+Sys::Guestfs::MetadataReader - Read a variety of guest metadata formats
+
+=head1 SYNOPSIS
+
+ use Sys::Guestfs::MetadataReader;
+
+ $reader = Sys::Guestfs::MetadataReader->get_instance("libvirtxml);
+ $dom = $reader->get_dom();
+
+=head1 DESCRIPTION
+
+Sys::Guestfs::MetadataReader reads the metadata of a, possibly foreign,
+guest. It provides the DOM representation of an equivalent libvirt XML
+representation.
+
+Sys::Guestfs::MetadataReader is an interface to various backends, each of
+which implement a consistent API. Sys::Guestfs::MetadataReader itself only
+implements methods to access backends.
+
+=head1 METHODS
+
+=item instantiate(name)
+
+Instantiate a backend instance with the given name.
+
+=cut
+
+sub instantiate
+{
+    my $class = shift;
+
+    # Get the name of the module we're going to instantiate
+    my $name = shift;
+    defined($name) or carp("instantiate called without name argument");
+
+    # Get command line options for the module
+    my $options = shift;
+    defined($options) or carp("instantiate called without options argument");
+
+    my $instance;
+    foreach my $module ($class->modules()) {
+        return $module->new($options) if($module->get_name() eq $name);
+    }
+
+    return undef;
+}
+
+=item get_options(name)
+
+Return a hashref containing module_name => (module options).
+
+=cut
+
+sub get_options
+{
+    my $class = shift;
+
+    my %options;
+    foreach my $module ($class->modules()) {
+        $options{$module->get_name()} = [ $module->get_options() ];
+    }
+
+    return \%options;
+}
+
+1;
+
+=head1 BACKEND INTERFACE
+
+=item new()
+
+Instantiate an instance of the backend
+
+=item get_name()
+
+Return the module's name.
+
+=item get_options()
+
+Return a list of command line options in the correct format for GetOptions. This
+list will be added to those of other modules and the main program.
+
+=item is_configured()
+
+Return 1 if the module has been suffiently configured to proceed.
+Return 0 and display an error message otherwise.
+
+=item handle_arguments(@arguments)
+
+A backend may take any number of arguments describing where its data is located.
+
+=item get_dom
+
+Returns an XML::DOM::Document describing a libvirt configuration equivalent to
+the input.
+
+Returns undef and displays an error if there was an error
+
+=head1 COPYRIGHT
+
+Copyright (C) 2009 Red Hat Inc.
+
+=head1 LICENSE
+
+Please see the file COPYING.LIB for the full license.
+
+=head1 SEE ALSO
+
+L<virt-inspector(1)>,
+L<Sys::Guestfs(3)>,
+L<guestfs(3)>,
+L<http://libguestfs.org/>,
+L<Sys::Virt(3)>,
+L<http://libvirt.org/>,
+L<guestfish(1)>.
+
+=cut
diff --git a/perl/lib/Sys/Guestfs/MetadataReader/LibVirtXML.pm b/perl/lib/Sys/Guestfs/MetadataReader/LibVirtXML.pm
new file mode 100644
index 0000000..f180443
--- /dev/null
+++ b/perl/lib/Sys/Guestfs/MetadataReader/LibVirtXML.pm
@@ -0,0 +1,150 @@
+# Sys::Guestfs::MetadataReader::LibVirtXML
+# Copyright (C) 2009 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::Guestfs::MetadataReader::LibVirtXML;
+
+use strict;
+use warnings;
+
+use XML::DOM;
+use XML::DOM::XPath;
+
+=pod
+
+=head1 NAME
+
+Sys::Guestfs::MetadataReader::LibVirtXML - Read libvirt XML from a file
+
+=head1 SYNOPSIS
+
+ use Sys::Guestfs::MetadataReader;
+
+ $reader = Sys::Guestfs::MetadataReader->get_instance("libvirtxml);
+ $dom = $reader->get_dom();
+
+=head1 DESCRIPTION
+
+Sys::Guestfs::MetadataReader::LibVirtXML is a backend for
+Sys::Guestfs::MetadataReader which reads libvirt XML guest descriptions from a
+file.
+
+See L<Sys::Guestfs::MetadataReader> for a description of its exported
+methods.
+
+=cut
+
+use constant NAME => "libvirtxml";
+
+sub new
+{
+    my $class = shift;
+
+    my $options = shift;
+    carp("new called without options") unless(defined($options));
+
+    my $self = $options;
+    bless($self, $class);
+
+    return $self;
+}
+
+sub get_name
+{
+    my $class = shift;
+
+    return NAME;
+}
+
+sub get_options
+{
+    my $class = shift;
+
+    return ();
+}
+
+sub is_configured
+{
+    my $self = shift;
+
+    if(!defined($self->{path})) {
+        print STDERR "You must specify a filename when using ".NAME.".\n";
+        return 0;
+    }
+
+    return 1;
+}
+
+sub handle_arguments
+{
+    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 "Warning: ".NAME." only takes a single filename.\n";
+    }
+}
+
+sub get_dom
+{
+    my $self = shift;
+
+    # Open the input file
+    my $xml; # Implicitly closed on function exit
+    if(!open($xml, '<', $self->{path})) {
+        print STDERR "Failed to open ".$self->{path}.": $!\n";
+        return undef;
+    }
+
+    # Parse the input file
+    my $parser = new XML::DOM::Parser;
+    my $dom;
+    eval { $dom = $parser->parse ($xml); };
+
+    # Display any parse errors
+    if ($@) {
+        print STDERR "Unable to parse ".$self->{path}.": $ \n";
+        return undef;
+    }
+
+    return $dom;
+}
+
+1;
+
+=head1 COPYRIGHT
+
+Copyright (C) 2009 Red Hat Inc.
+
+=head1 LICENSE
+
+Please see the file COPYING.LIB for the full license.
+
+=head1 SEE ALSO
+
+L<Sys::Guestfs::MetadataReader(3)>,
+L<virt-inspector(1)>,
+L<Sys::Guestfs(3)>,
+L<guestfs(3)>,
+L<http://libguestfs.org/>,
+L<Sys::Virt(3)>,
+L<http://libvirt.org/>,
+L<guestfish(1)>.
+
+=cut
diff --git a/perl/lib/Sys/Guestfs/Storage.pm b/perl/lib/Sys/Guestfs/Storage.pm
new file mode 100644
index 0000000..65addbd
--- /dev/null
+++ b/perl/lib/Sys/Guestfs/Storage.pm
@@ -0,0 +1,143 @@
+# Sys::Guestfs::Storage
+# Copyright (C) 2009 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::Guestfs::Storage;
+
+use strict;
+use warnings;
+
+use Module::Pluggable sub_name => 'modules',
+                      search_path => ['Sys::Guestfs::Storage'],
+                      require => 1;
+
+=pod
+
+=head1 NAME
+
+Sys::Guestfs::Storage - Manipulate a guest's storage during V2V migration
+
+=head1 SYNOPSIS
+
+ use Sys::Guestfs::Storage;
+
+ $storage = Sys::Guestfs::Storage->get_instance("snapshot");
+ $storage->update_guest($dom);
+
+=head1 DESCRIPTION
+
+Sys::Guestfs::Storage changes a guest's underlying storage underlying storage
+during a V2V migration.
+
+Sys::Guestfs::MetadataReader is an interface to various backends, each of
+which implement a consistent API. Sys::Guestfs::MetadataReader itself only
+implements methods to access backends.
+
+=head1 METHODS
+
+=item instantiate(name)
+
+Instantiate a backend instance with the given name.
+
+=cut
+
+sub instantiate
+{
+    my $class = shift;
+
+    # Get the name of the module we're going to instantiate
+    my $name = shift;
+    defined($name) or carp("instantiate called without name argument");
+
+    # Get the options for the module
+    my $options = shift;
+    defined($options) or carp("instantiate called without options argument");
+
+    my $instance;
+    foreach my $module ($class->modules()) {
+        return $module->new($options) if($module->get_name() eq $name);
+    }
+
+    return undef;
+}
+
+=item get_options()
+
+Return a hashref containing module_name => (module options).
+
+=cut
+
+sub get_options
+{
+    my $class = shift;
+
+    my %options;
+    foreach my $module ($class->modules()) {
+        $options{$module->get_name()} = [ $module->get_options() ];
+    }
+
+    return \%options;
+}
+
+1;
+
+=head1 BACKEND INTERFACE
+
+=item new()
+
+Instantiate an instance of the backend
+
+=item get_name()
+
+Return the module's name.
+
+=item get_options()
+
+Return a list of command line options in the correct format for GetOptions. This
+list will be added to those of other modules and the main program.
+
+=item is_configured()
+
+Return 1 if the module has been suffiently configured to proceed.
+Return 0 and display an error message otherwise.
+
+=item update_guest(dom)
+
+dom is an XML::DOM::Document object describing a libvirt configuration.
+update_guest finds the storage defined in the guest, creates new storage for it
+and updates the guest DOM accordingly.
+
+Returns 1 on success or 0 on error.
+
+=head1 COPYRIGHT
+
+Copyright (C) 2009 Red Hat Inc.
+
+=head1 LICENSE
+
+Please see the file COPYING.LIB for the full license.
+
+=head1 SEE ALSO
+
+L<virt-inspector(1)>,
+L<Sys::Guestfs(3)>,
+L<guestfs(3)>,
+L<http://libguestfs.org/>,
+L<Sys::Virt(3)>,
+L<http://libvirt.org/>,
+L<guestfish(1)>.
+
+=cut
diff --git a/perl/lib/Sys/Guestfs/Storage/QCOW2.pm b/perl/lib/Sys/Guestfs/Storage/QCOW2.pm
new file mode 100644
index 0000000..30e08ce
--- /dev/null
+++ b/perl/lib/Sys/Guestfs/Storage/QCOW2.pm
@@ -0,0 +1,180 @@
+# Sys::Guestfs::Storage::QCOW2
+# Copyright (C) 2009 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::Guestfs::Storage::QCOW2;
+
+use strict;
+use warnings;
+
+use File::Temp qw(:mktemp);
+use Locale::TextDomain 'libguestfs';
+
+use XML::DOM;
+use XML::DOM::XPath;
+
+=pod
+
+=head1 NAME
+
+Sys::Guestfs::Storage::QCOW2 - Create QCOW2 images for guest storage
+
+=head1 SYNOPSIS
+
+ use Sys::Guestfs::Storage;
+
+ $storage = Sys::Guestfs::Storage->get_instance("qcow2");
+ $storage->update_guest($dom);
+
+=head1 DESCRIPTION
+
+Sys::Guestfs::Storage::QCOW2 is a backend for Sys::Guestfs::Storage. See
+L<Sys::Guestfs::Storage> for a description of its exported methods.
+
+=cut
+
+use constant NAME => "qcow2";
+
+sub new
+{
+    my $class = shift;
+
+    my $options = shift;
+
+    my $self = $options;
+    bless ($self, $class);
+
+    # Configuration defaults
+    $self->{storagedir} = "/var/tmp" if(!defined($self->{storagedir}));
+
+    return $self;
+}
+
+sub get_name
+{
+    my $class = shift;
+
+    return NAME;
+}
+
+sub get_options
+{
+    my $class = shift;
+
+    return (["storagedir=s", "storagedir",
+            "The directory were qcow2 images will be written"]);
+}
+
+sub is_configured
+{
+    my $self = shift;
+
+    return 1;
+}
+
+# Create new qcow2 storage for a guest, and update the guest to use the new
+# storage
+sub update_guest
+{
+    my $self = shift;
+    my $dom = shift;
+
+    # First, get a list of existing storage
+    my @sources = $dom->findnodes('/domain/devices/disk/source');
+
+    foreach my $source (@sources) {
+        my $attributes = $source->getAttributes();
+
+        # Look for the source location
+        my $path;
+        foreach my $attr qw(dev file) {
+            my $item = $attributes->getNamedItem($attr);
+            if(defined($item)) {
+                $path = $item->getValue();
+
+                # Remove the attribute. We'll add a new one in below.
+                $attributes->removeNamedItem($attr);
+            }
+        }
+
+        # Warn and ignore this source if we didn't find either
+        if(!defined($path)) {
+            print STDERR "qcow2: invalid source: ".$source->toString()."\n";
+            next;
+        }
+
+        # XXX: Do something intelligent if it's already a qcow2 image
+
+        # Create a qcow2 image for the underlying storage
+        my $qcow2_path = $self->create_qcow2($path);
+
+        # Update the source to be a "file" with the new path
+        $source->setAttribute("file", $qcow2_path);
+
+        # Remove the driver element which is a sibling of source because it
+        # might specify a physical device
+        # XXX: Do we need to store the old value for any reason?
+
+        foreach my $driver ($source->findnodes('../driver')) {
+            $driver->getParent()->removeChild($driver);
+        }
+    }
+
+    return 1;
+}
+
+# Create a qcow2 image for <source> in the storagedir directory
+# Return the path of the newly created qcow2, or undef if there was a problem
+# XXX: This should use a libvirt storage pool
+sub create_qcow2
+{
+    my $self = shift;
+    my $source = shift;
+
+    my $qcow2 = mktemp($self->{storagedir}."/qcow2.XXXXXX");
+
+    system("qemu-img create -b $source -f qcow2 $qcow2");
+
+    if(0 != $?) {
+        print STDERR __"QCOW2: Failed to create qcow2 image"."\n";
+        return undef;
+    }
+
+    return $qcow2;
+}
+
+1;
+
+=head1 COPYRIGHT
+
+Copyright (C) 2009 Red Hat Inc.
+
+=head1 LICENSE
+
+Please see the file COPYING.LIB for the full license.
+
+=head1 SEE ALSO
+
+L<Sys::Guestfs::MetadataReader(3)>,
+L<virt-inspector(1)>,
+L<Sys::Guestfs(3)>,
+L<guestfs(3)>,
+L<http://libguestfs.org/>,
+L<Sys::Virt(3)>,
+L<http://libvirt.org/>,
+L<guestfish(1)>.
+
+=cut
diff --git a/po/POTFILES.in b/po/POTFILES.in
index ca01b3d..694a831 100644
--- a/po/POTFILES.in
+++ b/po/POTFILES.in
@@ -67,8 +67,18 @@ ocaml/guestfs_c_actions.c
 ocaml/guestfs_c.c
 perl/bindtests.pl
 perl/Guestfs.c
+perl/lib/Sys/Guestfs/GuestOS.pm
+perl/lib/Sys/Guestfs/GuestOS/RedHat.pm
+perl/lib/Sys/Guestfs/HVSource.pm
+perl/lib/Sys/Guestfs/HVSource/Xen/Linux.pm
+perl/lib/Sys/Guestfs/HVTarget/Linux.pm
+perl/lib/Sys/Guestfs/HVTarget.pm
 perl/lib/Sys/Guestfs/Lib.pm
+perl/lib/Sys/Guestfs/MetadataReader/LibVirtXML.pm
+perl/lib/Sys/Guestfs/MetadataReader.pm
 perl/lib/Sys/Guestfs.pm
+perl/lib/Sys/Guestfs/Storage.pm
+perl/lib/Sys/Guestfs/Storage/QCOW2.pm
 python/guestfs-py.c
 ruby/ext/guestfs/_guestfs.c
 src/guestfs-actions.c
diff --git a/v2v/STATUS b/v2v/STATUS
new file mode 100644
index 0000000..769986c
--- /dev/null
+++ b/v2v/STATUS
@@ -0,0 +1,56 @@
+What (hopefully) works
+----------------------
+
+Read a guest description from a libvirt xml file.
+
+Automatic snapshot creation and corresponding guest metadata rewrite.
+
+Detection of virtio capable kernel.
+  Installation of new kernel if appropriate
+  Rebuild of mkinitrd
+
+Configuration of virtio drivers.
+
+Example command-line:
+
+./v2v/run-v2v-locally --with rhel.5.i386.kernel=/home/mbooth/kernel-2.6.18-128.1.14.el5.i686.rpm /media/passport/RHEL52PV32-20090213.xml foo
+
+Required features not yet implemented
+-------------------------------------
+
+Completion of metadata rewrite
+  Xen specific metadata is identified, but not changed
+  Rewrite of storage metadata to use virtio
+
+Remap drive names in a guest
+  This is mostly done, just needs to be stuck into HVTarget::Linux somewhere
+
+Automatic configuration of a new guest via libvirt
+
+Get guest metadata direct from libvirt (libvirt MetadataReader)
+
+Network/Bridge mapping for libvirtxml reader
+
+POD everywhere
+
+Windows support
+
+Important features not yet implemented
+--------------------------------------
+
+Commit snapshot storage to original image
+
+Online help for module specific options
+
+Roadmap features
+----------------
+
+Snapshot storage module should use libvirt APIs
+
+In-place storage module
+
+Data copy storage module
+
+OVF metadata reader
+
+VMWare HVSource
diff --git a/v2v/virt-v2v.pl b/v2v/virt-v2v.pl
index fb1f220..1fc17e9 100755
--- a/v2v/virt-v2v.pl
+++ b/v2v/virt-v2v.pl
@@ -1,4 +1,4 @@
-#!/usr/bin/perl -w
+#!/usr/bin/perl
 # virt-v2v
 # Copyright (C) 2009 Red Hat Inc.
 #
@@ -28,8 +28,14 @@ use Getopt::Long;
 use Data::Dumper;
 use File::Temp qw/tempdir/;
 use XML::Writer;
+use File::Spec;
 use Locale::TextDomain 'libguestfs';
 
+use Sys::Guestfs::MetadataReader;
+use Sys::Guestfs::Storage;
+use Sys::Guestfs::GuestOS;
+use Sys::Guestfs::HVTarget;
+
 =encoding utf8
 
 =head1 NAME
@@ -159,10 +165,47 @@ Set the output guest name.
 
 =cut
 
+# A hash of module_name => { module_options }
+my %module_options;
+
+# A list of additional arguments to Getopt
+my @getopt_options;
+
+# Get module specific options
+# TODO: Use the option descriptions in the online help somehow
+foreach my $module qw(Sys::Guestfs::MetadataReader Sys::Guestfs::Storage) {
+    my $options = $module->get_options();
+
+    foreach my $name (keys(%$options)) {
+        my $options = $options->{$name};
+        $module_options{$name} = {};
+
+        foreach my $option (@$options) {
+            my $getopt = $option->[0];
+            my $switch = $option->[1];
+            my $description = $option->[2];
+
+            push(@getopt_options,
+                 $getopt => \$module_options{$name}->{$switch});
+        }
+    }
+}
+
+# Option defaults
+my $format_opt = "libvirtxml"; # Metadata format
+my $storage_opt = "qcow2"; # storage modifier
+
+# Files which may to be installed in a guest during migration
+my %files = ();
+
 GetOptions ("help|?" => \$help,
 	    "version" => \$version,
 	    "connect|c=s" => \$uri,
 	    "output|o=s" => \$output,
+            "format|f=s" => \$format_opt,
+            "storage|s=s" => \$storage_opt,
+            "with-file=s" => \%files,
+            @getopt_options
     ) or pod2usage (2);
 pod2usage (1) if $help;
 if ($version) {
@@ -173,70 +216,167 @@ if ($version) {
 }
 pod2usage (__"virt-v2v: no image or VM names given") if @ARGV == 0;
 
-# XXX This should be an option.  Disable for now until we get
-# downloads working reliably.
-my $use_windows_registry = 0;
+# Get an appropriate MetadataReader
+my $mdr = Sys::Guestfs::MetadataReader->instantiate($format_opt,
+                                                  $module_options{$format_opt});
+if(!defined($mdr)) {
+    print STDERR __x("virt-v2v: {format} is not a valid metadata format",
+                     format => $format_opt)."\n";
+    exit 1;
+}
 
-my @params = (\ ARGV);
-if ($uri) {
-    push @params, address => $uri;
+my $storage = Sys::Guestfs::Storage->instantiate($storage_opt,
+                                                 $module_options{$storage_opt});
+if(!defined($storage)) {
+    print STDERR __x("{virt-v2v: storage} is not a valid storage option\n",
+                     storage => $storage)."\n";
+    exit 1;
 }
-my ($g, $conn, $dom) = open_guest (@params);
 
-$g->launch ();
-$g->wait_ready ();
+# The name of the target guest is the last command line argument
+my $target_name = pop;
 
-# List of possible filesystems.
-my @partitions = get_partitions ($g);
+$mdr->handle_arguments(@ARGV);
 
-# Now query each one to build up a picture of what's in it.
-my %fses =
-    inspect_all_partitions ($g, \ partitions,
-			    use_windows_registry => $use_windows_registry);
+# Check all modules are properly initialised
+my $ready = 1;
+foreach my $module ($mdr, $storage) {
+    $ready = 0 if(!$module->is_configured());
+}
+exit 1 if(!$ready);
+
+# Create a squashfs filesystem containing all files given on the command line
+my $transferfs;
+if(values(%files) > 0) {
+    $transferfs = File::Temp->new(UNLINK => 1, SUFFIX => '.sqsh');
+
+    # mksquashfs complains if the file already exists. We unlink it here. UNLINK
+    # specified above will ensure that the file mksquashfs creates will be
+    # automatically unlinked when the program exits.
+    unlink("$transferfs");
+
+    system("mksquashfs ".join(' ', values(%files))." $transferfs");
+    if($? != 0) {
+        print STDERR "Failed to create squashfs for file transfer\n";
+        exit(1);
+    }
+
+    # As transfer directory hierarchy is flat, remove all directory components
+    # from paths
+    foreach my $key (keys(%files)) {
+        my (undef, undef, $filename) = File::Spec->splitpath($files{$key});
+        $files{$key} = $filename;
+    }
+}
+
+###############################################################################
+## Start of processing
+
+# Get a libvirt configuration for the guest
+my $dom = $mdr->get_dom();
+
+# Modify the storage in the guest according to configured options
+$storage->update_guest($dom);
 
-#print "fses -----------\n";
-#print Dumper(\%fses);
+# Get a list of the guest's storage devices
+my @devices = get_guest_devices($dom);
 
-my $oses = inspect_operating_systems ($g, \%fses);
+# Open a libguestfs handle on the guest's devices
+my $g = get_guestfs_handle(@devices);
 
-#print "oses -----------\n";
-#print Dumper($oses);
+# Inspect the guest
+my $os = inspect_guest($g);
 
-# Only work on single-root operating systems.
-my $root_dev;
-my @roots = keys %$oses;
-die __"no root device found in this operating system image" if @roots == 0;
-die __"multiboot operating systems are not supported by v2v" if @roots > 1;
-$root_dev = $roots[0];
+# Instantiate a GuestOS instance to manipulate the guest
+my $guestos = Sys::Guestfs::GuestOS->instantiate($g, $os, \%files);
 
-# Mount up the disks and check for applications.
+# Modify the guest and its metadata for the target hypervisor
+Sys::Guestfs::HVTarget->configure($guestos, $dom, $os);
 
-my $os = $oses->{$root_dev};
-mount_operating_system ($g, $os);
-inspect_in_detail ($g, $os);
-$g->umount_all ();
+print $dom->toString();
 
+$g->umount_all();
+$g->sync();
 
+sub get_guestfs_handle
+{
+    my @params = \ _; # Initialise parameters with list of devices
 
+    if ($uri) {
+        push @params, address => $uri;
+    }
 
+    my $g = open_guest(@params, rw => 1);
 
+    # If we defined a transfer filesystem, present it as the final device
+    $g->add_drive_ro($transferfs) if(defined($transferfs));
 
+    $g->launch ();
+    $g->wait_ready ();
 
+    return $g;
+}
+
+# Inspect the guest's storage. Returns an OS hashref as returned by
+# inspect_in_detail.
+sub inspect_guest
+{
+    my $g = shift;
 
+    my $use_windows_registry;
 
+    # List of possible filesystems.
+    my @partitions = get_partitions ($g);
 
+    # Now query each one to build up a picture of what's in it.
+    my %fses =
+        inspect_all_partitions ($g, \ partitions,
+    			    use_windows_registry => $use_windows_registry);
 
+    #print "fses -----------\n";
+    #print Dumper(\%fses);
 
+    my $oses = inspect_operating_systems ($g, \%fses);
 
+    #print "oses -----------\n";
+    #print Dumper($oses);
 
+    # Only work on single-root operating systems.
+    my $root_dev;
+    my @roots = keys %$oses;
+    die __"no root device found in this operating system image" if @roots == 0;
+    die __"multiboot operating systems are not supported by v2v" if @roots > 1;
+    $root_dev = $roots[0];
 
+    # Mount up the disks and check for applications.
 
+    my $os = $oses->{$root_dev};
+    mount_operating_system ($g, $os, 0);
+    inspect_in_detail ($g, $os);
 
+    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 SEE ALSO
 
-- 
1.6.2.5


[Date Prev][Date Next]   [Thread Prev][Thread Next]   [Thread Index] [Date Index] [Author Index]