[Libguestfs] [PATCH v2v for discussion only] Remove dependency on old Perl inspection code.
Richard W.M. Jones
rjones at redhat.com
Wed Mar 23 19:02:19 UTC 2011
It needs a lot more testing, which I'm (slowly) performing on
my own machine.
Note this also depends on the new guestfs_inspect_get_product_variant
API that I posted earlier today.
Rich.
--
Richard Jones, Virtualization Group, Red Hat http://people.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
-------------- next part --------------
>From a85d7b24f292a43e63e43a393a8d326bce2ab931 Mon Sep 17 00:00:00 2001
From: Richard W.M. Jones <rjones at redhat.com>
Date: Wed, 23 Mar 2011 11:05:26 +0000
Subject: [PATCH] Remove dependency on old Perl inspection code.
We now use the new C "core" inspection API in libguestfs.
Some of the detailed inspection code from Sys::Guestfs::Lib has been
copied into virt-v2v.
---
lib/Sys/VirtConvert/Connection/RHEVTarget.pm | 59 ++++----
lib/Sys/VirtConvert/Converter.pm | 3 +-
lib/Sys/VirtConvert/Converter/RedHat.pm | 205 +++++++++++++++++++++++++-
lib/Sys/VirtConvert/Converter/Windows.pm | 2 +-
v2v/virt-v2v.pl | 87 +++++++----
5 files changed, 286 insertions(+), 70 deletions(-)
diff --git a/lib/Sys/VirtConvert/Connection/RHEVTarget.pm b/lib/Sys/VirtConvert/Connection/RHEVTarget.pm
index 3441620..db18136 100644
--- a/lib/Sys/VirtConvert/Connection/RHEVTarget.pm
+++ b/lib/Sys/VirtConvert/Connection/RHEVTarget.pm
@@ -757,41 +757,41 @@ EOF
#
# WindowsXP
# os = windows
-# root->os_major_version = 5
-# root->os_minor_version = 1
+# major_version = 5
+# minor_version = 1
#
# WindowsXP
# os = windows
-# root->os_major_version = 5
-# root->os_minor_version = 2
-# root->product_name = 'Microsoft Windows XP'
+# major_version = 5
+# minor_version = 2
+# product_name = 'Microsoft Windows XP'
#
# Windows2003
# Windows2003x64
# os = windows
-# root->os_major_version = 5
-# root->os_minor_version = 2
+# major_version = 5
+# minor_version = 2
# N.B. This also matches Windows 2003 R2, which there's no option for
#
# Windows2008
# Windows2008x64
# os = windows
-# root->os_major_version = 6
-# root->os_minor_version = 0
+# major_version = 6
+# minor_version = 0
# N.B. This also matches Vista, which there's no option for
#
# Windows7
# Windows7x64
# os = windows
-# root->os_major_version = 6
-# root->os_minor_version = 1
-# root->windows_installation_type = 'Client'
+# major_version = 6
+# minor_version = 1
+# product_variant = 'Client'
#
# Windows2008R2x64
# os = windows
-# root->os_major_version = 6
-# root->os_minor_version = 1
-# root->windows_installation_type != 'Client'
+# major_version = 6
+# minor_version = 1
+# product_variant != 'Client'
#
# Unassigned
# None of the above
@@ -803,23 +803,20 @@ sub _get_os_type
{
my ($desc) = @_;
- my $root = $desc->{root};
- die ("No root device: ".Dumper($desc)) unless defined($root);
-
my $arch_suffix = '';
- if ($root->{arch} eq 'x86_64') {
+ if ($desc->{arch} eq 'x86_64') {
$arch_suffix = 'x64';
- } elsif ($root->{arch} ne 'i386') {
+ } elsif ($desc->{arch} ne 'i386') {
logmsg WARN, __x('Unsupported architecture: {arch}',
- arch => $root->{arch});
+ arch => $desc->{arch});
return undef;
}
my $type;
- $type = _get_os_type_linux($root, $arch_suffix)
+ $type = _get_os_type_linux($desc, $arch_suffix)
if ($desc->{os} eq 'linux');
- $type = _get_os_type_windows($root, $arch_suffix)
+ $type = _get_os_type_windows($desc, $arch_suffix)
if ($desc->{os} eq 'windows');
return 'Unassigned' if (!defined($type));
@@ -828,11 +825,11 @@ sub _get_os_type
sub _get_os_type_windows
{
- my ($root, $arch_suffix) = @_;
+ my ($desc, $arch_suffix) = @_;
- my $major = $root->{os_major_version};
- my $minor = $root->{os_minor_version};
- my $product = $root->{product_name};
+ my $major = $desc->{major_version};
+ my $minor = $desc->{minor_version};
+ my $product = $desc->{product_name};
if ($major == 5) {
if ($minor == 1 ||
@@ -853,7 +850,7 @@ sub _get_os_type_windows
}
if ($major == 6 && $minor == 1) {
- if ($root->{windows_installation_type} eq 'Client') {
+ if ($desc->{product_variant} eq 'Client') {
return "Windows7".$arch_suffix;
}
@@ -867,10 +864,10 @@ sub _get_os_type_windows
sub _get_os_type_linux
{
- my ($root, $arch_suffix) = @_;
+ my ($desc, $arch_suffix) = @_;
- my $distro = $root->{osdistro};
- my $major = $root->{os_major_version};
+ my $distro = $desc->{distro};
+ my $major = $desc->{major_version};
# XXX: RHEV 2.2 doesn't support a RHEL 6 target, however RHEV 2.3+ will.
# For the moment, we set RHEL 6 to be 'OtherLinux', however we will need to
diff --git a/lib/Sys/VirtConvert/Converter.pm b/lib/Sys/VirtConvert/Converter.pm
index 1bea3c9..8b98b8d 100644
--- a/lib/Sys/VirtConvert/Converter.pm
+++ b/lib/Sys/VirtConvert/Converter.pm
@@ -88,7 +88,7 @@ An initialised Sys::VirtConvert::Config object.
=item desc
-The OS description returned by Sys::Guestfs::Lib.
+The OS description (see virt-v2v.pl:inspect_guest).
=item dom
@@ -478,7 +478,6 @@ Please see the file COPYING.LIB for the full license.
=head1 SEE ALSO
L<Sys::VirtConvert::Converter::Linux(3pm)>,
-L<Sys::Guestfs::Lib(3pm)>,
L<Sys::Virt(3pm)>,
L<virt-v2v(1)>,
L<http://libguestfs.org/>.
diff --git a/lib/Sys/VirtConvert/Converter/RedHat.pm b/lib/Sys/VirtConvert/Converter/RedHat.pm
index 740e77b..2e6cba8 100644
--- a/lib/Sys/VirtConvert/Converter/RedHat.pm
+++ b/lib/Sys/VirtConvert/Converter/RedHat.pm
@@ -40,7 +40,7 @@ Sys::VirtConvert::Converter::RedHat - Convert a Red Hat based guest to run on KV
use Sys::VirtConvert::Converter;
- Sys::VirtConvert::Converter->convert($g, $meta, $os);
+ Sys::VirtConvert::Converter->convert($g, $meta, $desc);
=head1 DESCRIPTION
@@ -84,7 +84,7 @@ An initialised Sys::VirtConvert::Config
=item desc
-A description of the guest OS as returned by Sys::Guestfs::Lib.
+A description of the guest OS (see virt-v2v.pl:inspect_guest).
=item dom
@@ -112,6 +112,8 @@ sub convert
_init_selinux($g);
_init_augeas($g);
+ _init_modprobe_aliases($g, $desc);
+ _init_kernels($g, $desc);
my $modpath = _init_modpath($g);
# Un-configure HV specific attributes which don't require a direct
@@ -159,7 +161,6 @@ sub _init_augeas
# Initialise augeas
eval {
- $g->aug_close();
$g->aug_init("/", 1);
# Check if /boot/grub/menu.lst is included by the Grub lens
@@ -185,6 +186,51 @@ sub _init_augeas
augeas_error($g, $@) if ($@);
}
+# Find all modprobe aliases. Specifically, this looks in the following
+# locations:
+# * /etc/conf.modules
+# * /etc/modules.conf
+# * /etc/modprobe.conf
+# * /etc/modprobe.d/*
+#
+# This sets the $desc->{modprobe_aliases} field.
+
+sub _init_modprobe_aliases
+{
+ local $_;
+ my $g = shift;
+ my $desc = shift;
+
+ my %modprobe_aliases;
+
+ for my $pattern qw(/files/etc/conf.modules/alias
+ /files/etc/modules.conf/alias
+ /files/etc/modprobe.conf/alias
+ /files/etc/modprobe.d/*/alias) {
+ for my $path ( $g->aug_match($pattern) ) {
+ $path =~ m{^/files(.*)/alias(?:\[\d*\])?$}
+ or die __x("{path} doesn't match augeas pattern",
+ path => $path);
+ my $file = $1;
+
+ my $alias;
+ $alias = $g->aug_get($path);
+
+ my $modulename;
+ $modulename = $g->aug_get($path.'/modulename');
+
+ my %aliasinfo;
+ $aliasinfo{modulename} = $modulename;
+ $aliasinfo{augeas} = $path;
+ $aliasinfo{file} = $file;
+
+ $modprobe_aliases{$alias} = \%aliasinfo;
+ }
+ }
+
+ $desc->{modprobe_aliases} = \%modprobe_aliases;
+}
+
sub _init_modpath
{
my ($g) = @_;
@@ -531,6 +577,155 @@ sub _list_kernels
return @kernels;
}
+# Look for how boot (grub) and kernels are configured.
+#
+# The resulting information is stashed in $desc->{boot},
+# $desc->{kernels} and $desc->{initrd_modules}.
+
+sub _init_kernels
+{
+ my ($g, $desc) = @_;
+
+ if ($desc->{os} eq "linux") {
+ # Iterate over entries in grub.conf, populating $desc->{boot}
+ # For every kernel we find, inspect it and add to $desc->{kernels}
+
+ # All known past and present Red Hat-based distros mount a
+ # boot partition on /boot. We may have to revisit this if
+ # this assumption changes in future. (Old Perl inspection
+ # code used to try to detect this setting).
+ my $grub = "/boot";
+ my $grub_conf = "/etc/grub.conf";
+
+ my @boot_configs;
+
+ # We want
+ # $desc->{boot}
+ # ->{configs}
+ # ->[0]
+ # ->{title} = "Fedora (2.6.29.6-213.fc11.i686.PAE)"
+ # ->{kernel} = \kernel
+ # ->{cmdline} = "ro root=/dev/mapper/vg_mbooth-lv_root rhgb"
+ # ->{initrd} = \initrd
+ # ->{default} = \config
+ # ->{grub_fs} = "/boot"
+
+ my @configs = ();
+ # Get all configurations from grub
+ foreach my $bootable ($g->aug_match("/files/$grub_conf/title"))
+ {
+ my %config = ();
+ $config{title} = $g->aug_get($bootable);
+
+ my $grub_kernel;
+ eval { $grub_kernel = $g->aug_get("$bootable/kernel"); };
+ if($@) {
+ warn __x("Grub entry {title} has no kernel",
+ title => $config{title});
+ }
+
+ # Check we've got a kernel entry
+ if(defined($grub_kernel)) {
+ my $path = "$grub$grub_kernel";
+
+ # Reconstruct the kernel command line
+ my @args = ();
+ foreach my $arg ($g->aug_match("$bootable/kernel/*")) {
+ $arg =~ m{/kernel/([^/]*)$}
+ or die("Unexpected return from aug_match: $arg");
+
+ my $name = $1;
+ my $value;
+ eval { $value = $g->aug_get($arg); };
+
+ if(defined($value)) {
+ push(@args, "$name=$value");
+ } else {
+ push(@args, $name);
+ }
+ }
+ $config{cmdline} = join(' ', @args) if(scalar(@args) > 0);
+
+ my $kernel;
+ if ($g->exists($path)) {
+ $kernel = _inspect_linux_kernel($g, $path);
+ } else {
+ warn __x("grub refers to {path}, which doesn't exist\n",
+ path => $path);
+ }
+
+ # Check the kernel was recognised
+ if(defined($kernel)) {
+ # Put this kernel on the top level kernel list
+ $desc->{kernels} ||= [];
+ push(@{$desc->{kernels}}, $kernel);
+
+ $config{kernel} = $kernel;
+
+ # Look for an initrd entry
+ my $initrd;
+ eval {
+ $initrd = $g->aug_get("$bootable/initrd");
+ };
+
+ unless($@) {
+ $config{initrd} =
+ _inspect_initrd($g, $desc, "$grub$initrd",
+ $kernel->{version});
+ } else {
+ warn __x("Grub entry {title} does not specify an ".
+ "initrd", title => $config{title});
+ }
+ }
+ }
+
+ push(@configs, \%config);
+ }
+
+
+ # Create the top level boot entry
+ my %boot;
+ $boot{configs} = \@configs;
+ $boot{grub_fs} = $grub;
+
+ # Add the default configuration
+ eval {
+ $boot{default} = $g->aug_get("/files/$grub_conf/default");
+ };
+
+ $desc->{boot} = \%boot;
+ }
+}
+
+# Get a listing of device drivers from an initrd
+sub _inspect_initrd
+{
+ my ($g, $desc, $path, $version) = @_;
+
+ my @modules;
+
+ # Disregard old-style compressed ext2 files and only work with
+ # real compressed cpio files, since cpio takes ages to (fail to)
+ # process anything else.
+ if ($g->exists($path) && $g->file($path) =~ /cpio/) {
+ eval {
+ @modules = $g->initrd_list ($path);
+ };
+ unless ($@) {
+ @modules = grep { m{([^/]+)\.(?:ko|o)$} } @modules;
+ } else {
+ warn __x("{filename}: could not read initrd format",
+ filename => "$path");
+ }
+ }
+
+ # Add to the top level initrd_modules entry
+ $desc->{initrd_modules} ||= {};
+ $desc->{initrd_modules}->{$version} = \@modules;
+
+ return \@modules;
+}
+
# Use various methods to try to work out what Linux kernel we've got.
# Returns a hashref containing:
# path => path to kernel (same as $path variable passed in)
@@ -760,7 +955,7 @@ sub _unconfigure_xen
# Look for kmod-xenpv-*, which can be found on RHEL 3 machines
foreach my $app (@{$desc->{apps}}) {
- my $name = $app->{name};
+ my $name = $app->{app_name};
if($name =~ /^kmod-xenpv(-.*)?$/) {
_remove_application($name, $g);
@@ -820,7 +1015,7 @@ sub _unconfigure_vmware
# Uninstall VMwareTools
foreach my $app (@{$desc->{apps}}) {
- my $name = $app->{name};
+ my $name = $app->{app_name};
if ($name eq "VMwareTools") {
_remove_application($name, $g);
diff --git a/lib/Sys/VirtConvert/Converter/Windows.pm b/lib/Sys/VirtConvert/Converter/Windows.pm
index ca9bea7..72d826b 100644
--- a/lib/Sys/VirtConvert/Converter/Windows.pm
+++ b/lib/Sys/VirtConvert/Converter/Windows.pm
@@ -97,7 +97,7 @@ An initialised Sys::VirtConvert::Config object.
=item desc
-A description of the guest OS as returned by Sys::Guestfs::Lib.
+A description of the guest OS (see virt-v2v.pl:inspect_guest).
=item dom
diff --git a/v2v/virt-v2v.pl b/v2v/virt-v2v.pl
index 44764e1..75ba680 100755
--- a/v2v/virt-v2v.pl
+++ b/v2v/virt-v2v.pl
@@ -25,9 +25,6 @@ use Getopt::Long;
use Locale::TextDomain 'virt-v2v';
use Sys::Guestfs;
-use Sys::Guestfs::Lib qw(get_partitions inspect_all_partitions
- inspect_operating_systems mount_operating_system
- inspect_in_detail);
use Sys::VirtConvert;
use Sys::VirtConvert::Config;
@@ -403,7 +400,6 @@ if (defined($profile)) {
$output_method = $config->get_method();
- my $opts;
my $output_storage = $config->get_storage();
my $opts = $config->get_storage_opts();
@@ -496,15 +492,17 @@ $transferiso = $config->get_transfer_iso();
my $g = new Sys::VirtConvert::GuestfsHandle($storage, $transferiso,
$output_method eq 'rhev');
-my $os;
+my $root_dev;
my $guestcaps;
+my $desc;
eval {
# Inspect the guest
- $os = inspect_guest($g);
+ $desc = inspect_guest($g);
# Modify the guest and its metadata
- $guestcaps = Sys::VirtConvert::Converter->convert($g, $config, $os, $dom,
- $source->get_storage_devices());
+ $guestcaps =
+ Sys::VirtConvert::Converter->convert ($g, $config, $desc, $dom,
+ $source->get_storage_devices());
};
# If any of the above commands result in failure, we need to ensure that the
@@ -518,7 +516,7 @@ if ($@) {
$g->close();
-$target->create_guest($os, $dom, $guestcaps, $output_name);
+$target->create_guest($root_dev, $dom, $guestcaps, $output_name);
if($guestcaps->{block} eq 'virtio' && $guestcaps->{net} eq 'virtio') {
logmsg NOTICE, __x('{name} configured with virtio drivers.',
@@ -553,24 +551,18 @@ sub signal_exit
v2vdie __x('Received signal {sig}. Exiting.', sig => shift);
}
-# Inspect the guest's storage. Returns an OS hashref as returned by
-# inspect_in_detail.
+# Perform guest inspection using the libguestfs core inspection API.
+# Returns a hashref ("$desc") which contains the main features from
+# inspection.
sub inspect_guest
{
my $g = shift;
- # 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);
-
- my $oses = inspect_operating_systems ($g, \%fses);
-
# Get list of roots, sorted.
+ my @roots = $g->inspect_os ();
+ @roots = sort @roots;
+
my $root_dev;
- my @roots = sort (keys %$oses);
if(@roots == 0) {
v2vdie __('No root device found in this operating system image.');
@@ -588,8 +580,9 @@ sub inspect_guest
my $i = 1;
foreach (@roots) {
print " [$i] $_";
- print " (", $oses->{$_}->{product_name}, ")"
- if exists $oses->{$_}->{product_name};
+ my $prod;
+ eval { $prod = $g->inspect_get_product_name ($_) };
+ print " ($prod)" if defined $prod;
print "\n";
$i++;
}
@@ -625,8 +618,14 @@ sub inspect_guest
}
}
elsif ($root_choice =~ m|^/dev/|) {
- $root_dev = $root_choice;
- unless (exists $oses->{$root_dev}) {
+ # Check the chosen root exists.
+ foreach (@roots) {
+ if ($root_choice eq $_) {
+ $root_dev = $_;
+ last;
+ }
+ }
+ unless (defined $root_dev) {
v2vdie __x('Root device "{choice}" not found. Roots found were: {roots}.',
choice => $root_choice,
roots => join ' ', @roots)
@@ -638,13 +637,39 @@ sub inspect_guest
}
}
- # Mount up the disks and check for applications.
-
- my $os = $oses->{$root_dev};
- mount_operating_system ($g, $os, 0);
- inspect_in_detail ($g, $os);
+ # Mount up the disks.
+ my %fses = $g->inspect_get_mountpoints ($root_dev);
+ my @fses = sort { length $a <=> length $b } keys %fses;
+ foreach (@fses) {
+ eval { $g->mount_options ("", $fses{$_}, $_) };
+ print __x("{e} (ignored)\n", e => $@) if $@;
+ }
- return $os;
+ # Construct the "$desc" hashref which contains the main features
+ # found by inspection.
+ my %desc;
+
+ $desc{root_device} = $root_dev;
+
+ $desc{os} = $g->inspect_get_type ($root_dev);
+ $desc{distro} = $g->inspect_get_distro ($root_dev);
+ $desc{product_name} = $g->inspect_get_product_name ($root_dev);
+ $desc{product_variant} = $g->inspect_get_product_variant ($root_dev);
+ $desc{major_version} = $g->inspect_get_major_version ($root_dev);
+ $desc{minor_version} = $g->inspect_get_minor_version ($root_dev);
+ $desc{arch} = $g->inspect_get_arch ($root_dev);
+
+ # Notes:
+ # (1) Filesystems have to be mounted for this to work. Do not
+ # move this code over the filesystem mounting code above.
+ # (2) For RPM-based distros, new libguestfs inspection code
+ # is only able to populate the 'app_name' field (old Perl code
+ # populated a lot more). Fortunately this is the only field
+ # that the code currently uses.
+ my @apps = $g->inspect_list_applications ($root_dev);
+ $desc{apps} = \@apps;
+
+ return \%desc;
}
=head1 PREPARING TO CONVERT A GUEST
--
1.7.4.1
More information about the Libguestfs
mailing list