use vars qw(@EXPORT_OK @ISA);
@ISA = qw(Exporter);
-@EXPORT_OK = qw(open_guest get_partitions resolve_windows_path
+@EXPORT_OK = qw(open_guest feature_available
+ get_partitions resolve_windows_path
inspect_all_partitions inspect_partition
inspect_operating_systems mount_operating_system inspect_in_detail
inspect_linux_kernel);
domains.
The handle is still in the config state when it is returned, so you
-have to call C<$g-E<gt>launch ()> and C<$g-E<gt>wait_ready>.
+have to call C<$g-E<gt>launch ()>.
The optional C<address> parameter can be added to specify the libvirt
URI. In addition, L<Sys::Virt(3)> lists other parameters which are
return wantarray ? ($g, $conn, $dom, @images) : $g
}
+=head2 feature_available
+
+ $bool = feature_available ($g, $feature [, $feature ...]);
+
+This function is a useful wrapper around the basic
+C<$g-E<gt>available> call.
+
+C<$g-E<gt>available> tests for availability of a list of features and
+dies with an error if any is not available.
+
+This call tests for the list of features and returns true if all are
+available, or false otherwise.
+
+For a list of features you can test for, see L<guestfs(3)/AVAILABILITY>.
+
+=cut
+
+sub feature_available {
+ my $g = shift;
+
+ eval { $g->available (\@_); };
+ return $@ ? 0 : 1;
+}
+
=head2 get_partitions
@partitions = get_partitions ($g);
my @pvs = $g->pvs ();
@partitions = grep { ! _is_pv ($_, @pvs) } @partitions;
- my @lvs = $g->lvs ();
+ my @lvs;
+ @lvs = $g->lvs () if feature_available ($g, "lvm2");
return sort (@lvs, @partitions);
}
sub resolve_windows_path
{
- local $_;
my $g = shift;
my $path = shift;
- if (substr ($path, 0, 1) ne "/") {
- warn __"resolve_windows_path: path must start with a / character";
- return undef;
- }
-
- my @elems = split (/\//, $path);
- shift @elems;
-
- # Start reconstructing the path at the top.
- $path = "/";
-
- foreach my $dir (@elems) {
- my $found = 0;
- foreach ($g->ls ($path)) {
- if (lc ($_) eq lc ($dir)) {
- if ($path eq "/") {
- $path = "/$_";
- $found = 1;
- } else {
- $path = "$path/$_";
- $found = 1;
- }
- }
- }
- return undef unless $found;
- }
-
- return $path;
+ my $r;
+ eval { $r = $g->case_sensitive_path ($path); };
+ return $r;
}
=head2 file_architecture
=cut
+# Turn /dev/vd* and /dev/hd* into canonical device names
+# (see BLOCK DEVICE NAMING in guestfs(3)).
+
+sub _canonical_dev ($)
+{
+ my ($dev) = @_;
+ return "/dev/sd$1" if $dev =~ m{^/dev/[vh]d(\w+)};
+ return $dev;
+}
+
sub inspect_all_partitions
{
local $_;
my $g = shift;
my $parts = shift;
my @parts = @$parts;
- return map { $_ => inspect_partition ($g, $_, @_) } @parts;
+ return map { _canonical_dev ($_) => inspect_partition ($g, $_, @_) } @parts;
}
=head2 inspect_partition
foreach (@lines) {
if (m/^(.*) (.*) (.*) (.*) (.*)$/) {
my $epoch = $2;
- $epoch = "" if $epoch eq "(none)";
+ undef $epoch if $epoch eq "(none)";
my $app = {
name => $1,
epoch => $epoch,
{
my ($g, $os) = @_;
- if ($os->{os} eq "linux") {
+ if ($os->{os} eq "linux" && feature_available ($g, "augeas")) {
# Iterate over entries in grub.conf, populating $os->{boot}
# For every kernel we find, inspect it and add to $os->{kernels}
# Check the kernel was recognised
if(defined($kernel)) {
# Put this kernel on the top level kernel list
- my $kernels = $os->{kernels};
- if(!defined($kernels)) {
- $kernels = [];
- $os->{kernels} = $kernels;
- }
- push(@$kernels, $kernel);
+ $os->{kernels} ||= [];
+ push(@{$os->{kernels}}, $kernel);
$config{kernel} = $kernel;
}
# Add to the top level initrd_modules entry
- my $initrd_modules = $os->{initrd_modules};
- if(!defined($initrd_modules)) {
- $initrd_modules = {};
- $os->{initrd_modules} = $initrd_modules;
- }
-
- $initrd_modules->{$version} = \@modules;
+ $os->{initrd_modules} ||= {};
+ $os->{initrd_modules}->{$version} = \@modules;
return \@modules;
}