Re: [Libguestfs] [PATCH 3/4] Add SUSE converter

Matthew Booth
2013-09-25T16:01:56Z

Mike,

This is great. I have a couple of minor comments inline, but this looks
good.

I do have a major concern, though, which is this is basically a fork of
RedHat.pm. There are well over 1,000 identical lines of code between the
2 modules. Many of the differences are relatively minor, and could be
handled with additional cases. I've also fixed a couple of bits in
RedHat.pm since you forked it, and you've fixed at least 1 thing in
SUSE.pm which is relevant to RedHat.pm.

I don't think I could accept this as-is purely from a maintenance POV.
Could you have a look through and see what it would take to re-use code
currently in RedHat.pm? This might be:

* Renaming it, and handling SUSE as additional cases
* Pulling common code into a separate module

Thanks,

Matt

On Mon, 2013-09-23 at 18:32 -0600, Mike Latimer wrote:
> The SUSE converter itself, based on the RedHat converter. This supports
> converting SLES 10/11 and openSUSE 10/11/12/13.
>
> ---
>  MANIFEST                              |    1 +
>  lib/Sys/VirtConvert/Converter/SUSE.pm | 2527
+++++++++++++++++++++++++++++++++
>  2 files changed, 2528 insertions(+)
>
> diff --git a/MANIFEST b/MANIFEST
> index 3724fde..615ec32 100644
> --- a/MANIFEST
> +++ b/MANIFEST
> @@ -17,6 +17,7 @@ lib/Sys/VirtConvert/Connection/VMwareOVASource.pm
>  lib/Sys/VirtConvert/Connection/Volume.pm
>  lib/Sys/VirtConvert/Converter.pm
>  lib/Sys/VirtConvert/Converter/RedHat.pm
> +lib/Sys/VirtConvert/Converter/SUSE.pm
>  lib/Sys/VirtConvert/Converter/Windows.pm
>  lib/Sys/VirtConvert/ExecHelper.pm
>  lib/Sys/VirtConvert/GuestfsHandle.pm
> diff --git a/lib/Sys/VirtConvert/Converter/SUSE.pm
b/lib/Sys/VirtConvert/Converter/SUSE.pm
> new file mode 100644
> index 0000000..7227385
> --- /dev/null
> +++ b/lib/Sys/VirtConvert/Converter/SUSE.pm
> @@ -0,0 +1,2527 @@
> +# Sys::VirtConvert::Converter::SUSE
> +# Copyright (C) 2009-2012 SUSE Inc.

That should probably be:

Copyright (C) 2009-2012 Red Hat Inc.
Copyright (C) 2013 SUSE Inc.

> +#
> +# Based on Sys::VirtConvert::Converter::RedHat
> +#
> +# 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
> +
> +use strict;
> +use warnings;
> +
> +
> +# Functions common between grub legacy and grub2. All bootloader
> +# interactions should eventually go through Bootloader::Tools.
> +package Sys::VirtConvert::Converter::SUSE::Grub;
> +
> +use Sys::VirtConvert::Util;
> +use Locale::TextDomain 'virt-v2v';
> +
> +sub get_initrd
> +{
> +    my $self = shift;
> +    my ($path) = @_;
> +
> +    my $g = $self->{g};
> +
> +    # The default name of the initrd is the same as the kernel name, with
> +    # initrd replacing vmlinuz. This can be confirmed with grubby, or
> +    # Bootloader::Tools->GetSection, but for now just do the
replacement
> +    # if the file exists.
> +    my $initrd;
> +    ($initrd = $path) =~ s/vmlinuz/initrd/;
> +    if ($g->exists($initrd)) {
> +        return $initrd;
> +    }
> +
> +    v2vdie __x('Didn\'t find initrd for kernel {path}', path
=> $path);
> +}

I would accept this, but in general I've tried to avoid heuristics.
Could you make this more reliable?

> +sub get_default_image
> +{
> +    my $self = shift;
> +    my ($path) = @_;
> +
> +    my $g = $self->{g};
> +
> +    my $default = $g->command(['/usr/bin/perl',
> +                  '-MBootloader::Tools',
> +                  '-e', 'InitLibrary(); '.
> +                  'my $default=Bootloader::Tools::GetDefaultSection();
'.
> +                  'print $default->{image};']);
> +    # If the image starts with (hd*,*), remove it.
> +    $default =~ s/^\(hd.*\)//;
> +
> +    return $default;
> +}

How confident can you be that perl and Bootloader::Tools are available
on the guest? As a comparison, grubby is a dependency of the kernel on
Fedora, which is good enough :) Much less than that and you want to be
looking elsewhere.

> +sub set_default_image
> +{
> +    my $self = shift;
> +    my ($path) = @_;
> +
> +    my $g = $self->{g};
> +
> +    # Using the image path to set a default image is not always reliable.
> +    # To be safe, get the image name, then set that as the default image.
> +    $g->command(['/usr/bin/perl',
> +           '-MBootloader::Tools',
> +           '-e', 'InitLibrary(); '.
> +           'my @sections = '.
> +           'GetSectionList(type=>image,
image=>"'.$path.'"); '.
> +           'my $section = GetSection(@sections); '.
> +           'my $newdefault = $section->{name}; '.
> +           'SetGlobals(default, "$newdefault");']);
> +}
> +

> +# Methods for inspecting and manipulating grub legacy
> +package Sys::VirtConvert::Converter::SUSE::GrubLegacy;
> +
> +use Sys::VirtConvert::Util;
> +
> +use File::Basename;
> +use Locale::TextDomain 'virt-v2v';
> +
> +@Sys::VirtConvert::Converter::SUSE::GrubLegacy::ISA > +
qw(Sys::VirtConvert::Converter::SUSE::Grub);
> +
> +sub new
> +{
> +    my $class = shift;
> +    my ($g, $root) = @_;
> +
> +    my $self = {};
> +    bless($self, $class);
> +
> +    $self->{g} = $g;
> +    $self->{root} = $root;
> +
> +    # Look for an EFI configuration
> +    foreach my $cfg ($g->glob_expand('/boot/*efi/*/grub.conf'))
{

I noticed you've changed this. Out of curiosity, where does SUSE mount
it?

> +sub check
> +{
> +    my $self = shift;
> +    my ($path) = @_;
> +
> +    my $g = $self->{g};
> +    my $grub_conf = $self->{grub_conf};
> +    my $grub_fs   = $self->{grub_fs};
> +    $path =~ /^$grub_fs(.*)/
> +       or v2vdie __x('Kernel {kernel} is not under grub tree
{grub}',
> +                     kernel => $path, grub => $grub_fs);
> +    my $grub_path = $1;
> +
> +    # Nothing to do if the kernel already has a grub entry
> +    return if $g->aug_match("/files$grub_conf/title/kernel".
> +                            "[. = '$grub_path']") ne
'';

I notice this is a change from RedHat.pm. Why did you add the "ne
''"?
Augeas will only return kernel entries, and I would expect a blank
kernel entry to be a parse error, hence this would be redundant.

> +
> +    my $kernel > +
Sys::VirtConvert::Converter::SUSE::_inspect_linux_kernel($g, $path);
> +    my $version = $kernel->{version};
> +    my $grub_initrd = dirname($path)."/initrd-$version";
> +
> +    # No point in dying if /etc/SuSE-release can't be read
> +    my ($title) = eval { $g->read_lines('/etc/SuSE-release') };
> +    $title ||= 'Linux';

Another change from RedHat.pm, obviously :) I think there's a guestfs
inspection api to return this data. If so, that would help turn this
into a common module.

> +# For Grub legacy, all we have to do is re-install grub in the correct
place.
> +sub convert_efi
> +{
> +    my $self = shift;
> +    my ($device) = @_;
> +
> +    my $g = $self->{g};
> +
> +    $g->cp('/etc/grub.conf', '/boot/grub/grub.conf');
> +    $g->ln_sf('/boot/grub/grub.conf',
'/etc/grub.conf');
> +
> +    # Reload to pick up grub.conf in its new location
> +    eval { $g->aug_load() };
> +    augeas_error($g, $@) if ($@);
> +
> +    $g->command(['grub-install.unsupported', $device]);

I guess that's unsupported :) Another RedHat.pm diff which we could
probably detect.

> +}
> +
> +
> +# Methods for inspecting and manipulating grub2. Note that we don't
actually
> +# attempt to use grub2's configuration because it's utterly
insane. Instead,
> +# we reverse engineer the way the config is automatically generated and
use
> +# that instead.
> +package Sys::VirtConvert::Converter::SUSE::Grub2;
> +
> +use Sys::VirtConvert::Util qw(:DEFAULT augeas_error);
> +use Locale::TextDomain 'virt-v2v';
> +
> +@Sys::VirtConvert::Converter::SUSE::Grub2::ISA > +
qw(Sys::VirtConvert::Converter::SUSE::Grub);
> +
> +sub new
> +{
> +    my $class = shift;
> +    my ($g, $root, $config) = @_;
> +
> +    my $self = {};
> +    bless($self, $class);
> +
> +    $self->{g} = $g;
> +    $self->{root} = $root;
> +    $self->{config} = $config;
> +
> +    # Look for an EFI configuration
> +    foreach my $cfg
($g->glob_expand('/boot/grub-efi/*/grub.cfg')) {

This is different to the other glob. Which is better?

> +        $self->check_efi();
> +    }
> +
> +    # Check we have a grub2 configuration
> +    if ($g->exists('/boot/grub2/grub.cfg')) {
> +        $self->{cfg} = '/boot/grub2/grub.cfg';
> +    }
> +    die unless exists $self->{cfg};
> +
> +    return $self;
> +}
> +
> +sub list_kernels
> +{
> +    my $self = shift;
> +    my $g = $self->{g};
> +
> +    my @kernels;
> +
> +    # Start by adding the default kernel
> +    my $default = $self->get_default_image;

V2V always uses parens for function calls.

> +sub update_console
> +{
> +    my $self = shift;
> +    my ($remove) = @_;
> +
> +    my $g = $self->{g};
> +
> +    my $cmdline > +        eval {
$g->aug_get('/files/etc/default/grub/'.
> +                          'GRUB_CMDLINE_LINUX_DEFAULT') };

Another minor RedHat.pm diff. (Just documenting, we would need to detect
them all.)

> +
> +    if (defined($cmdline) && $cmdline =~ /\bconsole=(?:x|h)vc0\b/)
{
> +        if ($remove) {
> +            $cmdline =~ s/\bconsole=(?:x|h)vc0\b\s*//g;
> +        } else {
> +            $cmdline =~ s/\bconsole=(?:x|h)vc0\b/console=ttyS0/g;
> +        }
> +
> +        eval {
> +            $g->aug_set('/files/etc/default/grub/'.
> +                       'GRUB_CMDLINE_LINUX_DEFAULT', $cmdline);

And again.

> +            $g->aug_save();
> +        };
> +        augeas_error($g, $@) if ($@);
> +
> +        # We need to re-generate the grub config if we've updated this
file
> +        $g->command(['grub2-mkconfig', '-o',
$self->{cfg}]);
> +    }
> +}
> +
> +sub check
> +{
> +    # Nothing required for grub2
> +}
> +
> +sub write
> +{
> +    my $self = shift;
> +    my ($path) = @_;
> +
> +    my $g = $self->{g};
> +
> +    my $default = $self->get_default_image;

Parens().

> +
> +    if ($default ne $path) {
> +        eval {
> +            $self->set_default_image($path);
> +        };
> +        if ($@) {
> +            logmsg WARN, __x('Unable to set default kernel to
{path}',
> +                             path => $path);
> +        }
> +    }

RedHat.pm diff. This could be managed in a common set_default_image(),
though.

> +}
> +
> +# For grub2, we :
> +#   Turn the EFI partition into a BIOS Boot Partition
> +#   Remove the former EFI partition from fstab
> +#   Install the non-EFI version of grub
> +#   Install grub2 in the BIOS Boot Partition
> +#   Regenerate grub.cfg
> +sub convert_efi
> +{
> +    my $self = shift;
> +    my ($device) = @_;
> +
> +    my $g = $self->{g};
> +
> +    # EFI systems boot using grub2-efi, and probably don't have the
base grub2
> +    # package installed.
> +    Sys::VirtConvert::Convert::SUSE::_install_any
> +        (undef, ['grub2'], undef, $g, $self->{root},
$self->{config}, $self)
> +        or v2vdie __x('Failed to install non-EFI grub2');
> +
> +    # Relabel the EFI boot partition as a BIOS boot partition
> +    $g->part_set_gpt_type($device, 1,
'21686148-6449-6E6F-744E-656564454649');
> +
> +    # Delete the fstab entry for the EFI boot partition
> +    eval {
> +        foreach my $node ($g->aug_match("/files/etc/fstab/*[file =
'/boot/efi']"))
> +        {
> +            $g->aug_rm($node);
> +        }
> +    };
> +    augeas_error($g, $@) if $@;

This is a diff from RedHat.pm, and it looks wrong. It removes the call
to aug_save(). In fact, I have a sneaking suspicion I may have fixed
this in RedHat.pm since you forked RedHat.pm.

> +sub convert
> +{
> +    my $class = shift;
> +
> +    my ($g, $root, $config, $meta, $options) = @_;
> +
> +    _clean_rpmdb($g);
> +    _init_selinux($g);
> +    _init_augeas($g);
> +
> +    my $grub;
> +    $grub = eval
> +        { Sys::VirtConvert::Converter::SUSE::Grub2->new($g, $root,
$config) };
> +    $grub = eval
> +        { Sys::VirtConvert::Converter::SUSE::GrubLegacy->new($g, $root)
}
> +        unless defined($grub);
> +    v2vdie __('No grub configuration found') unless
defined($grub);
> +
> +    # Un-configure HV specific attributes which don't require a direct
> +    # replacement
> +    _unconfigure_hv($g, $root);
> +
> +    # Try to install the virtio capability
> +    my $virtio = _install_capability('virtio', $g, $root, $config,
$meta, $grub);
> +
> +    # Get an appropriate kernel, or install one if none is available
> +    my $kernel = _configure_kernel($virtio, $g, $root, $config, $meta,
$grub);
> +
> +    # Install user custom packages
> +    if (! _install_capability('user-custom', $g, $root, $config,
$meta, $grub)) {
> +        logmsg WARN, __('Failed to install user-custom packages');
> +    }
> +
> +    # Configure the rest of the system
> +    my $remove_serial_console = exists($options->{NO_SERIAL_CONSOLE});
> +    _configure_console($g, $grub, $remove_serial_console);
> +
> +    _configure_display_driver($g, $root, $config, $meta, $grub);
> +    _remap_block_devices($meta, $virtio, $g, $root, $grub);

You've added $grub here. See note about this later.

> +# Configure a console on ttyS0. Make sure existing console references use
it.
> +# N.B. Note that the RHEL 6 xen guest kernel presents a console device
called
> +# /dev/hvc0, where previous xen guest kernels presented /dev/xvc0. The
regular

You don't like whereas ;)

> +# kernel running under KVM also presents a virtio console device called
> +# /dev/hvc0, so ideally we would just leave it alone. However, RHEL 6
libvirt
> +# doesn't yet support this device so we can't attach to it. We
therefore use
> +# /dev/ttyS0 for RHEL 6 anyway.
> +#

> +sub _configure_display_driver
> +{
> +    my ($g, $root, $config, $meta, $grub) = @_;
> +
> +    # Update the display driver if it exists
> +    my $updated = 0;
> +    eval {
> +        my $xorg;
> +
> +        # Check which X configuration we have, and make augeas load it if
> +        # necessary
> +        if (! $g->exists('/etc/X11/xorg.conf') &&
> +            $g->exists('/etc/X11/XF86Config'))
> +        {
> +            $g->aug_set('/augeas/load/Xorg/incl[last()+1]',
> +                        '/etc/X11/XF86Config');
> +
> +            # Reload to pick up the new configuration
> +            $g->aug_load();
> +
> +            $xorg = '/etc/X11/XF86Config';
> +        } else {
> +            $xorg = '/etc/X11/xorg.conf';
> +        }
> +
> +        foreach my $path
($g->aug_match('/files'.$xorg.'/Device/Driver')) {
> +            $g->aug_set($path, 'cirrus');

I've changed the default to qxl now.

> +sub _configure_kernel
> +{
> +    my ($virtio, $g, $root, $config, $meta, $grub) = @_;
> +
> +    # Pick first appropriate kernel returned by list_kernels
> +    my $boot_kernel;
> +    foreach my $path ($grub->list_kernels()) {
> +        my $kernel = _inspect_linux_kernel($g, $path);
> +        my $version = $kernel->{version};
> +
> +        # Skip foreign kernels
> +        next if _is_hv_kernel($g, $version);
> +
> +        # If we're configuring virtio, check this kernel supports it
> +        next if ($virtio && !_supports_virtio($version, $g));
> +
> +        $boot_kernel = $version;
> +        last;
> +    }
> +
> +    # Warn if there is no installed virtio capable kernel
> +    logmsg NOTICE, __x('virtio capable guest, but no virtio kernel
found.')
> +        if ($virtio && !defined($boot_kernel));
> +
> +    # If none of the installed kernels are appropriate, install a new one
> +    if(!defined($boot_kernel)) {
> +        my ($kernel_pkg, $kernel_arch, undef) > +
_discover_kernel($g, $root, $grub);
> +
> +        # If the guest is using a Xen PV kernel, choose an appropriate
> +        # normal kernel replacement
> +        if ($kernel_pkg eq "kernel-xen" || $kernel_pkg eq
"kernel-xen-base") {

RedHat.pm diff.

> +            $kernel_pkg = _get_replacement_kernel_name($g, $root,
> +                                                       $kernel_arch,
$meta);
> +
> +            # Check there isn't already one installed
> +            my ($kernel) =
_get_installed("$kernel_pkg.$kernel_arch", $g);
> +            $boot_kernel =
$kernel->[1].'-'.$kernel->[2].'.'.$kernel_arch
> +                if defined($kernel);
> +        }
> +
> +        if (!defined($boot_kernel)) {
> +            # List of kernels before the new kernel installation
> +            my @k_before = $g->glob_expand('/boot/vmlinuz-*');
> +
> +            if (_install_any([[$kernel_pkg, $kernel_arch]], undef, undef,

It looks like you modified _install_any to take a list of lists, but I
don't see anywhere that you've passed in more than a single kernel. Not
sure what's going on here. Looks like it's probably a bug.

> +                             $g, $root, $config, $grub))
> +            {
> +                # Figure out which kernel has just been installed
> +                my $version;
> +                foreach my $k
($g->glob_expand('/boot/vmlinuz-*')) {
> +                    if (!grep(/^$k$/, @k_before)) {
> +                        # Check which directory in /lib/modules the kernel
rpm
> +                        # creates
> +                        foreach my $file
> +                                ($g->command_lines(['rpm',
'-qlf', $k]))
> +                        {
> +                            next unless ($file =~
m{^/lib/modules/([^/]+)$});
> +
> +                            if
($g->is_dir("/lib/modules/$1")) {
> +                                $boot_kernel = $1;
> +                                last;
> +                            }
> +                        }
> +
> +                        last if defined($boot_kernel);
> +                    }
> +                }
> +
> +                v2vdie __x('Couldn\'t determine version of
installed kernel')
> +                    unless defined($boot_kernel);
> +            } else {
> +                v2vdie __x('Failed to find a {name} package to
install',
> +                           name => "$kernel_pkg");

This is $kernel_pkg.$kernel_arch in RedHat.pm. Is there any reason you
removed the arch?

> +# Get the target architecture from the default boot kernel
> +sub _get_os_arch
> +{
> +    my ($g, $root, $grub) = @_;
> +
> +    # Get the arch of the default kernel
> +    my @kernels = $grub->list_kernels();
> +    my $path = $kernels[0] if @kernels > 0;
> +    my $kernel = _inspect_linux_kernel($g, $path) if defined($path);
> +    my $arch = $kernel->{arch} if defined($kernel);
> +
> +    # Use the libguestfs-detected arch if the above failed
> +    $arch = $g->inspect_get_arch($root) unless defined($arch);
> +
> +    # Default to x86_64 if we still didn't find an architecture
> +    return 'x86_64' unless defined($arch);
> +
> +    # We want an i586 guest for i[346]86
> +    return 'i586' if($arch =~ /^i[346]86$/);

RedHat.pm diff.

> +# Unconfigure Xen specific guest modifications
> +sub _unconfigure_xen
> +{
> +    my ($g, $apps) = @_;
> +
> +    # Remove xen modules from INITRD_MODULES and DOMU_INITRD_MODULES
variables
> +    my $sysconfig = '/etc/sysconfig/kernel';
> +    my @variables = qw(INITRD_MODULES DOMU_INITRD_MODULES);
> +    my @xen_modules = qw(xennet xen-vnif xenblk xen-vbd);
> +    my $modified;
> +
> +    foreach my $var (@variables) {
> +        foreach my $xen_mod (@xen_modules) {
> +            foreach my $entry
> +                ($g->aug_match("/files$sysconfig/$var/value[. =
'$xen_mod']"))
> +            {
> +                $g->aug_rm("$entry");

$g->aug_rm($entry);

> +                $modified = 1;
> +            }
> +        }
> +    }
> +    $g->aug_save if ($modified == 1);
> +}

Obvious RedHat.pm diff.

> +sub _install_capability
> +{
> +    my ($name, $g, $root, $config, $meta, $grub) = @_;
> +
> +    my $cap = eval { $config->match_capability($g, $root, $name) };
> +    if ($@) {
> +        warn($@);
> +        return 0;
> +    }
> +
> +    if (!defined($cap)) {
> +        logmsg WARN, __x('{name} capability not found in
configuration',
> +                         name => $name);
> +        return 0;
> +    }
> +
> +    my @install;
> +    my @update;
> +    my $kernel;
> +    foreach my $name (keys(%$cap)) {
> +        my $props = $cap->{$name};
> +        my $ifinstalled = $props->{ifinstalled};
> +
> +        # Parse epoch, version and release from minversion
> +        my ($min_epoch, $min_version, $min_release);
> +        if (exists($props->{minversion})) {
> +            eval {
> +                ($min_epoch, $min_version, $min_release) > +
_parse_evr($props->{minversion});
> +            };
> +            v2vdie __x('Unrecognised format for {field} in config:
'.
> +                       '{value}. {field} must be in the format '.
> +                       '[epoch:]version[-release].',
> +                       field => 'minversion', value =>
$props->{minversion})
> +                if $@;
> +        }
> +
> +        # Kernels are special
> +        if ($name eq 'kernel') {
> +            my ($kernel_pkg, $kernel_arch, $kernel_rpmver) > +
_discover_kernel($g, $root, $grub);
> +
> +            # If we didn't establish a kernel version, assume we have
to update
> +            # it.
> +            if (!defined($kernel_rpmver)) {
> +                $kernel = [$kernel_pkg, $kernel_arch];
> +            }
> +
> +            else {
> +                my ($kernel_epoch, $kernel_ver, $kernel_release) > +
eval { _parse_evr($kernel_rpmver) };
> +                if ($@) {
> +                    # Don't die here, just make best effort to do a
version
> +                    # comparison by directly comparing the full strings
> +                    $kernel_epoch = undef;
> +                    $kernel_ver = $kernel_rpmver;
> +                    $kernel_release = undef;
> +
> +                    $min_epoch = undef;
> +                    $min_version = $props->{minversion};
> +                    $min_release = undef;
> +                }
> +
> +                # If the guest is using a Xen PV kernel, choose an
appropriate
> +                # normal kernel replacement
> +                if ($kernel_pkg eq "kernel-xen" || $kernel_pkg
eq "kernel-xen-base")

RedHat.pm diff.

> +                {
> +                    $kernel_pkg > +
_get_replacement_kernel_name($g, $root, $kernel_arch,
> +                                                     $meta);
> +
> +                    # Check if we've already got an appropriate kernel
> +                    my ($inst) > +
_get_installed("$kernel_pkg.$kernel_arch", $g);
> +
> +                    if (!defined($inst) ||
> +                        (defined($min_version) &&
> +                         _evr_cmp($inst->[0], $inst->[1],
$inst->[2],
> +                                  $min_epoch, $min_version, $min_release)
< 0))
> +                    {
> +                        # filter out xen from release field
> +                        if (defined($kernel_release) &&
> +                            $kernel_release =~ /^(\S+?)(xen)?$/)

This is xen/xenU in RedHat.pm. Could leave it alone as it would work
here, despite being (presumably) unnecessary.

> +                        {
> +                            $kernel_release = $1;
> +                        }
> +
> +                        # If the guest kernel is new enough, but PV, try
to
> +                        # replace it with an equivalent version FV kernel
> +                        if (!defined($min_version) ||
> +                            _evr_cmp($kernel_epoch, $kernel_ver,
> +                                     $kernel_release,
> +                                     $min_epoch, $min_version,
> +                                     $min_release) >= 0)
> +                        {
> +                            $kernel = [[$kernel_pkg, $kernel_arch,
> +                                       $kernel_epoch, $kernel_ver,
> +                                       $kernel_release]];

Single kernel.

> +                        }
> +
> +                        # Otherwise, just grab the latest
> +                        else {
> +                            $kernel = [[$kernel_pkg, $kernel_arch]];

Single kernel.

> +                        }
> +                    }
> +                }
> +
> +                # If the kernel is too old, grab the latest replacement
> +                elsif (defined($min_version) &&
> +                       _evr_cmp($kernel_epoch, $kernel_ver,
$kernel_release,
> +                                $min_epoch, $min_version, $min_release)
< 0)
> +                {
> +                    $kernel = [[$kernel_pkg, $kernel_arch]];

Single kernel.

> +sub _install_any
> +{
> +    my ($kernel, $install, $update, $g, $root, $config, $grub) = @_;
> +
> +    # If we're installing a kernel, check which kernels are there
first
> +    my @k_before = $g->glob_expand('/boot/vmlinuz-*') if
defined($kernel);
> +
> +    # If a SLES11 kernel is being added, add -base kernel
> +    if (defined($kernel)) {
> +        if (_is_sles_family($g, $root) &&
> +           $g->inspect_get_major_version($root) == 11) {
> +            $kernel->[1][0] = $kernel->[0][0].'-base';
> +            for my $count (1..4) {
> +                if (defined($kernel->[0][$count])) {
> +                    $kernel->[1][$count] = $kernel->[0][$count];
> +                }
> +            }
> +        }
> +    }

Ah... I see what you're doing here. Still, _install_any() only takes a
single kernel. You can convert it into a list within this function and
leave the rest untouched.

> +    # Due to bnc#836521, root can be set to (hd*), instead of (hd*,*)
> +    # For the time being, workaround the problem
> +    my $pbl_fix = _modify_perlBootloader($g) if defined($kernel);
> +
> +    my $success = 0;
> +    _net_run($g, sub {
> +        eval {
> +            # Try to fetch these dependencies using the guest's native
update
> +            # tool
> +            $success = _install_zypper($kernel, $install, $update, $g);

Obvious RedHat.pm diff.

> +# Install a set of rpms
> +sub _install_rpms
> +{
> +    local $_;
> +    my ($g, $config, $update, @rpms) = @_;
> +
> +    # Nothing to do if we got an empty set
> +    return if(scalar(@rpms) == 0);
> +
> +    # All paths are relative to the transfer mount. Need to make them
absolute.
> +    # No need to check get_transfer_path here as all paths have been
previously
> +    # checked
> +    @rpms = map { $_ = $config->get_transfer_path($_) } @rpms;
> +
> +    logmsg NOTICE, __x('Falling back to local virt-v2v repo:');
> +    foreach my $pkg (@rpms) {
> +        (my $pkgname = $pkg) =~ s/(.*\/)//;

basename would have saved me a moment of squinting :)

> +        logmsg NOTICE, __x("   $pkgname");

Logging must not be used for formatting. The log message must be
self-contained. You should construct this list and emit a single log
message.

> +    }
> +
> +    eval { $g->command(['rpm', $update == 1 ? '-U' :
'-i', @rpms]) };
> +    if ($@) {
> +        my $error = $@;
> +        # Try to isolate error to a meaningful string
> +        $error =~ /^(command.*error:)\s+(.*:)\s+(.*)\s(at \/usr\/.*)/;
> +        logmsg WARN, __x('Failed to install packages. '.
> +                         'Error was: {error}', error =>
"$2 $3");

What error message is this trying to parse? We should avoid trying to
parse error message wherever possible as they are notorious for
differing between versions.

Also, this should almost certainly die (with v2vdie) rather than be a
warning.

> +# Inspect the guest to work out what kernel package is in use
> +# Returns ($kernel_pkg, $kernel_arch)
> +sub _discover_kernel
> +{
> +    my ($g, $root, $grub) = @_;
> +
> +    # Get a current bootable kernel, preferrably the default
> +    my $kernel_pkg;
> +    my $kernel_arch;
> +    my $kernel_ver;
> +
> +    foreach my $path ($grub->list_kernels()) {
> +        my $kernel = _inspect_linux_kernel($g, $path);
> +
> +        # Check its architecture is known
> +        $kernel_arch = $kernel->{arch};
> +        next unless (defined($kernel_arch));
> +
> +        # Get the kernel package name
> +        $kernel_pkg = $kernel->{package};
> +
> +        # Get the kernel package version
> +        $kernel_ver = $kernel->{version};
> +
> +        last;
> +    }
> +
> +    # Default to 'kernel' if package name wasn't discovered
> +    $kernel_pkg = "kernel" if (!defined($kernel_pkg));
> +
> +    # Default the kernel architecture to the userspace architecture if it
wasn't
> +    # directly detected
> +    $kernel_arch = $g->inspect_get_arch($root) unless
defined($kernel_arch);
> +
> +    # The supported 32 bit kernel architecture is i586.
> +    $kernel_arch = 'i586' if ('i386' eq $kernel_arch);

RedHat.pm diff.

> +
> +    return ($kernel_pkg, $kernel_arch, $kernel_ver);
> +}
> +
> +sub _get_replacement_kernel_name
> +{
> +    my ($g, $root, $arch, $meta) = @_;
> +
> +    # Make an informed choice about a replacement kernel for distros we
know
> +    # about
> +
> +    # SLES 11
> +    if (_is_sles_family($g, $root) &&
> +        $g->inspect_get_major_version($root) eq '11') {
> +        if ($arch eq 'i586') {
> +            # If the guest has > 10G RAM, give it a pae kernel
> +            if ($meta->{memory} > 10 * 1024 * 1024 * 1024) {
> +                return 'kernel-pae';
> +            }
> +
> +            else {
> +                return 'kernel-default';
> +            }
> +       }
> +
> +        # There's only 1 kernel package on SLES 11 x86_64
> +        else {
> +            return 'kernel-default';
> +        }
> +    }
> +
> +    # SLES 10
> +    elsif (_is_sles_family($g, $root) &&
> +        $g->inspect_get_major_version($root) eq '10') {
> +        if ($arch eq 'i586') {
> +            # If the guest has > 10G RAM, give it a bigsmp kernel
> +            if ($meta->{memory} > 10 * 1024 * 1024 * 1024) {
> +                return 'kernel-bigsmp';
> +            }
> +
> +            # SMP kernel for guests with >1 CPU
> +            elsif ($meta->{cpus} > 1) {
> +                return 'kernel-smp';
> +            }
> +
> +            else {
> +                return 'kernel-default';
> +            }
> +        }
> +
> +        else {
> +            if ($meta->{cpus} > 1) {
> +                return 'kernel-smp';
> +            }
> +
> +            else {
> +                return 'kernel-default';
> +            }
> +        }
> +    }

This could easily be a big combined RH/SLES list.

> +sub _remap_block_devices
> +{
> +    my ($meta, $virtio, $g, $root, $grub) = @_;
> +
> +    my @devices = map { $_->{device} } @{$meta->{disks}};
> +    @devices = sort { scsi_first_cmp($a, $b) } @devices;
> +
> +    # @devices contains an ordered list of libvirt device names. Because
> +    # libvirt uses a similar naming scheme to Linux, these will mostly be
the
> +    # same names as used by the guest. They are ordered as they were
passed to
> +    # libguestfs, which means their device name in the appliance can be
> +    # inferred.
> +
> +    # If the guest is using libata, IDE drives could have different names
in the
> +    # guest from their libvirt device names.
> +
> +    # Modern SUSE distros use libata, and IDE devices are presented as sdX
> +    my $libata = 1;
> +
> +    # Disable libata for SUSE7/8, although this platform is unsupported
> +    if (_is_sles_family($g, $root)) {
> +        my $major_version = $g->inspect_get_major_version($root);
> +        if ($major_version eq '7' ||
> +            $major_version eq '8')
> +        {
> +            $libata = 0;
> +        }
> +    }

Could be combined with RHEL list.

> +    # Create a hash to track any hd->sd conversions, as any references
to
> +    # hd devices (in fstab, menu.lst, etc) will need to be converted
later.
> +    my %idemap;
> +
> +    if ($libata) {
> +        # If there are any IDE devices, the guest will have named these
sdX
> +        # after any SCSI devices. i.e. If we have disks hda, hdb, sda and
sdb,
> +        # these will have been presented to the guest as sdc, sdd, sda and
sdb
> +        # respectively.
> +        #
> +        # N.B. I think the IDE/SCSI ordering situation may be somewhat
more
> +        # complicated than previously thought. This code originally put
IDE
> +        # drives first, but this hasn't worked for an OVA file. Given
that
> +        # this is a weird and somewhat unlikely situation I'm going
with SCSI
> +        # first until we have a more comprehensive solution.
> +
> +        my $idedev;
> +        my @newdevices;
> +        my $suffix = 'a';
> +        foreach my $device (@devices) {
> +            if ($device =~ /(?:h|s)d[a-z]+/) {
> +                $idedev = $device;
> +                $device = 'sd'.$suffix++;
> +                $idemap{$device} = $idedev if ($device ne $idedev);

RedHat.pm diff, and probably generally applicable. I'd definitely want
to look at this as a separate patch.

> +            }
> +            push(@newdevices, $device);
> +        }
> +        @devices = @newdevices;
> +    }
> +
> +    # We now assume that @devices contains an ordered list of device
names, as
> +    # used by the guest. Create a map of old guest device names to new
guest
> +    # device names.
> +    my %map;
> +
> +    # Everything will be converted to either vdX, sdX or hdX
> +    my $prefix;
> +    if ($virtio) {
> +        $prefix = 'vd';
> +    } elsif ($libata) {
> +        $prefix = 'sd';
> +    } else {
> +        $prefix = 'hd'
> +    }
> +
> +    my $letter = 'a';
> +    foreach my $device (@devices) {
> +        my $mapped = $prefix.$letter;
> +
> +
> +        # If a Xen guest has non-PV devices, Xen also simultaneously
presents
> +        # these as xvd devices. i.e. hdX and xvdX both exist and are the
same
> +        # device.
> +        # This mapping is also useful for P2V conversion of Citrix
Xenserver
> +        # guests done in HVM mode. Disks are detected as sdX, although the
guest
> +        # uses xvdX natively.
> +        if ($device =~ /^(?:h|s)d([a-z]+)/) {
> +            $map{'xvd'.$1} = $mapped;
> +        }
> +        $map{$device} = $mapped;
> +        # Also add a mapping for previously saved hd->sd conversions
> +        #if (defined($idemap{$device}) && (($idemap{$device}) ne
"")){
> +        if (defined($idemap{$device})){
> +            my $idedevice;
> +            $idedevice = $idemap{$device};
> +            $map{$idedevice} = $mapped;
> +        }
> +
> +        $letter++;
> +    }
> +
> +    eval {
> +        # Update bare device references in fstab and grub's menu.lst
and device.map
> +        foreach my $spec
($g->aug_match('/files/etc/fstab/*/spec'),
> +
$g->aug_match("/files$grub->{grub_conf}/*/kernel/root"),
> +
$g->aug_match("/files$grub->{grub_conf}/*/kernel/resume"),

This doesn't work for grub2. However, it does need to be done, and we
don't do it in RedHat.pm. Again, I'd like to see a general solution to
this.

> +sub _prepare_bootable
> +{
> +    my ($g, $root, $grub, $version, @modules) = @_;
> +
> +    my $path = "/boot/vmlinuz-$version";
> +    $grub->write($path);
> +    my $grub_initrd = $grub->get_initrd($path);
> +
> +    # Backup the original initrd
> +    $g->mv($grub_initrd, "$grub_initrd.pre-v2v")
> +    if $g->exists($grub_initrd);
> +
> +    # dracut does not exist in SUSE, but might in the future
> +    if ($g->exists('/sbin/dracut')) {
> +        $g->command(['/sbin/dracut', '--add-drivers',
join(" ", @modules),
> +                     $grub_initrd, $version]);
> +    }
> +
> +    elsif ($g->exists('/sbin/mkinitrd')) {
> +        # Create a new initrd which probes the required kernel modules
> +        my @module_args = ();
> +        push(@module_args, "-m \"");
> +        foreach my $module (@modules) {
> +            push(@module_args, "$module ");
> +        }
> +        push(@module_args, "\"");
> +
> +        my @env;
> +
> +        $g->sh(join(' ', @env).'/sbin/mkinitrd
'.join(' ', @module_args).
> +               " -i $grub_initrd -k /boot/vmlinuz-$version");

I think you're looking for:

$g->sh(join(' ', @env).' /sbin/mkinitrd -m "'.join('
', @modules).'" '.

We should probably modularise this who section somewhere.

> +    }
> +
> +    else {
> +        v2vdie __('Didn\'t find mkinitrd or dracut. Unable to
update initrd.');
> +    }
> +
> +}
> +
> +# Return 1 if the guest supports ACPI, 0 otherwise
> +sub _supports_acpi
> +{
> +    my ($g, $root, $arch) = @_;
> +
> +    # Blacklist configurations which are known to fail
> +    # possibly SLES 8, x86_64 (Similar to RHEL 3?)
> +    if (_is_sles_family($g, $root) &&
$g->inspect_get_major_version($root) == 8 &&
> +        $arch eq 'x86_64') {
> +        return 0;
> +    }
> +
> +    return 1;
> +}
> +
> +sub _supports_virtio
> +{
> +    my ($kernel, $g) = @_;
> +
> +    my %checklist = (
> +        "virtio_net" => 0,
> +        "virtio_blk" => 0
> +    );
> +
> +    # Search the installed kernel's modules for the virtio drivers
> +    foreach my $module ($g->find("/lib/modules/$kernel")) {
> +        foreach my $driver (keys(%checklist)) {
> +            if($module =~ m{/$driver\.(?:o|ko)$}) {
> +                $checklist{$driver} = 1;
> +            }
> +        }
> +    }
> +
> +    # Check we've got all the drivers in the checklist
> +    foreach my $driver (keys(%checklist)) {
> +        if(!$checklist{$driver}) {
> +            return 0;
> +        }
> +    }
> +
> +    return 1;
> +}
> +
> +# The next two functions are a temporary workaround to bnc#836521. The
actual
> +# fix is in a new perl-Bootloader, which will likely not be on most
guests.
> +sub _modify_perlBootloader
> +{
> +    my ($g) = @_;
> +    my $module = $g->sh('rpm -ql perl-Bootloader | grep
GRUB.pm');
> +    chomp($module);
> +    my $module_bak = "$module.v2vtmp";
> +
> +    if ($g->grep('/dev/(?:vx', "$module")) {
> +        $g->mv($module, $module_bak);
> +        $g->sh("/usr/bin/sed -e's/vx/xv/' $module_bak >
$module");
> +
> +        return 1;
> +    }
> +
> +    return 0;
> +}

Welcome to being forced to work around bugs which were fixed long ago ;)

> +sub _restore_perlBootloader
> +{
> +    my ($g) = @_;
> +    my $module = $g->sh('rpm -ql perl-Bootloader | grep
GRUB.pm');
> +    chomp($module);
> +    my $module_bak = "$module.v2vtmp";
> +
> +    if ($g->exists($module_bak)) {
> +        $g->mv($module_bak, $module);
> +    }
> +}
> +
> +=back
> +
> +=head1 COPYRIGHT
> +
> +Copyright (c) 2013 SUSE LINUX Products GmbH, Nuernberg, Germany.
> +
> +=head1 LICENSE
> +
> +Please see the file COPYING.LIB for the full license.
> +
> +=head1 SEE ALSO
> +
> +L<Sys::VirtConvert::Converter(3pm)>,
> +L<Sys::VirtConvert(3pm)>,
> +L<virt-v2v(1)>,
> +L<http://libguestfs.org/>.
> +
> +=cut
> +
> +1;