[Libguestfs] [PATCH 5/9] Fix application installation by GuestOS

Rewrite the code to create the transfer ISO to use the new XML config file format, and move it out of GuestOS in to virt-v2v.pl --- lib/Sys/VirtV2V/GuestOS.pm | 217 +++++++++++++++------------- lib/Sys/VirtV2V/GuestOS/RedHat.pm | 294 ++++++++++++++++--------------------- v2v/virt-v2v.pl | 94 +++++++++++- 3 files changed, 328 insertions(+), 277 deletions(-) diff --git a/lib/Sys/VirtV2V/GuestOS.pm b/lib/Sys/VirtV2V/GuestOS.pm index 1db7590..539659e 100644 --- a/lib/Sys/VirtV2V/GuestOS.pm +++ b/lib/Sys/VirtV2V/GuestOS.pm @@ -43,7 +43,7 @@ Sys::VirtV2V::GuestOS - Manipulate and query a Guest OS use Sys::VirtV2V::GuestOS; - $guestos = Sys::VirtV2V::GuestOS->instantiate($g, $desc); + $guestos = Sys::VirtV2V::GuestOS->new($g, $desc, $dom, $config); =head1 DESCRIPTION @@ -57,25 +57,11 @@ implements methods to access backends. Sys::VirtV2V::GuestOS uses L<Module::Pluggable> to automatically discover backends under Sys::VirtV2V::GuestOS. -=cut - -# A map of file labels to their paths relative to the transfer device -my %files; - -# A map of file labels to their dependencies -my %deps; - -# A map of file labels aliases -my %aliases; - -# The path (on the host) to the transfer iso -my $transferiso; - =head1 METHODS =over -=item instantiate(g, desc) +=item new(g, desc, dom, config) Instantiate a GuestOS object capable of manipulating the target OS. @@ -89,123 +75,162 @@ A L<Sys::Guestfs> handle. An OS description created by L<Sys::Guestfs::Lib>. +=item dom + +An XML::DOM object containing the guest's libvirt domain XML prior to +conversion. + +=item config + +An XML::DOM object containing the virt-v2v configuration. + =back -Returns a capable Sys::VirtV2V::GuestOS backend if one is found. +Returns a capable Sys::VirtV2V::GuestOS if one is found. Returns undef otherwise. =cut -sub instantiate +sub new { my $class = shift; - my ($g, $desc) = @_; - defined($g) or carp("get_instance called without g argument"); - defined($desc) or carp("get_instance called without desc argument"); + my ($g, $desc, $dom, $config) = @_; + defined($g) or carp("instantiate called without g argument"); + defined($desc) or carp("instantiate called without desc argument"); + defined($dom) or carp("instantiate called without dom argument"); + defined($config) or carp("instantiate called without config argument"); + + my $self = {}; + + $self->{g} = $g; + $self->{desc} = $desc; + $self->{dom} = $dom; + $self->{config} = $config; foreach my $module ($class->modules()) { - return $module->new($g, $desc, \%files, \%deps, \%aliases) - if($module->can_handle($desc)); + return $module->new($self) + if($module->can_handle($desc)); } return undef; } -=item configure(config) +=item get_ncpus -=over +Return the number of CPUS which are available to this guest -=item config +=cut -The parsed virt-v2v config file, as returned by Config::Tiny. +sub get_ncpus +{ + my $self = shift; -=back + my ($ncpus) = $self->{dom}->findnodes('/domain/vcpu/text()'); + if (defined($ncpus)) { + return $ncpus->getData(); + } else { + return 1; + } +} + +=item get_memory_kb -Read the [files], [deps] and [aliases] sections of the virt-v2v config file. -Create the transfer iso from the contents of [files]. +Return the amount of memory, in KB, which is available to this guest =cut -sub configure +sub get_memory_kb { - my $class = shift; + my $self = shift; - my $config = shift; + my ($mem_kb) = $self->{dom}->findnodes('/domain/memory/text()'); - carp("configure called without config argument") unless(defined($config)); + return $mem_kb->getData(); +} - # Lookup the [files] config section - my $files_conf = $config->{files}; +=item match_app - # Do nothing if there is no [files] config section - return unless(defined($files_conf)); +Return a matching app entry from the virt-v2v configuration. The entry is +returned as a hashref containing 2 entries. I<path> contains the path to the +application itself. I<deps> contains an arrayref containing the paths of all the +app's listed dependencies. - # A hash, whose labels are filenames to be added to the transfer iso. We use - # a hash here to remove duplicates. - my %paths = (); - foreach my $label (keys(%$files_conf)) { - my $path = $files_conf->{$label}; +=cut - unless(-f $path && -r $path) { - print STDERR user_message(__x("WARNING: unable to access {path}.", - path => $path)); - next; - } +sub match_app +{ + my $self = shift; - $paths{$path} = 1; + my ($name, $arch) = @_; - # As transfer directory hierarchy is flat, remove all directory - # components from paths - my (undef, undef, $filename) = File::Spec->splitpath($path); - $files{$label} = $filename; - } + my $config = $self->{config}; - # Do nothing if there are no files defined - return if(keys(%paths) == 0); - - $transferiso = File::Temp->new(UNLINK => 1, SUFFIX => '.iso'); - my $eh = Sys::VirtV2V::ExecHelper->run - ('mkisofs', '-o', $transferiso, '-r', '-J', - '-V', '__virt-v2v_transfer__', keys(%paths)); - if($eh->status() != 0) { - print STDERR user_message(__x("Failed to create transfer iso. Command ". - "output was:\n{output}", - output => $eh->output())); - } + my $desc = $self->{desc}; + my $distro = $desc->{distro}; + my $major = $desc->{major_version}; + my $minor = $desc->{minor_version}; + + # Check we've got at least a distro from OS detection + die(user_message(__"Didn't detect OS distribution")) + unless (defined($distro)); + + # Create a list of xpath queries against the config which look for a + # matching <app> config entry in descending order of specificity - # Populate deps from the [deps] config section - my $deps_conf = $config->{deps}; + my $prefix = "/virt-v2v/app[\@os='$distro' and \@name='$name'"; - if(defined($deps_conf)) { - # Copy the deps_conf hash into %deps - foreach my $label (keys(%$deps_conf)) { - $deps{$label} = $deps_conf->{$label}; + my @queries; + if (defined($major)) { + if (defined($minor)) { + push(@queries, $prefix." and \@major='$major' ". + "and \@minor='$minor' and \@arch='$arch']"); + push(@queries, $prefix." and \@major='$major' ". + "and \@minor='$minor']"); } + + push(@queries, $prefix." and \@major='$major' and \@arch='$arch']"); + push(@queries, $prefix." and \@major='$major']"); } - # Populate aliases from the [aliases] config section - my $aliases_conf = $config->{aliases}; + push(@queries, $prefix." and \@arch='$arch']"); + push(@queries, $prefix."]"); - if(defined($aliases_conf)) { - # Copy the aliases_conf hash into %aliases - foreach my $label (keys(%$aliases_conf)) { - $aliases{$label} = $aliases_conf->{$label}; - } + # Use the results of the first query which returns a result + my $app; + foreach my $query (@queries) { + ($app) = $config->findnodes($query); + last if (defined($app)); } -} -=item get_transfer_iso + unless (defined($app)) { + my $search = "distro='$distro' name='$name'"; + $search .= " major='$major'" if (defined($major)); + $search .= " minor='$minor'" if (defined($minor)); + $search .= " arch='$arch'"; -Return the path (on the host) to the transfer iso image. L</configure> must have -been called first. + die(user_message(__x("No app in config matches {search}", + search => $search))); + } -=cut + my %app; + my ($path) = $app->findnodes('path/text()'); + die(user_message(__x("app entry in config doesn't contain a path: {xml}", + xml => $app->toString()))) unless (defined($path)); + $path = $path->getData(); -sub get_transfer_iso -{ - return $transferiso; + my @deps; + foreach my $dep ($app->findnodes('dep/text()')) { + push(@deps, $dep->getData()); + } + + # Return a hash containing the application path and its dependencies + my %ret; + $ret{path} = $path; + $ret{deps} = \@deps; + + return \%ret; } =back @@ -242,21 +267,15 @@ A L<Sys::Guestfs> handle. An OS description created by L<Sys::Guestfs::Lib>. -=item files - -A hash containing 'label => filename' mappings. These mappings are consulted -when a guest needs to install a specific application. +=item dom -=item deps +A parsed XML::DOM containing the libvirt domain XML for this guest prior to any +conversion. -A hash containing 'label => C<space separated dependency list>'. The -dependencies are given as labels rather than specific files. This is used to -install dependencies when installing an application in the guest. - -=item aliases +=item config -A hack containing 'label => alias'. Aliases are given as labels rather than -specific files. This is used to substitute packages during installation. +A parsed XML::DOM containing the virt-v2v configuration, or undef if there is +no config. =back diff --git a/lib/Sys/VirtV2V/GuestOS/RedHat.pm b/lib/Sys/VirtV2V/GuestOS/RedHat.pm index 920eea2..d6abe9b 100644 --- a/lib/Sys/VirtV2V/GuestOS/RedHat.pm +++ b/lib/Sys/VirtV2V/GuestOS/RedHat.pm @@ -17,9 +17,13 @@ package Sys::VirtV2V::GuestOS::RedHat; +our @ISA = ('Sys::VirtV2V::GuestOS'); + use strict; use warnings; +use File::Spec; + use Sys::Guestfs::Lib qw(inspect_linux_kernel); use Sys::VirtV2V::UserMessage qw(user_message); @@ -65,7 +69,7 @@ sub can_handle return ($desc->{os} eq 'linux') && ($desc->{package_format} eq 'rpm'); } -=item Sys::VirtV2V::GuestOS::RedHat->new(g, desc, files, deps, aliases) +=item Sys::VirtV2V::GuestOS::RedHat->new(self) See BACKEND INTERFACE in L<Sys::VirtV2V::GuestOS> for details. @@ -75,27 +79,9 @@ 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}); - - # Guest dependency map - $self->{deps} = shift; - carp("new called without dependencies") unless defined($self->{deps}); - - # Guest alias map - $self->{aliases} = shift; - carp("new called without aliases") unless defined($self->{aliases}); + # Self object + my $self = shift; + carp("new called without self object") unless defined($self); bless($self, $class); @@ -475,32 +461,113 @@ sub add_kernel my ($kernel_pkg, $kernel_arch) = $self->_discover_kernel(); - # Install the kernel's dependencies - $self->_install_rpms(1, $self->_resolve_deps($kernel_pkg)); + # 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-xenU") { + my $desc = $self->{desc}; + + # Make an informed choice about a replacement kernel for distros we know + # about + + # RHEL 5 + if ($desc->{distro} eq 'rhel' && $desc->{major_version} eq '5') { + if ($kernel_arch eq 'i686') { + # XXX: This assumes that PAE will be available in the + # hypervisor. While this is almost certainly true, it's + # theoretically possible that it isn't. The information we need + # is available in the capabilities XML. + # If PAE isn't available, we should choose 'kernel'. + $kernel_pkg = 'kernel-PAE'; + } + + # There's only 1 kernel package on RHEL 5 x86_64 + else { + $kernel_pkg = 'kernel'; + } + } + + # RHEL 4 + elsif ($desc->{distro} eq 'rhel' && $desc->{major_version} eq '4') { + my $ncpus = $self->get_ncpus(); + + if ($kernel_arch eq 'i686') { + # If the guest has > 10G RAM, give it a hugemem kernel + if ($self->get_memory_kb() > 10 * 1024 * 1024) { + $kernel_pkg = 'kernel-hugemem'; + } + + # SMP kernel for guests with >1 CPU + elsif ($ncpus > 1) { + $kernel_pkg = 'kernel-smp'; + } + + else { + $kernel_pkg = 'kernel'; + } + } + + else { + if ($ncpus > 8) { + $kernel_pkg = 'kernel-largesmp'; + } + + elsif ($ncpus > 1) { + $kernel_pkg = 'kernel-smp'; + } + + else { + $kernel_pkg = 'kernel'; + } + } + } - my $filename; + # RHEL 3 didn't have a xen kernel + + # XXX: Could do with a history of Fedora kernels in here + + # For other distros, be conservative and just return 'kernel' + else { + $kernel_pkg = 'kernel'; + } + } + + my $app; eval { - # Get a matching rpm - $filename = $self->_match_file($kernel_pkg, $kernel_arch); + $app = $self->match_app($kernel_pkg, $kernel_arch); }; - # Return undef if we didn't find a kernel + if ($@) { + print STDERR $@; + return undef; + } + + my $path = $app->{path}; + + my @install; + # Install any kernel dependencies which aren't already installed + foreach my $dep (@{$app->{deps}}) { + push(@install, $dep) unless($self->_is_installed($dep)); + } + $self->_install_rpms(1, @install); + return undef if($@); # Inspect the rpm to work out what kernel version it contains my $version; my $g = $self->{g}; - foreach my $file ($g->command_lines(["rpm", "-qlp", $filename])) { + foreach my $file ($g->command_lines + (["rpm", "-qlp", $self->_transfer_path($path)])) + { if($file =~ m{^/boot/vmlinuz-(.*)$}) { $version = $1; last; } } - die(user_message(__x("{filename} doesn't contain a valid kernel", - filename => $filename))) if(!defined($version)); + die(user_message(__x("{path} doesn't contain a valid kernel", + path => $path))) if(!defined($version)); - $self->_install_rpms(0, ($filename)); + $self->_install_rpms(0, ($path)); # Make augeas reload so it'll find the new kernel $g->aug_load(); @@ -508,7 +575,7 @@ sub add_kernel return $version; } -# Inspect the guest description to work out what kernel should be installed. +# Inspect the guest description to work out what kernel package is in use # Returns ($kernel_pkg, $kernel_arch) sub _discover_kernel { @@ -602,63 +669,21 @@ sub add_application my $user_arch = $self->{desc}->{arch}; - # Get the rpm for this label - my $rpm = $self->_match_file($label, $user_arch); + my $app = $self->match_app($label, $user_arch); # Nothing to do if it's already installed - return if(_is_installed($rpm)); + return if($self->_is_installed($app->{path})); - my @install = ($rpm); + my @install = ($app->{path}); - # Add the dependencies to the install set - push(@install, $self->_resolve_deps($label)); + # Add any dependencies which aren't already installed to the install set + foreach my $dep (@{$app->{deps}}) { + push(@install, $dep) unless ($self->_is_installed($dep)); + } $self->_install_rpms(1, @install); } -# Return a list of dependencies which must be installed before $label can be -# installed. The list contains paths of rpm files. It does not contain the rpm -# for $label itself. This is so _resolve_deps can be used to install kernel -# dependencies with -U before the kernel itself is installed with -i. -sub _resolve_deps -{ - my $self = shift; - - my ($label, @path) = @_; - - my $user_arch = $self->{desc}->{arch}; - - # Check for an alias for $label - $label = $self->_resolve_alias($label, $user_arch); - - # Check that the dependency path doesn't include the given label. If it - # does, that's a dependency loop. - if(grep(/\Q$label\E/, @path) > 0) { - die(user_message(__x("Found dependency loop installing {label}: {path}", - label => $label, path => join(' ', @path)))); - } - push(@path, $label); - - my $g = $self->{g}; - - my @depfiles = (); - - # Find dependencies for $label - foreach my $dep ($self->_match_deps($label, $user_arch)) { - my $rpm = $self->_match_file($dep, $user_arch); - - # Don't add the dependency if it's already installed - next if($self->_is_installed($rpm)); - - # Add the dependency - push(@depfiles, $rpm); - - # Recursively add dependencies - push(@depfiles, $self->_resolve_deps($dep, @path)); - } - - return @depfiles; -} # Return 1 if the requested rpm, or a newer version, is installed # Return 0 otherwise @@ -669,6 +694,8 @@ sub _is_installed my $g = $self->{g}; + $rpm = $self->_transfer_path($rpm); + # Get NEVRA for the rpm to be installed my $nevra = $g->command(['rpm', '-qp', '--qf', '%{NAME} %{EPOCH} %{VERSION} %{RELEASE} %{ARCH}', @@ -828,94 +855,6 @@ sub get_application_owner die($@) if($@); } -# Lookup a guest specific match for the given label -sub _match -{ - my $self = shift; - my ($object, $label, $arch, $hash) = @_; - - my $desc = $self->{desc}; - my $distro = $desc->{distro}; - my $major = $desc->{major_version}; - my $minor = $desc->{minor_version}; - - if(values(%$hash) > 0) { - # 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 $name if(defined($hash->{$name})); - } - } - - die(user_message(__x("No {object} given matching {label}", - object => $object, - label => "$distro.$major.$minor.$arch.$label"))); -} - -# Return the path to an rpm for <label>.<arch> -# Dies if no match is found -sub _match_file -{ - my $self = shift; - my ($label, $arch) = @_; - - # Check for an alias for $label - $label = $self->_resolve_alias($label, $arch); - - my $files = $self->{files}; - - my $name = $self->_match(__"file", $label, $arch, $files); - - # Ensure that whatever file is returned is accessible - $self->_ensure_transfer_mounted(); - - return $self->{transfer_mount}.'/'.$files->{$name}; -} - -# Look for an alias for this label -sub _resolve_alias -{ - my $self = shift; - my ($label, $arch) = @_; - - my $aliases = $self->{aliases}; - - my $alias; - eval { - $alias = $self->_match(__"alias", $label, $arch, $aliases); - }; - - return $aliases->{$alias} if(defined($alias)); - return $label; -} - -# Return a list of labels listed as dependencies of the given label. -# Returns an empty list if no dependencies were specified. -sub _match_deps -{ - my $self = shift; - my ($label, $arch) = @_; - - my $deps = $self->{deps}; - - my $name; - eval { - $name = $self->_match(__"dependencies", $label, $arch, $deps); - }; - - # Return an empty list if there were no dependencies defined - if($@) { - return (); - } else { - return split(/\s+/, $deps->{$name}); - } -} - # Install a set of rpms sub _install_rpms { @@ -926,6 +865,9 @@ sub _install_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. + @rpms = map { $_ = $self->_transfer_path($_) } @rpms; + my $g = $self->{g}; eval { $g->command(['rpm', $upgrade == 1 ? '-U' : '-i', @rpms]); @@ -935,6 +877,18 @@ sub _install_rpms die($@) if($@); } +# Get full, local path of a file on the transfer mount +sub _transfer_path +{ + my $self = shift; + + my ($path) = @_; + + $self->_ensure_transfer_mounted(); + + return File::Spec->catfile($self->{transfer_mount}, $path); +} + # Ensure that the transfer device is mounted. If not, mount it. sub _ensure_transfer_mounted { diff --git a/v2v/virt-v2v.pl b/v2v/virt-v2v.pl index cf78523..a0559e9 100755 --- a/v2v/virt-v2v.pl +++ b/v2v/virt-v2v.pl @@ -22,7 +22,9 @@ use strict; use Pod::Usage; use Getopt::Long; #use Data::Dumper; -use Config::Tiny; +use File::Spec; +use File::stat; + use Locale::TextDomain 'virt-v2v'; use Sys::Guestfs; @@ -31,10 +33,11 @@ use Sys::Guestfs::Lib qw(open_guest get_partitions inspect_all_partitions inspect_in_detail); use Sys::VirtV2V; -use Sys::VirtV2V::GuestOS; use Sys::VirtV2V::Converter; use Sys::VirtV2V::Connection::LibVirt; use Sys::VirtV2V::Connection::LibVirtXML; +use Sys::VirtV2V::ExecHelper; +use Sys::VirtV2V::GuestOS; use Sys::VirtV2V::UserMessage qw(user_message); =encoding utf8 @@ -296,10 +299,6 @@ if ($@) { exit(1); } -# Configure GuestOS ([files] and [deps] sections) -# Need to fix GuestOS's usage of config for installing applications -Sys::VirtV2V::GuestOS->configure({}); - ############################################################################### ## Start of processing @@ -311,6 +310,9 @@ exit(1) unless(defined($dom)); # Get a list of the guest's transfered storage devices my @storage = $conn->get_local_storage(); +# Create the transfer iso if required +my $transferiso = get_transfer_iso($config, $config_file); + # Open a libguestfs handle on the guest's storage devices my $g = get_guestfs_handle(\@storage, $transferiso); @@ -321,7 +323,7 @@ $SIG{'QUIT'} = \&close_guest_handle; my $os = inspect_guest($g); # Instantiate a GuestOS instance to manipulate the guest -my $guestos = Sys::VirtV2V::GuestOS->instantiate($g, $os); +my $guestos = Sys::VirtV2V::GuestOS->new($g, $os, $dom, $config); # Modify the guest and its metadata for the target hypervisor Sys::VirtV2V::Converter->convert($vmm, $guestos, $config, $dom, $os); @@ -346,9 +348,85 @@ sub close_guest_handle } } +sub get_transfer_iso +{ + my ($config, $config_file) = @_; + + # Nothing to do if there's no config + return undef unless (defined($config)); + + # path-root doesn't have to be defined + my ($root) = $config->findnodes('/virt-v2v/path-root/text()'); + $root = $root->getData() if (defined($root)); + + # Construct a list of path arguments to mkisofs from paths referenced in the + # config file + # We actually use a hash here to avoid duplicates + my %path_args; + foreach my $path ($config->findnodes('/virt-v2v/app/path/text() | '. + '/virt-v2v/app/dep/text()')) { + $path = $path->getData(); + + # Get the absolute path if iso-root was defined + my $abs; + if (defined($root)) { + $abs = File::Spec->catfile($root, $path); + } else { + $abs = $path; + } + + # Check the referenced path is accessible + die(user_message(__x("Unable to access {path} referenced in ". + "the config file", + path => $path))) unless (-r $abs); + + $path_args{"$path=$abs"} = 1; + } + + # Nothing further to do if there are no paths + return if (keys(%path_args) == 0); + + # Get the path of the transfer iso + my ($iso_path) = $config->findnodes('/virt-v2v/iso-path/text()'); + + # We need this + die(user_message(__"<iso-path> must be specified in the configuration ". + "file")) unless (defined($iso_path)); + $iso_path = $iso_path->getData(); + + # Check that the transfer iso exists, and is newer than the config file + if (-e $iso_path) { + my $iso_st = stat($iso_path) + or die(user_message(__x("Unable to stat iso file {path}: {error}", + path => $iso_path, error => $!))); + + my $config_st = stat($config_file) + or die(user_message(__x("Unable to stat config file {path}: ". + "{error}", + path => $config_file, error => $!))); + + # Don't need to re-create if the iso file is newer than the config file + return $iso_path if ($iso_st->mtime > $config_st->mtime); + } + + # Re-create the transfer iso + my $eh = Sys::VirtV2V::ExecHelper->run + ('mkisofs', '-o', $iso_path, + '-r', '-J', + '-V', '__virt-v2v_transfer__', + '-graft-points', keys(%path_args)); + die(user_message(__x("Failed to create transfer iso. ". + "Command output was:\n{output}", + output => $eh->output()))) unless ($eh->status() == 0); + + return $iso_path; +} + sub get_guestfs_handle { - my $g = open_guest(\@_, rw => 1); + my ($storage, $transferiso) = @_; + + my $g = open_guest($storage, rw => 1); # Add the transfer iso if there is one $g->add_drive($transferiso) if(defined($transferiso)); -- 1.6.6