build: update gnulib submodule to latest

[libguestfs.git] / perl / lib / Sys / Guestfs / Lib.pm

diff --git a/perl/lib/Sys/Guestfs/Lib.pm b/perl/lib/Sys/Guestfs/Lib.pm
index 1f84bc6..c97fae3 100644 (file)
--- a/perl/lib/Sys/Guestfs/Lib.pm
+++ b/perl/lib/Sys/Guestfs/Lib.pm
@@ -64,9 +64,11 @@ require Exporter;
 use vars qw(@EXPORT_OK @ISA);
 
 @ISA = qw(Exporter);
 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_all_partitions inspect_partition

-  inspect_operating_systems mount_operating_system inspect_in_detail);
+  inspect_operating_systems mount_operating_system inspect_in_detail
+  inspect_linux_kernel);

 
 =head2 open_guest
 
 
 =head2 open_guest
 


@@ -99,7 +101,7 @@ read-write handle, this function will refuse to use active libvirt
 domains.
 
 The handle is still in the config state when it is returned, so you
 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
 
 The optional C<address> parameter can be added to specify the libvirt
 URI.  In addition, L<Sys::Virt(3)> lists other parameters which are


@@ -207,6 +209,30 @@ sub open_guest
     return wantarray ? ($g, $conn, $dom, @images) : $g
 }
 
     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);
 =head2 get_partitions
 
  @partitions = get_partitions ($g);


@@ -229,7 +255,8 @@ sub get_partitions
     my @pvs = $g->pvs ();
     @partitions = grep { ! _is_pv ($_, @pvs) } @partitions;
 
     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);
 }
 
     return sort (@lvs, @partitions);
 }


@@ -266,38 +293,12 @@ by C</> characters.  Do not use C<\>, drive names, etc.
 
 sub resolve_windows_path
 {
 
 sub resolve_windows_path
 {

-    local $_;

     my $g = shift;
     my $path = shift;
 
     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
 }
 
 =head2 file_architecture


@@ -568,13 +569,23 @@ C<use_windows_registry> flag are explained below.
 
 =cut
 
 
 =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;
 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
 }
 
 =head2 inspect_partition


@@ -1493,7 +1504,7 @@ sub _check_for_kernels
 {
     my ($g, $os) = @_;
 
 {
     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}
 
         # Iterate over entries in grub.conf, populating $os->{boot}
         # For every kernel we find, inspect it and add to $os->{kernels}
 


@@ -1551,10 +1562,15 @@ sub _check_for_kernels
                 }
                 $config{cmdline} = join(' ', @args) if(scalar(@args) > 0);
 
                 }
                 $config{cmdline} = join(' ', @args) if(scalar(@args) > 0);
 

-                my $kernel = _inspect_linux_kernel($g, $os, "$path");
+                my $kernel =
+                    inspect_linux_kernel($g, $path, $os->{package_format});

 
                 # Check the kernel was recognised
                 if(defined($kernel)) {
 
                 # Check the kernel was recognised
                 if(defined($kernel)) {

+                    # Put this kernel on the top level kernel list
+                    $os->{kernels} ||= [];
+                    push(@{$os->{kernels}}, $kernel);
+

                     $config{kernel} = $kernel;
 
                     # Look for an initrd entry
                     $config{kernel} = $kernel;
 
                     # Look for an initrd entry


@@ -1599,9 +1615,19 @@ sub _check_for_kernels
     }
 }
 
     }
 }
 

-sub _inspect_linux_kernel
+=head2 inspect_linux_kernel
+
+ my $kernel_hash = inspect_linux_kernel($g, $vmlinuz_path, $package_format);
+
+inspect_linux_kernel returns a hash describing the target linux kernel. For the
+contents of the hash, see the I<kernels> structure described under
+L</inspect_in_detail>.
+
+=cut
+
+sub inspect_linux_kernel

 {
 {

-    my ($g, $os, $path) = @_;
+    my ($g, $path, $package_format) = @_;

 
     my %kernel = ();
 
 
     my %kernel = ();
 


@@ -1610,7 +1636,7 @@ sub _inspect_linux_kernel
     # If this is a packaged kernel, try to work out the name of the package
     # which installed it. This lets us know what to install to replace it with,
     # e.g. kernel, kernel-smp, kernel-hugemem, kernel-PAE
     # If this is a packaged kernel, try to work out the name of the package
     # which installed it. This lets us know what to install to replace it with,
     # e.g. kernel, kernel-smp, kernel-hugemem, kernel-PAE

-    if($os->{package_format} eq "rpm") {
+    if($package_format eq "rpm") {

         my $package;
         eval { $package = $g->command(['rpm', '-qf', '--qf',
                                        '%{NAME}', $path]); };
         my $package;
         eval { $package = $g->command(['rpm', '-qf', '--qf',
                                        '%{NAME}', $path]); };


@@ -1667,14 +1693,6 @@ sub _inspect_linux_kernel
     # of any kernel module.
     $kernel{arch} = file_architecture ($g, $any_module);
 
     # of any kernel module.
     $kernel{arch} = file_architecture ($g, $any_module);
 

-    # Put this kernel on the top level kernel list
-    my $kernels = $os->{kernels};
-    if(!defined($kernels)) {
-        $kernels = [];
-        $os->{kernels} = $kernels;
-    }
-    push(@$kernels, \%kernel);
-

     return \%kernel;
 }
 
     return \%kernel;
 }
 


@@ -1754,13 +1772,8 @@ sub _inspect_initrd
     }
 
     # Add to the top level initrd_modules entry
     }
 
     # 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;
 }
 
     return \@modules;
 }