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

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