[Libguestfs] [PATCH 6/6] Fix application installation by GuestOS
Matthew Booth
mbooth at redhat.com
Tue Feb 9 16:01:19 UTC 2010
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
More information about the Libguestfs
mailing list