[Libguestfs] [PATCH] Initial drop of virt-v2v
Matthew Booth
mbooth at redhat.com
Fri Jul 24 21:34:21 UTC 2009
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
More information about the Libguestfs
mailing list