[PATCH 0/2] Deprecate zfile
by Richard W.M. Jones
OK let's restart this whole architecture thing.
Firstly two patches which pass the '-z' parameter to 'file' so it
looks inside compressed files. (Thanks to Matt for finding this
not-so-obscure option).
This means the 'zfile' command is now obsolete.
Rich.
--
Richard Jones, Emerging Technologies, Red Hat http://et.redhat.com/~rjones
virt-p2v converts physical machines to virtual machines. Boot with a
live CD or over the network (PXE) and turn machines into Xen guests.
http://et.redhat.com/~rjones/virt-p2v
14 years, 9 months
[PATCH] guestfs_file_arch command
by Richard W.M. Jones
This patch adds a new function, guestfs_file_arch, which is like
guestfs_file but specifically intended to determine the architecture
of binaries and libraries.
Usage is:
guestfs_file_arch (g, "/bin/ls")
==> "x86_64" (or whatever)
What it can do:
- ELF binaries
- ELF shared libraries
- Windows Win32 and Win64 binaries
- Windows Win32 and Win64 DLLs
- Linux kernel modules
- Linux new-style initrd images
- some non-x86 Linux vmlinuz kernels
What it can't do:
- static libraries (libfoo.a)
- Linux old-style initrd as compressed ext2 filesystem (RHEL 3)
- x86 Linux vmlinuz kernels
- ancient stuff like a.out, COFF binaries
It turns out that x86 vmlinuz (ie. bzImage) is virtually impossible to
unpack. It consists of an amalgam of 16 bit code, 32 bit code (even
on x86-64) and compressed kernel. The only way to unpack it would be
to either uncompress the compressed kernel, or else reverse the (32
bit) CPU detection code. Neither is very realistic, but I left in
some commented-out code to show you how far I got.
An easy LKML patch for someone would be to add the required
architecture into the setup header so we can just read it out
directly, or maybe someone else can see something I've missed.
Initrd unpacking is relatively simple. We unpack the initrd and look
for some known binaries inside it. This seems to work OK on all the
new-style initrds I tested it against.
Finally, in order to run the tests we need binaries from lots of
different architectures. Obviously building these is difficult, as it
would require a cross-compiler. So instead I've proposed we just add
them into the images/ directory. These come "without source", but the
source is just:
main(){}
for the binaries, and (literally) the empty file for the libraries.
Hope that doesn't annoy any purists.
Rich.
--
Richard Jones, Emerging Technologies, Red Hat http://et.redhat.com/~rjones
virt-p2v converts physical machines to virtual machines. Boot with a
live CD or over the network (PXE) and turn machines into Xen guests.
http://et.redhat.com/~rjones/virt-p2v
14 years, 10 months
[PATCH] Replace shell_quote function with %Q and %R printf specifiers.
by Richard W.M. Jones
At the moment the daemon code contains an incredibly hairy function
called shell_quote for safely quoting strings passed to the shell.
The patch replaces that with a glibc custom printf format (actually
two, but very closely related), %Q and %R.
%Q is like %s but it safely shell quotes the string.
%R is like %Q but it prefixes the path with /sysroot.
Example usage (w/o error checks):
asprintf (&cmd, "zcat %R | tar xvf -", path);
==> "zcat /sysroot/path\ with\ spaces | tar xvf -"
Rich.
[One of the nice things about OCaml is this sort of safe shell quoting
is built in to the stdlib functions].
--
Richard Jones, Emerging Technologies, Red Hat http://et.redhat.com/~rjones
Read my programming blog: http://rwmj.wordpress.com
Fedora now supports 75 OCaml packages (the OPEN alternative to F#)
http://cocan.org/getting_started_with_ocaml_on_red_hat_and_fedora
14 years, 10 months
[PATCH] Initial drop of virt-v2v
by Matthew Booth
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
14 years, 10 months
virt-v2v
by Matthew Booth
I've attached v2v/STATUS. There's still a bit to do. I'm not yet
proposing this for inclusion, just discussion.
Apart from the tool itself, I think there's mileage in considering how
the functionality of Sys::Guestfs::Lib could be given more structure. I
think there's considerable mileage in moving much of Sys::Guestfs::Lib
into Sys::Guestfs::GuestOS.
I haven't tried to code anything for Debian in what's here. However, the
intention is that a Sys::Guestfs::GuestOS::Debian module would implement
this. Much of the functionality in Sys::Guestfs::GuestOS::RedHat should
be common with Debian, so I'd expect common code to be stripped out of
it, maybe into Sys::Guestfs::GuestOS::Linux.
The best way to read the code is to start from 'Start of processing' in
virt-v2v.pl. Everything above that is trivia to do with command line
parsing. The main body is only a single page, and shows what order
things are called into, and how they fit together.
Matt
--
Matthew Booth, RHCA, RHCSS
Red Hat Engineering, Virtualisation Team
M: +44 (0)7977 267231
GPG ID: D33C3490
GPG FPR: 3733 612D 2D05 5458 8A8A 1600 3441 EA19 D33C 3490
14 years, 10 months
ANNOUNCE: libguestfs 1.0.64 released
by Richard W.M. Jones
I'm pleased to announce the release of libguestfs 1.0.64, the library
for accessing and modifying virtual machine disk images.
Homepage: http://libguestfs.org/
Downloads: http://libguestfs.org/download/
Git repo: http://git.et.redhat.com/?p=libguestfs.git
Fedora builds: http://koji.fedoraproject.org/koji/packageinfo?packageID=8391
NOTE at present there is a bug in qemu's vmchannel which stops
libguestfs from working correctly with the very latest qemu from git.
Use a stable 0.10.X version, or apply this patch:
http://lists.gnu.org/archive/html/qemu-devel/2009-07/msg01753.html
(These release notes include changes since the previous announcement,
which was for 1.0.59)
* New tool: virt-cat. This tool lets you copy out files from a
guest. See this page for some interesting and unexpected uses:
http://libguestfs.org/virt-cat.1.html#examples
* Added libguestfs-test-tool which is a tool you can use to
diagnose qemu / kernel booting problems, and also make bug
reports more useful.
* [Sys::Guestfs::Lib] split $os->{version} into $os->{major_version}
and $os->{minor_version}. Add feature tags. (Matt Booth).
* Allow TMPDIR to be used to override the location of temporary files.
* Implement the guestfs_read_file call.
* New calls guestfs_mkmountpoint and guestfs_rmmountpoint to allow
some specialized read-only or nested filesystems to be mounted,
particularly for examining live CDs.
http://rwmj.wordpress.com/2009/07/15/unpack-the-russian-doll-of-a-f11-liv...
* New call guestfs_mountpoints to return a hash of device -> mountpoint.
* Many documentation fixes, including an "API Overview" section
which will help developers navigate parts of the now very large
libguestfs API.
http://libguestfs.org/guestfs.3.html#api_overview
* Add ~ and ~username expansion in guestfish (RHBZ#511372).
* Add kernel modules for reading DOS filesystems (Guido Gunther).
* Add i18n support for Perl strings.
Bugs fixed:
* Fix guestfish -i / virt-inspector when working with libvirt domain
names, so now 'guestfish -i libvirtdom' really works.
* Detect renamed guestfwd support for vmchannel in upstream qemu.
* Always pass noapic on kernel command line (workaround for RHBZ#502058)
* Workaround for udev timeouts.
* Check /usr/libexec for qemu binary, for RHEL 5.4.
* Multiple fixes for non-srcdir builds.
Rich.
--
Richard Jones, Emerging Technologies, Red Hat http://et.redhat.com/~rjones
virt-top is 'top' for virtual machines. Tiny program with many
powerful monitoring features, net stats, disk stats, logging, etc.
http://et.redhat.com/~rjones/virt-top
14 years, 10 months
Pseudo code for v2v
by Matthew Booth
I've attached my initial thoughts on the design for the v2v tool.
--
Matthew Booth, RHCA, RHCSS
Red Hat Engineering, Virtualisation Team
M: +44 (0)7977 267231
GPG ID: D33C3490
GPG FPR: 3733 612D 2D05 5458 8A8A 1600 3441 EA19 D33C 3490
14 years, 10 months