tools: Specify format of disks (RHBZ#642934,CVE-2010-3851).
[libguestfs.git] / perl / lib / Sys / Guestfs / Lib.pm
index 2864bfa..2292839 100644 (file)
@@ -1,5 +1,5 @@
 # Sys::Guestfs::Lib
-# Copyright (C) 2009 Red Hat Inc.
+# Copyright (C) 2009-2010 Red Hat Inc.
 #
 # This library is free software; you can redistribute it and/or
 # modify it under the terms of the GNU Lesser General Public
@@ -20,6 +20,15 @@ package Sys::Guestfs::Lib;
 use strict;
 use warnings;
 
+# The minor part of this version number is incremented when some
+# change is made to this module.  The major part is incremented if we
+# make a change which is not backwards compatible.  It is not related
+# to the libguestfs version number.
+use vars qw($VERSION);
+$VERSION = '0.2';
+
+use Carp qw(croak);
+
 use Sys::Guestfs;
 use File::Temp qw/tempdir/;
 use Locale::TextDomain 'libguestfs';
@@ -28,6 +37,7 @@ use Locale::TextDomain 'libguestfs';
 eval "use Sys::Virt;";
 eval "use XML::XPath;";
 eval "use XML::XPath::XMLParser;";
+eval "use Win::Hivex;";
 
 =pod
 
@@ -78,7 +88,7 @@ use vars qw(@EXPORT_OK @ISA);
 
  $g = open_guest ($name, address => $uri, ...);
 
- $g = open_guest ([$img1, $img2, ...], address => $uri, ...);
+ $g = open_guest ([$img1, $img2, ...], address => $uri, format => $format, ...);
 
  ($g, $conn, $dom, @images) = open_guest ($name);
 
@@ -93,7 +103,8 @@ block.
 
 The first parameter is either a string referring to a libvirt domain
 or a disk image, or (if a guest has several disk images) an arrayref
-C<[$img1, $img2, ...]>.
+C<[$img1, $img2, ...]>.  For disk images, if the C<format> parameter
+is specified then that format is forced.
 
 The handle is I<read-only> by default.  Use the optional parameter
 C<rw =E<gt> 1> to open a read-write handle.  However if you open a
@@ -110,16 +121,16 @@ The implicit libvirt handle is closed after this function, I<unless>
 you call the function in C<wantarray> context, in which case the
 function returns a tuple of: the open libguestfs handle, the open
 libvirt handle, and the open libvirt domain handle, and a list of
-images.  (This is useful if you want to do other things like pulling
-the XML description of the guest).  Note that if this is a straight
-disk image, then C<$conn> and C<$dom> will be C<undef>.
+[image,format] pairs.  (This is useful if you want to do other things
+like pulling the XML description of the guest).  Note that if this is
+a straight 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.
+The optional C<interface> parameter can be used to open devices with a
+specified qemu interface.  See L<Sys::Guestfs/guestfs_add_drive_opts>
+for more details.
 
 =cut
 
@@ -132,6 +143,7 @@ sub open_guest
     my $rw = $params{rw};
     my $address = $params{address};
     my $interface = $params{interface};
+    my $format = $params{format}; # undef == autodetect
 
     my @images = ();
     if (ref ($first) eq "ARRAY") {
@@ -139,17 +151,26 @@ 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"
+    }
+
+    # Check each element of @images is defined.
+    # (See https://bugzilla.redhat.com/show_bug.cgi?id=601092#c3).
+    foreach (@images) {
+        croak __"open_guest: first argument contains undefined element"
+            unless defined $_;
     }
 
     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 $_;
         }
+
+        @images = map { [ $_, $format ] } @images;
     } else {
         die __"open_guest: no libvirt support (install Sys::Virt, XML::XPath and XML::XPath::XMLParser)"
             unless exists $INC{"Sys/Virt.pm"} &&
@@ -194,32 +215,41 @@ sub open_guest
         my $xml = $dom->get_xml_description ();
 
         my $p = XML::XPath->new (xml => $xml);
-        my @disks = $p->findnodes ('//devices/disk/source/@dev');
-        push (@disks, $p->findnodes ('//devices/disk/source/@file'));
+        my $nodes = $p->find ('//devices/disk');
+
+        my @disks = ();
+        my $node;
+        foreach $node ($nodes->get_nodelist) {
+            # The filename can be in dev or file attribute, hence:
+            my $filename = $p->find ('./source/@dev', $node);
+            unless ($filename) {
+                $filename = $p->find ('./source/@file', $node);
+                next unless $filename;
+            }
+            $filename = $filename->to_literal;
+
+            # Get the disk format (may not be set).
+            my $format = $p->find ('./driver/@type', $node);
+            $format = $format->to_literal if $format;
+
+            push @disks, [ $filename, $format ];
+        }
 
         die __x("{imagename} seems to have no disk devices\n",
                 imagename => $images[0])
             unless @disks;
 
-        @images = map { $_->getData } @disks;
+        @images = @disks;
     }
 
     # We've now got the list of @images, so feed them to libguestfs.
     my $g = Sys::Guestfs->new ();
     foreach (@images) {
-        if ($rw) {
-            if ($interface) {
-                $g->add_drive_with_if ($_, $interface);
-            } else {
-                $g->add_drive ($_);
-            }
-        } else {
-            if ($interface) {
-                $g->add_drive_ro_with_if ($_, $interface);
-            } else {
-                $g->add_drive_ro ($_);
-            }
-        }
+        my @args = ($_->[0]);
+        push @args, format => $_->[1] if defined $_->[1];
+        push @args, readonly => 1 unless $rw;
+        push @args, iface => $interface if defined $interface;
+        $g->add_drive_opts (@args);
     }
 
     return wantarray ? ($g, $conn, $dom, @images) : $g
@@ -257,16 +287,27 @@ This function takes an open libguestfs handle C<$g> and returns all
 partitions and logical volumes found on it.
 
 What is returned is everything that could contain a filesystem (or
-swap).  Physical volumes are excluded from the list, and so are any
-devices which are partitioned (eg. C</dev/sda> would not be returned
-if C</dev/sda1> exists).
+swap).  Physical volumes are not normally included from the list
+except if they contain a filesystem directly.  Nor are devices which
+are partitioned (eg. C</dev/sda> would not be returned if C</dev/sda1>
+exists).
 
 =cut
 
 sub get_partitions
 {
+    local $_;
     my $g = shift;
 
+    # Look to see if any devices directly contain filesystems (RHBZ#590167).
+    my @devices = $g->list_devices ();
+    my @fses_on_device = ();
+    foreach (@devices) {
+        eval { $g->mount_ro ($_, "/"); };
+        push @fses_on_device, $_ unless $@;
+        $g->umount_all ();
+    }
+
     my @partitions = $g->list_partitions ();
     my @pvs = $g->pvs ();
     @partitions = grep { ! _is_pv ($_, @pvs) } @partitions;
@@ -274,7 +315,7 @@ sub get_partitions
     my @lvs;
     @lvs = $g->lvs () if feature_available ($g, "lvm2");
 
-    return sort (@lvs, @partitions);
+    return sort (@fses_on_device, @lvs, @partitions);
 }
 
 sub _is_pv {
@@ -319,159 +360,18 @@ sub resolve_windows_path
 
 =head2 file_architecture
 
- $arch = file_architecture ($g, $path)
-
-The C<file_architecture> function lets you get the architecture for a
-particular binary or library in the guest.  By "architecture" we mean
-what processor it is compiled for (eg. C<i586> or C<x86_64>).
-
-The function works on at least the following types of files:
-
-=over 4
-
-=item *
-
-many types of Un*x binary
-
-=item *
-
-many types of Un*x shared library
-
-=item *
-
-Windows Win32 and Win64 binaries
-
-=item *
-
-Windows Win32 and Win64 DLLs
+Deprecated function.  Replace any calls to this function with:
 
-Win32 binaries and DLLs return C<i386>.
-
-Win64 binaries and DLLs return C<x86_64>.
-
-=item *
-
-Linux kernel modules
-
-=item *
-
-Linux new-style initrd images
-
-=item *
-
-some non-x86 Linux vmlinuz kernels
-
-=back
-
-What it can't do currently:
-
-=over 4
-
-=item *
-
-static libraries (libfoo.a)
-
-=item *
-
-Linux old-style initrd as compressed ext2 filesystem (RHEL 3)
-
-=item *
-
-x86 Linux vmlinuz kernels
-
-x86 vmlinuz images (bzImage format) consist of a mix of 16-, 32- and
-compressed code, and are horribly hard to unpack.  If you want to find
-the architecture of a kernel, use the architecture of the associated
-initrd or kernel module(s) instead.
-
-=back
+ $g->file_architecture ($path);
 
 =cut
 
-sub _elf_arch_to_canonical
-{
-    local $_ = shift;
-
-    if ($_ eq "Intel 80386") {
-        return "i386";
-    } elsif ($_ eq "Intel 80486") {
-        return "i486"; # probably not in the wild
-    } elsif ($_ eq "x86-64") {
-        return "x86_64";
-    } elsif ($_ eq "AMD x86-64") {
-        return "x86_64";
-    } elsif (/SPARC32/) {
-        return "sparc";
-    } elsif (/SPARC V9/) {
-        return "sparc64";
-    } elsif ($_ eq "IA-64") {
-        return "ia64";
-    } elsif (/64.*PowerPC/) {
-        return "ppc64";
-    } elsif (/PowerPC/) {
-        return "ppc";
-    } else {
-        warn __x("returning non-canonical architecture type '{arch}'",
-                 arch => $_);
-        return $_;
-    }
-}
-
-my @_initrd_binaries = ("nash", "modprobe", "sh", "bash");
-
 sub file_architecture
 {
-    local $_;
     my $g = shift;
     my $path = shift;
 
-    # Our basic tool is 'file' ...
-    my $file = $g->file ($path);
-
-    if ($file =~ /ELF.*(?:executable|shared object|relocatable), (.+?),/) {
-        # ELF executable or shared object.  We need to convert
-        # what file(1) prints into the canonical form.
-        return _elf_arch_to_canonical ($1);
-    } elsif ($file =~ /PE32 executable/) {
-        return "i386";         # Win32 executable or DLL
-    } elsif ($file =~ /PE32\+ executable/) {
-        return "x86_64";       # Win64 executable or DLL
-    }
-
-    elsif ($file =~ /cpio archive/) {
-        # Probably an initrd.
-        my $zcat = "cat";
-        if ($file =~ /gzip/) {
-            $zcat = "zcat";
-        } elsif ($file =~ /bzip2/) {
-            $zcat = "bzcat";
-        }
-
-        # Download and unpack it to find a binary file.
-        my $dir = tempdir (CLEANUP => 1);
-        $g->download ($path, "$dir/initrd");
-
-        my $bins = join " ", map { "bin/$_" } @_initrd_binaries;
-        my $cmd = "cd $dir && $zcat initrd | cpio --quiet -id $bins";
-        my $r = system ($cmd);
-        die __x("cpio command failed: {error}", error => $?)
-            unless $r == 0;
-
-        foreach my $bin (@_initrd_binaries) {
-            if (-f "$dir/bin/$bin") {
-                $_ = `file $dir/bin/$bin`;
-                if (/ELF.*executable, (.+?),/) {
-                    return _elf_arch_to_canonical ($1);
-                }
-            }
-        }
-
-        die __x("file_architecture: no known binaries found in initrd image: {path}",
-                path => $path);
-    }
-
-    die __x("file_architecture: unknown architecture: {path}",
-            path => $path);
+    return $g->file_architecture ($path);
 }
 
 =head1 OPERATING SYSTEM INSPECTION FUNCTIONS
@@ -573,15 +473,12 @@ 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
 
@@ -601,26 +498,21 @@ sub inspect_all_partitions
     my $g = shift;
     my $parts = shift;
     my @parts = @$parts;
-    return map { _canonical_dev ($_) => 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):
@@ -665,7 +557,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
 
@@ -707,9 +599,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.
 
@@ -791,7 +680,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;
         }
     }
@@ -814,6 +703,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));
@@ -821,6 +711,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") {
@@ -869,11 +761,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";
@@ -920,24 +813,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;
@@ -949,17 +841,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.
@@ -984,72 +885,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;
+    return unless exists $INC{"Win/Hivex.pm"};
 
-    my $dir = tempdir (CLEANUP => 1);
-
-    $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
@@ -1079,7 +998,8 @@ like:
    '/dev/VG/Root' => \%os,
  }
 
-(There can be multiple roots for a multi-boot VM).
+There can be multiple roots for a multi-boot VM, but this function
+will throw an error if no roots (ie. OSes) could be found.
 
 The C<\%os> hash contains the following keys (any can be omitted):
 
@@ -1097,6 +1017,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".
@@ -1158,6 +1082,11 @@ sub inspect_operating_systems
         }
     }
 
+    # If we didn't find any operating systems then it's an error (RHBZ#591142).
+    if (0 == keys %oses) {
+        die __"No operating system could be detected inside this disk image.\n\nThis may be because the file is not a disk image, or is not a virtual machine\nimage, or because the OS type is not understood by virt-inspector.\n\nIf you feel this is an error, please file a bug report including as much\ninformation about the disk image as possible.\n";
+    }
+
     return \%oses;
 }
 
@@ -1168,6 +1097,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};
@@ -1435,10 +1366,17 @@ 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;
@@ -1453,6 +1391,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
@@ -1584,8 +1546,14 @@ sub _check_for_kernels
                 }
                 $config{cmdline} = join(' ', @args) if(scalar(@args) > 0);
 
-                my $kernel =
-                    inspect_linux_kernel($g, $path, $os->{package_format});
+                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)) {
@@ -1625,9 +1593,6 @@ sub _check_for_kernels
         eval {
             $boot{default} = $g->aug_get("/files/$grub_conf/default");
         };
-        if($@) {
-            warn __"No grub default specified";
-        }
 
         $os->{boot} = \%boot;
     }
@@ -1734,13 +1699,6 @@ sub _find_modprobe_aliases
     # Initialise augeas
     $g->aug_init("/", 16);
 
-    # Register additional paths to the Modprobe lens
-    $g->aug_set("/augeas/load/Modprobe/incl[last()+1]", "/etc/modules.conf");
-    $g->aug_set("/augeas/load/Modprobe/incl[last()+1]", "/etc/conf.modules");
-
-    # Make augeas reload
-    $g->aug_load();
-
     my %modprobe_aliases;
 
     for my $pattern qw(/files/etc/conf.modules/alias
@@ -1781,7 +1739,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);
         };