Warn instead of dying if grub refers to non-existent kernel
[libguestfs.git] / perl / lib / Sys / Guestfs / Lib.pm
index 72b0f7d..8ec487d 100644 (file)
@@ -20,6 +20,8 @@ package Sys::Guestfs::Lib;
 use strict;
 use warnings;
 
+use Carp qw(croak);
+
 use Sys::Guestfs;
 use File::Temp qw/tempdir/;
 use Locale::TextDomain 'libguestfs';
@@ -28,6 +30,7 @@ use Locale::TextDomain 'libguestfs';
 eval "use Sys::Virt;";
 eval "use XML::XPath;";
 eval "use XML::XPath::XMLParser;";
+eval "use Win::Hivex;";
 
 =pod
 
@@ -64,9 +67,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,11 +104,10 @@ 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
-passed through to C<Sys::Virt-E<gt>new> unchanged.
+URI.
 
 The implicit libvirt handle is closed after this function, I<unless>
 you call the function in C<wantarray> context, in which case the
@@ -116,6 +120,10 @@ disk image, then C<$conn> and C<$dom> will be C<undef>.
 If the C<Sys::Virt> module is not available, then libvirt is bypassed,
 and this function can only open disk images.
 
+The optional C<interface> parameter can be used to open devices with
+C<add_drive{,_ro}_with_if>.  See
+L<Sys::Guestfs/guestfs_add_drive_with_if> for more details.
+
 =cut
 
 sub open_guest
@@ -124,7 +132,9 @@ sub open_guest
     my $first = shift;
     my %params = @_;
 
-    my $readwrite = $params{rw};
+    my $rw = $params{rw};
+    my $address = $params{address};
+    my $interface = $params{interface};
 
     my @images = ();
     if (ref ($first) eq "ARRAY") {
@@ -132,14 +142,14 @@ sub open_guest
     } elsif (ref ($first) eq "SCALAR") {
         @images = ($first);
     } else {
-        die __"open_guest: first parameter must be a string or an arrayref"
+        croak __"open_guest: first parameter must be a string or an arrayref"
     }
 
     my ($conn, $dom);
 
     if (-e $images[0]) {
         foreach (@images) {
-            die __x("guest image {imagename} does not exist or is not readable",
+            croak __x("guest image {imagename} does not exist or is not readable",
                     imagename => $_)
                 unless -r $_;
         }
@@ -152,12 +162,15 @@ sub open_guest
         die __"open_guest: too many domains listed on command line"
             if @images > 1;
 
-        $conn = Sys::Virt->new (readonly => 1, @_);
+        my @libvirt_args = ();
+        push @libvirt_args, address => $address if defined $address;
+
+        $conn = Sys::Virt->new (readonly => 1, @libvirt_args);
         die __"open_guest: cannot connect to libvirt" unless $conn;
 
         my @doms = $conn->list_defined_domains ();
         my $isitinactive = 1;
-        unless ($readwrite) {
+        unless ($rw) {
             # In the case where we want read-only access to a domain,
             # allow the user to specify an active domain too.
             push @doms, $conn->list_domains ();
@@ -197,16 +210,48 @@ sub open_guest
     # We've now got the list of @images, so feed them to libguestfs.
     my $g = Sys::Guestfs->new ();
     foreach (@images) {
-        if ($readwrite) {
-            $g->add_drive ($_);
+        if ($rw) {
+            if ($interface) {
+                $g->add_drive_with_if ($_, $interface);
+            } else {
+                $g->add_drive ($_);
+            }
         } else {
-            $g->add_drive_ro ($_);
+            if ($interface) {
+                $g->add_drive_ro_with_if ($_, $interface);
+            } else {
+                $g->add_drive_ro ($_);
+            }
         }
     }
 
     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 +274,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 +312,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
@@ -556,44 +576,46 @@ L<virt-inspector(1)> to get useful output.
 
  %fses = inspect_all_partitions ($g, \@partitions);
 
- %fses = inspect_all_partitions ($g, \@partitions, use_windows_registry => 1);
-
 This calls C<inspect_partition> for each partition in the list
 C<@partitions>.
 
 The result is a hash which maps partition name to C<\%fs> hashref.
 
-The contents of the C<%fs> hash and the meaning of the
-C<use_windows_registry> flag are explained below.
+The contents of the C<%fs> hash is 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
 
  \%fs = inspect_partition ($g, $partition);
 
- \%fs = inspect_partition ($g, $partition, use_windows_registry => 1);
-
 This function inspects the device named C<$partition> in isolation and
 tries to determine what it is.  It returns information such as whether
 the partition is formatted, and with what, whether it is mountable,
 and what it appears to contain (eg. a Windows root, or a Linux /usr).
 
-If C<use_windows_registry> is set to 1, then we will try to download
-and parse the content of the Windows registry (for Windows root
-devices).  However since this is an expensive and error-prone
-operation, we don't do this by default.  It also requires the external
-program C<reged>, patched to remove numerous crashing bugs in the
-upstream version.
+If the Perl module L<Win::Hivex(3)> is installed, then additional
+information is made available for Windows guests, if we can locate and
+read their registries.
 
 The returned value is a hashref C<\%fs> which may contain the
 following top-level keys (any key can be missing):
@@ -638,7 +660,7 @@ Operating system distribution.  One of: "fedora", "rhel", "centos",
 =item package_format
 
 (For Linux root partitions only)
-The package format used by the guest distribution. One of: "rpm", "dpkg".
+The package format used by the guest distribution. One of: "rpm", "deb".
 
 =item package_management
 
@@ -680,9 +702,6 @@ sub inspect_partition
     local $_;
     my $g = shift;
     my $dev = shift;           # LV or partition name.
-    my %params = @_;
-
-    my $use_windows_registry = $params{use_windows_registry};
 
     my %r;                     # Result hash.
 
@@ -764,7 +783,7 @@ sub inspect_partition
             $r{fsos} = "windows";
             $r{content} = "windows-root";
             $r{is_root} = 1;
-            _check_windows_root ($g, \%r, $use_windows_registry);
+            _check_windows_root ($g, \%r);
             goto OUT;
         }
     }
@@ -787,6 +806,7 @@ sub _check_linux_root
 
         $_ = $g->cat ("/etc/redhat-release");
         if (/Fedora release (\d+)(?:\.(\d+))?/) {
+            chomp; $r->{product_name} = $_;
             $r->{osdistro} = "fedora";
             $r->{os_major_version} = "$1";
             $r->{os_minor_version} = "$2" if(defined($2));
@@ -794,6 +814,8 @@ sub _check_linux_root
         }
 
         elsif (/(Red Hat Enterprise Linux|CentOS|Scientific Linux)/) {
+            chomp; $r->{product_name} = $_;
+
             my $distro = $1;
 
             if($distro eq "Red Hat Enterprise Linux") {
@@ -842,11 +864,12 @@ sub _check_linux_root
             $r->{osdistro} = "redhat-based";
         }
     } elsif ($g->is_file ("/etc/debian_version")) {
-        $r->{package_format} = "dpkg";
+        $r->{package_format} = "deb";
         $r->{package_management} = "apt";
 
         $_ = $g->cat ("/etc/debian_version");
         if (/(\d+)\.(\d+)/) {
+            chomp; $r->{product_name} = $_;
             $r->{osdistro} = "debian";
             $r->{os_major_version} = "$1";
             $r->{os_minor_version} = "$2";
@@ -893,24 +916,23 @@ sub _check_linux_root
 # Windows installations and their %systemroot%s in a simple text
 # format.
 #
-# XXX We could parse this better.  This won't work if /boot.ini is on
-# a different drive from the %systemroot%, and in other unusual cases.
+# XXX We don't handle the case where /boot.ini is on a different
+# partition very well (Windows Vista and later).
 
 sub _check_windows_root
 {
     local $_;
     my $g = shift;
     my $r = shift;
-    my $use_windows_registry = shift;
 
     my $boot_ini = resolve_windows_path ($g, "/boot.ini");
     $r->{boot_ini} = $boot_ini;
 
+    my $systemroot;
     if (defined $r->{boot_ini}) {
         $_ = $g->cat ($boot_ini);
         my @lines = split /\n/;
         my $section;
-        my $systemroot;
         foreach (@lines) {
             if (m/\[.*\]/) {
                 $section = $1;
@@ -922,17 +944,26 @@ sub _check_windows_root
                 last;
             }
         }
+    }
 
-        if (defined $systemroot) {
-            $r->{systemroot} = resolve_windows_path ($g, "/$systemroot");
-            if (defined $r->{systemroot}) {
-                _check_windows_arch ($g, $r, $r->{systemroot});
-                if ($use_windows_registry) {
-                    _check_windows_registry ($g, $r, $r->{systemroot});
-                }
+    if (!defined $systemroot) {
+        # Last ditch ... try to guess %systemroot% location.
+        foreach ("windows", "winnt") {
+            my $dir = resolve_windows_path ($g, "/$_/system32");
+            if (defined $dir) {
+                $systemroot = $_;
+                last;
             }
         }
     }
+
+    if (defined $systemroot) {
+        $r->{systemroot} = resolve_windows_path ($g, "/$systemroot");
+        if (defined $r->{systemroot}) {
+            _check_windows_arch ($g, $r, $r->{systemroot});
+            _check_windows_registry ($g, $r, $r->{systemroot});
+        }
+    }
 }
 
 # Find Windows userspace arch.
@@ -957,72 +988,90 @@ sub _check_windows_registry
     my $systemroot = shift;
 
     # Download the system registry files.  Only download the
-    # interesting ones, and we don't bother with user profiles at all.
+    # interesting ones (SOFTWARE and SYSTEM).  We don't bother with
+    # the user ones.
 
-    my $configdir = resolve_windows_path ($g, "$systemroot/system32/config");
-    if (defined $configdir) {
-        my $softwaredir = resolve_windows_path ($g, "$configdir/software");
-        if (defined $softwaredir) {
-            _load_windows_registry ($g, $r, $softwaredir,
-                                    "HKEY_LOCAL_MACHINE\\SOFTWARE");
-        }
-        my $systemdir = resolve_windows_path ($g, "$configdir/system");
-        if (defined $systemdir) {
-            _load_windows_registry ($g, $r, $systemdir,
-                                    "HKEY_LOCAL_MACHINE\\System");
-        }
-    }
-}
-
-sub _load_windows_registry
-{
-    local $_;
-    my $g = shift;
-    my $r = shift;
-    my $regfile = shift;
-    my $prefix = shift;
-
-    my $dir = tempdir (CLEANUP => 1);
+    return unless exists $INC{"Win/Hivex.pm"};
 
-    $g->download ($regfile, "$dir/reg");
-
-    # 'reged' command is particularly noisy.  Redirect stdout and
-    # stderr to /dev/null temporarily.
-    open SAVEOUT, ">&STDOUT";
-    open SAVEERR, ">&STDERR";
-    open STDOUT, ">/dev/null";
-    open STDERR, ">/dev/null";
-
-    my @cmd = ("reged", "-x", "$dir/reg", "$prefix", "\\", "$dir/out");
-    my $res = system (@cmd);
+    my $configdir = resolve_windows_path ($g, "$systemroot/system32/config");
+    return unless defined $configdir;
 
-    close STDOUT;
-    close STDERR;
-    open STDOUT, ">&SAVEOUT";
-    open STDERR, ">&SAVEERR";
-    close SAVEOUT;
-    close SAVEERR;
+    my $tmpdir = tempdir (CLEANUP => 1);
 
-    unless ($res == 0) {
-        warn __x("reged command failed: {errormsg}", errormsg => $?);
-        return;
+    my $software = resolve_windows_path ($g, "$configdir/software");
+    my $software_hive;
+    if (defined $software) {
+        eval {
+            $g->download ($software, "$tmpdir/software");
+            $software_hive = Win::Hivex->open ("$tmpdir/software");
+        };
+        warn "$@\n" if $@;
+        $r->{windows_software_hive} = $software;
     }
 
-    # Some versions of reged segfault on inputs.  If that happens we
-    # may get no / partial output file.  Anyway, if it exists, load
-    # it.
-    my $content;
-    unless (open F, "$dir/out") {
-        warn __x("no output from reged command: {errormsg}", errormsg => $!);
-        return;
+    my $system = resolve_windows_path ($g, "$configdir/system");
+    my $system_hive;
+    if (defined $system) {
+        eval {
+            $g->download ($system, "$tmpdir/system");
+            $system_hive = Win::Hivex->open ("$tmpdir/system");
+        };
+        warn "$@\n" if $@;
+        $r->{windows_system_hive} = $system;
     }
-    { local $/ = undef; $content = <F>; }
-    close F;
 
-    my @registry = ();
-    @registry = @{$r->{registry}} if exists $r->{registry};
-    push @registry, $content;
-    $r->{registry} = \@registry;
+    # Get the ProductName, major and minor version, etc.
+    if (defined $software_hive) {
+        my $cv_node;
+        eval {
+            $cv_node = $software_hive->root;
+            $cv_node = $software_hive->node_get_child ($cv_node, $_)
+                foreach ("Microsoft", "Windows NT", "CurrentVersion");
+        };
+        warn "$@\n" if $@;
+
+        if ($cv_node) {
+            my @values = $software_hive->node_values ($cv_node);
+
+            foreach (@values) {
+                my $k = $software_hive->value_key ($_);
+                if ($k eq "ProductName") {
+                    $_ = $software_hive->value_string ($_);
+                    $r->{product_name} = $_ if defined $_;
+                } elsif ($k eq "CurrentVersion") {
+                    $_ = $software_hive->value_string ($_);
+                    if (defined $_ && m/^(\d+)\.(\d+)/) {
+                        $r->{os_major_version} = $1;
+                        $r->{os_minor_version} = $2;
+                    }
+                } elsif ($k eq "CurrentBuild") {
+                    $_ = $software_hive->value_string ($_);
+                    $r->{windows_current_build} = $_ if defined $_;
+                } elsif ($k eq "SoftwareType") {
+                    $_ = $software_hive->value_string ($_);
+                    $r->{windows_software_type} = $_ if defined $_;
+                } elsif ($k eq "CurrentType") {
+                    $_ = $software_hive->value_string ($_);
+                    $r->{windows_current_type} = $_ if defined $_;
+                } elsif ($k eq "RegisteredOwner") {
+                    $_ = $software_hive->value_string ($_);
+                    $r->{windows_registered_owner} = $_ if defined $_;
+                } elsif ($k eq "RegisteredOrganization") {
+                    $_ = $software_hive->value_string ($_);
+                    $r->{windows_registered_organization} = $_ if defined $_;
+                } elsif ($k eq "InstallationType") {
+                    $_ = $software_hive->value_string ($_);
+                    $r->{windows_installation_type} = $_ if defined $_;
+                } elsif ($k eq "EditionID") {
+                    $_ = $software_hive->value_string ($_);
+                    $r->{windows_edition_id} = $_ if defined $_;
+                } elsif ($k eq "ProductID") {
+                    $_ = $software_hive->value_string ($_);
+                    $r->{windows_product_id} = $_ if defined $_;
+                }
+            }
+        }
+    }
 }
 
 sub _check_grub
@@ -1070,6 +1119,10 @@ Operating system userspace architecture, eg. "i386", "x86_64".
 
 Operating system distribution, eg. "debian".
 
+=item product_name
+
+Free text product name.
+
 =item major_version
 
 Operating system major version, eg. "4".
@@ -1141,6 +1194,8 @@ sub _get_os_version
     my $r = shift;
 
     $r->{os} = $r->{root}->{fsos} if exists $r->{root}->{fsos};
+    $r->{product_name} = $r->{root}->{product_name}
+        if exists $r->{root}->{product_name};
     $r->{distro} = $r->{root}->{osdistro} if exists $r->{root}->{osdistro};
     $r->{major_version} = $r->{root}->{os_major_version}
         if exists $r->{root}->{os_major_version};
@@ -1271,7 +1326,7 @@ sub mount_operating_system
             if($ro) {
                 $g->mount_ro ($mounts->{$_}, $_)
             } else {
-                $g->mount ($mounts->{$_}, $_)
+                $g->mount_options ("", $mounts->{$_}, $_)
             }
         }
     }
@@ -1330,7 +1385,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
 
@@ -1404,14 +1463,21 @@ sub _check_for_applications
     if ($osn eq "linux") {
         my $package_format = $os->{package_format};
         if (defined $package_format && $package_format eq "rpm") {
-            my @lines = $g->command_lines
-                (["rpm",
-                  "-q", "-a",
-                  "--qf", "%{name} %{epoch} %{version} %{release} %{arch}\n"]);
+            my @lines = ();
+            eval {
+                @lines = $g->command_lines
+                    (["rpm",
+                      "-q", "-a", "--qf",
+                      "%{name} %{epoch} %{version} %{release} %{arch}\n"]);
+            };
+
+            warn(__x("Error running rpm -qa: {error}", error => $@)) if ($@);
+
+            @lines = sort @lines;
             foreach (@lines) {
                 if (m/^(.*) (.*) (.*) (.*) (.*)$/) {
                     my $epoch = $2;
-                    $epoch = "" if $epoch eq "(none)";
+                    undef $epoch if $epoch eq "(none)";
                     my $app = {
                         name => $1,
                         epoch => $epoch,
@@ -1422,6 +1488,30 @@ sub _check_for_applications
                     push @apps, $app
                 }
             }
+        } elsif (defined $package_format && $package_format eq "deb") {
+            my @lines = ();
+            eval {
+                @lines = $g->command_lines
+                    (["dpkg-query",
+                      "-f", '${Package} ${Version} ${Architecture} ${Status}\n',
+                      "-W"]);
+            };
+
+            warn(__x("Error running dpkg-query: {error}", error => $@)) if ($@);
+
+            @lines = sort @lines;
+            foreach (@lines) {
+                if (m/^(.*) (.*) (.*) (.*) (.*) (.*)$/) {
+                    if ( $6 eq "installed" ) {
+                        my $app = {
+                            name => $1,
+                            version => $2,
+                            arch => $3
+                        };
+                        push @apps, $app
+                    }
+                }
+            }
         }
     } elsif ($osn eq "windows") {
         # XXX
@@ -1435,14 +1525,72 @@ 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 $grub_conf = "/etc/grub.conf";
+
+        # Debian and other's have no /etc/grub.conf:
+        if ( ! -f "$grub_conf" ) {
+            $grub_conf = "$grub/grub/menu.lst";
+        }
+
         my @boot_configs;
 
         # We want
@@ -1454,13 +1602,14 @@ 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);
 
         my @configs = ();
         # Get all configurations from grub
         foreach my $bootable
-            ($g->aug_match("/files/etc/grub.conf/title"))
+            ($g->aug_match("/files/$grub_conf/title"))
         {
             my %config = ();
             $config{title} = $g->aug_get($bootable);
@@ -1474,7 +1623,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 +1643,21 @@ sub _check_for_kernels
                 }
                 $config{cmdline} = join(' ', @args) if(scalar(@args) > 0);
 
-                my $kernel = _inspect_linux_kernel($g, $os, "$path");
+                my $kernel;
+                if ($g->exists($path)) {
+                    $kernel =
+                        inspect_linux_kernel($g, $path, $os->{package_format});
+                } else {
+                    warn __x("grub refers to {path}, which doesn't exist\n",
+                             path => $path);
+                }
 
                 # 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 +1668,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,14 +1684,12 @@ sub _check_for_kernels
         # Create the top level boot entry
         my %boot;
         $boot{configs} = \@configs;
+        $boot{grub_fs} = $grub;
 
         # Add the default configuration
         eval {
-            $boot{default} = $g->aug_get("/files/etc/grub.conf/default");
+            $boot{default} = $g->aug_get("/files/$grub_conf/default");
         };
-        if($@) {
-            warn __"No grub default specified";
-        }
 
         $os->{boot} = \%boot;
     }
@@ -1541,9 +1699,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 +1720,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 +1777,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;
 }
 
@@ -1683,7 +1843,7 @@ sub _inspect_initrd
     # Disregard old-style compressed ext2 files and only work with real
     # compressed cpio files, since cpio takes ages to (fail to) process anything
     # else.
-    if ($g->file ($path) =~ /cpio/) {
+    if ($g->exists($path) && $g->file($path) =~ /cpio/) {
         eval {
             @modules = $g->initrd_list ($path);
         };
@@ -1696,13 +1856,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;
 }