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 dfa79af..c97fae3 100644 (file)
--- a/perl/lib/Sys/Guestfs/Lib.pm
+++ b/perl/lib/Sys/Guestfs/Lib.pm
@@ -64,7 +64,8 @@ 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_operating_systems mount_operating_system inspect_in_detail
   inspect_linux_kernel);
   inspect_all_partitions inspect_partition
   inspect_operating_systems mount_operating_system inspect_in_detail
   inspect_linux_kernel);


@@ -100,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


@@ -208,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);


@@ -230,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);
 }


@@ -267,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


@@ -569,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


@@ -1494,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}
 


@@ -1558,12 +1568,8 @@ sub _check_for_kernels
                 # Check the kernel was recognised
                 if(defined($kernel)) {
                     # Put this kernel on the top level kernel list
                 # 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;
 
 
                     $config{kernel} = $kernel;
 


@@ -1766,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;
 }