X-Git-Url: http://git.annexia.org/?p=libguestfs.git;a=blobdiff_plain;f=perl%2Flib%2FSys%2FGuestfs%2FLib.pm;h=49c08b39c57161398512675979bc9aa11b6a4a54;hp=72b0f7df6debaab0913a9c8108b3f04ba3be64c8;hb=a59dcdbd1b0a28c960e3792165a13f2daf4f6c35;hpb=2f1a50d81671810256dce0852e6b1e0810ac44af

diff --git a/perl/lib/Sys/Guestfs/Lib.pm b/perl/lib/Sys/Guestfs/Lib.pm
index 72b0f7d..49c08b3 100644
--- 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);
-@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_operating_systems mount_operating_system inspect_in_detail
+  inspect_linux_kernel);
 
 =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
-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
@@ -207,6 +209,30 @@ sub open_guest
     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);
@@ -229,7 +255,8 @@ sub get_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);
 }
@@ -266,38 +293,12 @@ by C</> characters.  Do not use C<\>, drive names, etc.
 
 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
@@ -568,13 +569,23 @@ C<use_windows_registry> flag are explained below.
 
 =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
@@ -1330,7 +1341,11 @@ The kernel command line.
 
 =item default
 
-The index of the default configuration in the configs array
+The index of the default configuration in the configs array.
+
+=item grub_fs
+
+The path of the filesystem containing the grub partition.
 
 =back
 
@@ -1411,7 +1426,7 @@ sub _check_for_applications
             foreach (@lines) {
                 if (m/^(.*) (.*) (.*) (.*) (.*)$/) {
                     my $epoch = $2;
-                    $epoch = "" if $epoch eq "(none)";
+                    undef $epoch if $epoch eq "(none)";
                     my $app = {
                         name => $1,
                         epoch => $epoch,
@@ -1435,14 +1450,66 @@ sub _check_for_applications
     $os->{apps} = \@apps;
 }
 
+# Find the path which needs to be prepended to paths in grub.conf to make them
+# absolute
+sub _find_grub_prefix
+{
+    my ($g, $os) = @_;
+
+    my $fses = $os->{filesystems};
+    die("filesystems undefined") unless(defined($fses));
+
+    # Look for the filesystem which contains grub
+    my $grubdev;
+    foreach my $dev (keys(%$fses)) {
+        my $fsinfo = $fses->{$dev};
+        if(exists($fsinfo->{content}) && $fsinfo->{content} eq "linux-grub") {
+            $grubdev = $dev;
+            last;
+        }
+    }
+
+    my $mounts = $os->{mounts};
+    die("mounts undefined") unless(defined($mounts));
+
+    # Find where the filesystem is mounted
+    if(defined($grubdev)) {
+        foreach my $mount (keys(%$mounts)) {
+            if($mounts->{$mount} eq $grubdev) {
+                return "" if($mount eq '/');
+                return $mount;
+            }
+        }
+
+        die("$grubdev defined in filesystems, but not in mounts");
+    }
+
+    # If we didn't find it, look for /boot/grub/menu.lst, then try to work out
+    # what filesystem it's on. We use menu.lst rather than grub.conf because
+    # debian only uses menu.lst, and anaconda creates a symlink for it.
+    die(__"Can't find grub on guest") unless($g->exists('/boot/grub/menu.lst'));
+
+    # Look for the most specific mount point in mounts
+    foreach my $path qw(/boot/grub /boot /) {
+        if(exists($mounts->{$path})) {
+            return "" if($path eq '/');
+            return $path;
+        }
+    }
+
+    die("Couldn't determine which filesystem holds /boot/grub/menu.lst");
+}
+
 sub _check_for_kernels
 {
     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}
 
+        my $grub = _find_grub_prefix($g, $os);
+
         my @boot_configs;
 
         # We want
@@ -1454,6 +1521,7 @@ sub _check_for_kernels
         #           ->{cmdline} = "ro root=/dev/mapper/vg_mbooth-lv_root rhgb"
         #           ->{initrd}  = \initrd
         #       ->{default} = \config
+        #       ->{grub_fs} = "/boot"
         # Initialise augeas
         $g->aug_init("/", 16);
 
@@ -1474,7 +1542,7 @@ sub _check_for_kernels
 
             # Check we've got a kernel entry
             if(defined($grub_kernel)) {
-                my $path = "/boot$grub_kernel";
+                my $path = "$grub$grub_kernel";
 
                 # Reconstruct the kernel command line
                 my @args = ();
@@ -1494,10 +1562,15 @@ sub _check_for_kernels
                 }
                 $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)) {
+                    # Put this kernel on the top level kernel list
+                    $os->{kernels} ||= [];
+                    push(@{$os->{kernels}}, $kernel);
+
                     $config{kernel} = $kernel;
 
                     # Look for an initrd entry
@@ -1508,7 +1581,7 @@ sub _check_for_kernels
 
                     unless($@) {
                         $config{initrd} =
-                            _inspect_initrd($g, $os, "/boot$initrd",
+                            _inspect_initrd($g, $os, "$grub$initrd",
                                             $kernel->{version});
                     } else {
                         warn __x("Grub entry {title} does not specify an ".
@@ -1524,6 +1597,7 @@ sub _check_for_kernels
         # Create the top level boot entry
         my %boot;
         $boot{configs} = \@configs;
+        $boot{grub_fs} = $grub;
 
         # Add the default configuration
         eval {
@@ -1541,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 = ();
 
@@ -1552,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($os->{package_format} eq "rpm") {
+    if($package_format eq "rpm") {
         my $package;
         eval { $package = $g->command(['rpm', '-qf', '--qf',
                                        '%{NAME}', $path]); };
@@ -1609,14 +1693,6 @@ sub _inspect_linux_kernel
     # 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;
 }
 
@@ -1696,13 +1772,8 @@ sub _inspect_initrd
     }
 
     # 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;
 }