perl: Fix another place where qw() was used as parentheses.

[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 96ada0d..fc6a10f 100644 (file)
--- a/perl/lib/Sys/Guestfs/Lib.pm
+++ b/perl/lib/Sys/Guestfs/Lib.pm
@@ -1,5 +1,5 @@
 # Sys::Guestfs::Lib
 # 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
 #
 # 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;
 
 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.3';
+
+use Carp qw(croak);
+

 use Sys::Guestfs;
 use File::Temp qw/tempdir/;
 use Locale::TextDomain 'libguestfs';
 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 Sys::Virt;";
 eval "use XML::XPath;";
 eval "use XML::XPath::XMLParser;";

+eval "use Win::Hivex;";

 
 =pod
 
 
 =pod
 


@@ -37,14 +47,10 @@ Sys::Guestfs::Lib - Useful functions for using libguestfs from Perl
 
 =head1 SYNOPSIS
 
 
 =head1 SYNOPSIS
 

- use Sys::Guestfs::Lib qw(open_guest inspect_all_partitions ...);
+ use Sys::Guestfs::Lib qw(open_guest ...);

 
  $g = open_guest ($name);
 
 
  $g = open_guest ($name);
 

- %fses = inspect_all_partitions ($g, \@partitions);
-
-(and many more calls - see the rest of this manpage)
-

 =head1 DESCRIPTION
 
 C<Sys::Guestfs::Lib> is an extra library of useful functions for using
 =head1 DESCRIPTION
 
 C<Sys::Guestfs::Lib> is an extra library of useful functions for using


@@ -55,6 +61,14 @@ The basic libguestfs API is not covered by this manpage.  Please refer
 instead to L<Sys::Guestfs(3)> and L<guestfs(3)>.  The libvirt API is
 also not covered.  For that, see L<Sys::Virt(3)>.
 
 instead to L<Sys::Guestfs(3)> and L<guestfs(3)>.  The libvirt API is
 also not covered.  For that, see L<Sys::Virt(3)>.
 

+=head1 DEPRECATION OF SOME FUNCTIONS
+
+This module contains functions and code to perform inspection of guest
+images.  Since libguestfs 1.5.3 this ability has moved into the core
+API (see L<guestfs(3)/INSPECTION>).  The inspection functions in this
+module are deprecated and will not be updated.  Each deprecated
+function is marked in the documentation below.
+

 =head1 BASIC FUNCTIONS
 
 =cut
 =head1 BASIC FUNCTIONS
 
 =cut


@@ -64,7 +78,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);


@@ -77,7 +92,7 @@ use vars qw(@EXPORT_OK @ISA);
 
  $g = open_guest ($name, address => $uri, ...);
 
 
  $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);
 
 
  ($g, $conn, $dom, @images) = open_guest ($name);
 


@@ -92,7 +107,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
 
 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
 
 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


@@ -100,23 +116,26 @@ 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
 
 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
 function returns a tuple of: the open libguestfs handle, the open
 libvirt handle, and the open libvirt domain handle, and a list of
 
 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.
 
 
 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 a
+specified qemu interface.  See L<Sys::Guestfs/guestfs_add_drive_opts>
+for more details.
+

 =cut
 
 sub open_guest
 =cut
 
 sub open_guest


@@ -125,7 +144,10 @@ sub open_guest
     my $first = shift;
     my %params = @_;
 
     my $first = shift;
     my %params = @_;
 

-    my $readwrite = $params{rw};
+    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") {
 
     my @images = ();
     if (ref ($first) eq "ARRAY") {


@@ -133,17 +155,26 @@ sub open_guest
     } elsif (ref ($first) eq "SCALAR") {
         @images = ($first);
     } else {
     } 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) {
     }
 
     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 $_;
         }
                     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"} &&
     } else {
         die __"open_guest: no libvirt support (install Sys::Virt, XML::XPath and XML::XPath::XMLParser)"
             unless exists $INC{"Sys/Virt.pm"} &&


@@ -153,12 +184,15 @@ sub open_guest
         die __"open_guest: too many domains listed on command line"
             if @images > 1;
 
         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;
         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 ();
             # 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 ();


@@ -185,54 +219,100 @@ sub open_guest
         my $xml = $dom->get_xml_description ();
 
         my $p = XML::XPath->new (xml => $xml);
         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;
 
 
         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) {
     }
 
     # 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 ($_);
-        } 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
 }
 
     }
 
     return wantarray ? ($g, $conn, $dom, @images) : $g
 }
 

-=head2 get_partitions
+=head2 feature_available

 
 

- @partitions = get_partitions ($g);
+ $bool = feature_available ($g, $feature [, $feature ...]);

 
 

-This function takes an open libguestfs handle C<$g> and returns all
-partitions and logical volumes found on it.
+This function is a useful wrapper around the basic
+C<$g-E<gt>available> call.

 
 

-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).
+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
+
+This function is deprecated.  It will not be updated in future
+versions of libguestfs.  New code should not use this function.  Use
+the core API function L<Sys::Guestfs(3)/list_filesystems> instead.

 
 =cut
 
 sub get_partitions
 {
 
 =cut
 
 sub get_partitions
 {

+    local $_;

     my $g = shift;
 
     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;
 
     my @partitions = $g->list_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 (@fses_on_device, @lvs, @partitions);

 }
 
 sub _is_pv {
 }
 
 sub _is_pv {


@@ -267,307 +347,49 @@ 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
 

- $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
-
-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.
+Deprecated function.  Replace any calls to this function with:

 
 

-=back
+ $g->file_architecture ($path);

 
 =cut
 
 
 =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
 {
 sub file_architecture
 {

-    local $_;

     my $g = shift;
     my $path = shift;
 
     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
 
 }
 
 =head1 OPERATING SYSTEM INSPECTION FUNCTIONS
 

-The functions in this section can be used to inspect the operating
-system(s) available inside a virtual machine image.  For example, you
-can find out if the VM is Linux or Windows, how the partitions are
-meant to be mounted, and what applications are installed.
-
-If you just want a simple command-line interface to this
-functionality, use the L<virt-inspector(1)> tool.  The documentation
-below covers the case where you want to access this functionality from
-a Perl program.
-
-Once you have the list of partitions (from C<get_partitions>) there
-are several steps involved:
-
-=over 4
-
-=item 1.
-
-Look at each partition separately and find out what is on it.
-
-The information you get back includes whether the partition contains a
-filesystem or swapspace, what sort of filesystem (eg. ext3, ntfs), and
-a first pass guess at the content of the filesystem (eg. Linux boot,
-Windows root).
-
-The result of this step is a C<%fs> hash of information, one hash for
-each partition.
-
-See: C<inspect_partition>, C<inspect_all_partitions>
-
-=item 2.
-
-Work out the relationship between partitions.
-
-In this step we work out how partitions are related to each other.  In
-the case of a single-boot VM, we work out how the partitions are
-mounted in respect of each other (eg. C</dev/sda1> is mounted as
-C</boot>).  In the case of a multi-boot VM where there are several
-roots, we may identify several operating system roots, and mountpoints
-can even be shared.
-
-The result of this step is a single hash called C<%oses> which is
-described in more detail below, but at the top level looks like:
-
- %oses = {
-   '/dev/VG/Root1' => \%os1,
-   '/dev/VG/Root2' => \%os2,
- }
-
- %os1 = {
-   os => 'linux',
-   mounts => {
-     '/' => '/dev/VG/Root1',
-     '/boot' => '/dev/sda1',
-   },
-   ...
- }
-
-(example shows a multi-boot VM containing two root partitions).
-
-See: C<inspect_operating_systems>
-
-=item 3.
-
-Mount up the disks.
-
-Previous to this point we've essentially been looking at each
-partition in isolation.  Now we construct a true guest filesystem by
-mounting up all of the disks.  Only once everything is mounted up can
-we run commands in the OS context to do more detailed inspection.
-
-See: C<mount_operating_system>
-
-=item 4.
-
-Check for kernels and applications.
-
-This step now does more detailed inspection, where we can look for
-kernels, applications and more installed in the guest.
-
-The result of this is an enhanced C<%os> hash.
-
-See: C<inspect_in_detail>
-
-=item 5.
-
-Generate output.
-
-This library does not contain functions for generating output based on
-the analysis steps above.  Use a command line tool such as
-L<virt-inspector(1)> to get useful output.
-
-=back
-

 =head2 inspect_all_partitions
 
 =head2 inspect_all_partitions
 

- %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>.
+This function is deprecated.  It will not be updated in future
+versions of libguestfs.  New code should not use this function.  Use
+the core API functions instead, see L<guestfs(3)/INSPECTION>.

 
 

-The result is a hash which maps partition name to C<\%fs> hashref.
+=cut

 
 

-The contents of the C<%fs> hash and the meaning of the
-C<use_windows_registry> flag are explained below.
+# Turn /dev/vd* and /dev/hd* into canonical device names
+# (see BLOCK DEVICE NAMING in guestfs(3)).

 
 

-=cut
+sub _canonical_dev ($)
+{
+    my ($dev) = @_;
+    return "/dev/sd$1" if $dev =~ m{^/dev/[vh]d(\w+)};
+    return $dev;
+}

 
 sub inspect_all_partitions
 {
 
 sub inspect_all_partitions
 {


@@ -575,104 +397,14 @@ sub inspect_all_partitions
     my $g = shift;
     my $parts = shift;
     my @parts = @$parts;
     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
 

- \%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.
-
-The returned value is a hashref C<\%fs> which may contain the
-following top-level keys (any key can be missing):
-
-=over 4
-
-=item fstype
-
-Filesystem type, eg. "ext2" or "ntfs"
-
-=item fsos
-
-Apparent filesystem OS, eg. "linux" or "windows"
-
-=item is_swap
-
-If set, the partition is a swap partition.
-
-=item uuid
-
-Filesystem UUID.
-
-=item label
-
-Filesystem label.
-
-=item is_mountable
-
-If set, the partition could be mounted by libguestfs.
-
-=item content
-
-Filesystem content, if we could determine it.  One of: "linux-grub",
-"linux-root", "linux-usrlocal", "linux-usr", "windows-root".
-
-=item osdistro
-
-(For Linux root partitions only).
-Operating system distribution.  One of: "fedora", "rhel", "centos",
-"scientific", "debian".
-
-=item package_format
-
-(For Linux root partitions only)
-The package format used by the guest distribution. One of: "rpm", "dpkg".
-
-=item package_management
-
-(For Linux root partitions only)
-The package management tool used by the guest distribution. One of: "rhn",
-"yum", "apt".
-
-=item os_major_version
-
-(For root partitions only).
-Operating system major version number.
-
-=item os_minor_version
-
-(For root partitions only).
-Operating system minor version number.
-
-=item fstab
-
-(For Linux root partitions only).
-The contents of the C</etc/fstab> file.
-
-=item boot_ini
-
-(For Windows root partitions only).
-The contents of the C</boot.ini> (NTLDR) file.
-
-=item registry
-
-The value is an arrayref, which is a list of Windows registry
-file contents, in Windows C<.REG> format.
-
-=back
+This function is deprecated.  It will not be updated in future
+versions of libguestfs.  New code should not use this function.  Use
+the core API functions instead, see L<guestfs(3)/INSPECTION>.

 
 =cut
 
 
 =cut
 


@@ -681,9 +413,6 @@ sub inspect_partition
     local $_;
     my $g = shift;
     my $dev = shift;           # LV or partition name.
     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.
 
 
     my %r;                     # Result hash.
 


@@ -765,7 +494,7 @@ sub inspect_partition
             $r{fsos} = "windows";
             $r{content} = "windows-root";
             $r{is_root} = 1;
             $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;
         }
     }
             goto OUT;
         }
     }


@@ -788,16 +517,19 @@ sub _check_linux_root
 
         $_ = $g->cat ("/etc/redhat-release");
         if (/Fedora release (\d+)(?:\.(\d+))?/) {
 
         $_ = $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));
             $r->{package_management} = "yum";
         }
 
             $r->{osdistro} = "fedora";
             $r->{os_major_version} = "$1";
             $r->{os_minor_version} = "$2" if(defined($2));
             $r->{package_management} = "yum";
         }
 

-        elsif (/(Red Hat Enterprise Linux|CentOS|Scientific Linux)/) {
+        elsif (/(Red Hat|CentOS|Scientific Linux)/) {
+            chomp; $r->{product_name} = $_;
+

             my $distro = $1;
 
             my $distro = $1;
 

-            if($distro eq "Red Hat Enterprise Linux") {
+            if($distro eq "Red Hat") {

                 $r->{osdistro} = "rhel";
             }
 
                 $r->{osdistro} = "rhel";
             }
 


@@ -843,11 +575,12 @@ sub _check_linux_root
             $r->{osdistro} = "redhat-based";
         }
     } elsif ($g->is_file ("/etc/debian_version")) {
             $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+)/) {
         $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";
             $r->{osdistro} = "debian";
             $r->{os_major_version} = "$1";
             $r->{os_minor_version} = "$2";


@@ -894,24 +627,23 @@ sub _check_linux_root
 # Windows installations and their %systemroot%s in a simple text
 # format.
 #
 # 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;
 
 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 $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;
     if (defined $r->{boot_ini}) {
         $_ = $g->cat ($boot_ini);
         my @lines = split /\n/;
         my $section;

-        my $systemroot;

         foreach (@lines) {
             if (m/\[.*\]/) {
                 $section = $1;
         foreach (@lines) {
             if (m/\[.*\]/) {
                 $section = $1;


@@ -923,17 +655,26 @@ sub _check_windows_root
                 last;
             }
         }
                 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.
 }
 
 # Find Windows userspace arch.


@@ -958,72 +699,90 @@ sub _check_windows_registry
     my $systemroot = shift;
 
     # Download the system registry files.  Only download the
     my $systemroot = shift;
 
     # Download the system registry files.  Only download the

-    # interesting ones, and we don't bother with user profiles at all.
-
-    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");
-        }
-    }
-}
+    # interesting ones (SOFTWARE and SYSTEM).  We don't bother with
+    # the user ones.

 
 

-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
 }
 
 sub _check_grub


@@ -1037,78 +796,9 @@ sub _check_grub
 
 =head2 inspect_operating_systems
 
 
 =head2 inspect_operating_systems
 

- \%oses = inspect_operating_systems ($g, \%fses);
-
-This function works out how partitions are related to each other.  In
-the case of a single-boot VM, we work out how the partitions are
-mounted in respect of each other (eg. C</dev/sda1> is mounted as
-C</boot>).  In the case of a multi-boot VM where there are several
-roots, we may identify several operating system roots, and mountpoints
-can even be shared.
-
-This function returns a hashref C<\%oses> which at the top level looks
-like:
-
- %oses = {
-   '/dev/VG/Root' => \%os,
- }
-
-(There can be multiple roots for a multi-boot VM).
-
-The C<\%os> hash contains the following keys (any can be omitted):
-
-=over 4
-
-=item os
-
-Operating system type, eg. "linux", "windows".
-
-=item arch
-
-Operating system userspace architecture, eg. "i386", "x86_64".
-
-=item distro
-
-Operating system distribution, eg. "debian".
-
-=item major_version
-
-Operating system major version, eg. "4".
-
-=item minor_version
-
-Operating system minor version, eg "3".
-
-=item root
-
-The value is a reference to the root partition C<%fs> hash.
-
-=item root_device
-
-The value is the name of the root partition (as a string).
-
-=item mounts
-
-Mountpoints.
-The value is a hashref like this:
-
- mounts => {
-   '/' => '/dev/VG/Root',
-   '/boot' => '/dev/sda1',
- }
-
-=item filesystems
-
-Filesystems (including swap devices and unmounted partitions).
-The value is a hashref like this:
-
- filesystems => {
-   '/dev/sda1' => \%fs,
-   '/dev/VG/Root' => \%fs,
-   '/dev/VG/Swap' => \%fs,
- }
-
-=back
+This function is deprecated.  It will not be updated in future
+versions of libguestfs.  New code should not use this function.  Use
+the core API functions instead, see L<guestfs(3)/INSPECTION>.

 
 =cut
 
 
 =cut
 


@@ -1132,6 +822,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;
 }
 
     return \%oses;
 }
 


@@ -1142,6 +837,8 @@ sub _get_os_version
     my $r = shift;
 
     $r->{os} = $r->{root}->{fsos} if exists $r->{root}->{fsos};
     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};
     $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};


@@ -1170,7 +867,7 @@ sub _assign_mount_points
         foreach (@fstab) {
             my ($spec, $file) = @$_;
 
         foreach (@fstab) {
             my ($spec, $file) = @$_;
 

-            my ($dev, $fs) = _find_filesystem ($g, $fses, $spec);
+            my ($dev, $fs) = _find_filesystem ($g, $fses, $spec, $file);

             if ($dev) {
                 $r->{mounts}->{$file} = $dev;
                 $r->{filesystems}->{$dev} = $fs;
             if ($dev) {
                 $r->{mounts}->{$file} = $dev;
                 $r->{filesystems}->{$dev} = $fs;


@@ -1191,6 +888,7 @@ sub _find_filesystem
     my $g = shift;
     my $fses = shift;
     local $_ = shift;
     my $g = shift;
     my $fses = shift;
     local $_ = shift;

+    my $file = shift;

 
     if (/^LABEL=(.*)/) {
         my $label = $1;
 
     if (/^LABEL=(.*)/) {
         my $label = $1;


@@ -1224,6 +922,9 @@ sub _find_filesystem
         if (m{^/dev/hd(.*)} && exists $fses->{"/dev/sd$1"}) {
             return ("/dev/sd$1", $fses->{"/dev/sd$1"});
         }
         if (m{^/dev/hd(.*)} && exists $fses->{"/dev/sd$1"}) {
             return ("/dev/sd$1", $fses->{"/dev/sd$1"});
         }

+        if (m{^/dev/vd(.*)} && exists $fses->{"/dev/sd$1"}) {
+            return ("/dev/sd$1", $fses->{"/dev/sd$1"});
+        }

         if (m{^/dev/xvd(.*)} && exists $fses->{"/dev/sd$1"}) {
             return ("/dev/sd$1", $fses->{"/dev/sd$1"});
         }
         if (m{^/dev/xvd(.*)} && exists $fses->{"/dev/sd$1"}) {
             return ("/dev/sd$1", $fses->{"/dev/sd$1"});
         }


@@ -1231,7 +932,9 @@ sub _find_filesystem
             return ("/dev/$1/$2", $fses->{"/dev/$1/$2"});
         }
 
             return ("/dev/$1/$2", $fses->{"/dev/$1/$2"});
         }
 

+       return () if $file =~ (/media\/cdrom/);

         return () if m{/dev/cdrom};
         return () if m{/dev/cdrom};

+        return () if m{/dev/fd0};

 
         warn __x("unknown filesystem {fs}\n", fs => $_);
         return ();
 
         warn __x("unknown filesystem {fs}\n", fs => $_);
         return ();


@@ -1240,17 +943,9 @@ sub _find_filesystem
 
 =head2 mount_operating_system
 
 
 =head2 mount_operating_system
 

- mount_operating_system ($g, \%os, [$ro]);
-
-This function mounts the operating system described in the
-C<%os> hash according to the C<mounts> table in that hash (see
-C<inspect_operating_systems>).
-
-The partitions are mounted read-only unless the third parameter
-is specified as zero explicitly.
-
-To reverse the effect of this call, use the standard
-libguestfs API call C<$g-E<gt>umount_all ()>.
+This function is deprecated.  It will not be updated in future
+versions of libguestfs.  New code should not use this function.  Use
+the core API functions instead, see L<guestfs(3)/INSPECTION>.

 
 =cut
 
 
 =cut
 


@@ -1272,7 +967,7 @@ sub mount_operating_system
             if($ro) {
                 $g->mount_ro ($mounts->{$_}, $_)
             } else {
             if($ro) {
                 $g->mount_ro ($mounts->{$_}, $_)
             } else {

-                $g->mount ($mounts->{$_}, $_)
+                $g->mount_options ("", $mounts->{$_}, $_)

             }
         }
     }
             }
         }
     }


@@ -1280,107 +975,9 @@ sub mount_operating_system
 
 =head2 inspect_in_detail
 
 
 =head2 inspect_in_detail
 

- mount_operating_system ($g, \%os);
- inspect_in_detail ($g, \%os);
- $g->umount_all ();
-
-The C<inspect_in_detail> function inspects the mounted operating
-system for installed applications, installed kernels, kernel modules,
-system architecture, and more.
-
-It adds extra keys to the existing C<%os> hash reflecting what it
-finds.  These extra keys are:
-
-=over 4
-
-=item apps
-
-List of applications.
-
-=item boot
-
-Boot configurations. A hash containing:
-
-=over 4
-
-=item configs
-
-An array of boot configurations. Each array entry is a hash containing:
-
-=over 4
-
-=item initrd
-
-A reference to the expanded initrd structure (see below) for the initrd used by
-this boot configuration.
-
-=item kernel
-
-A reference to the expanded kernel structure (see below) for the kernel used by
-this boot configuration.
-
-=item title
-
-The human readable name of the configuration.
-
-=item cmdline
-
-The kernel command line.
-
-=back
-
-=item default
-
-The index of the default configuration in the configs array.
-
-=item grub_fs
-
-The path of the filesystem containing the grub partition.
-
-=back
-
-=item kernels
-
-List of kernels.
-
-This is a hash of kernel version =E<gt> a hash with the following keys:
-
-=over 4
-
-=item version
-
-Kernel version.
-
-=item arch
-
-Kernel architecture (eg. C<x86-64>).
-
-=item modules
-
-List of modules.
-
-=item path
-
-The path to the kernel's vmlinuz file.
-
-=item package
-
-If the kernel was installed in a package, the name of that package.
-
-=back
-
-=item modprobe_aliases
-
-(For Linux VMs).
-The contents of the modprobe configuration.
-
-=item initrd_modules
-
-(For Linux VMs).
-The kernel modules installed in the initrd.  The value is
-a hashref of kernel version to list of modules.
-
-=back
+This function is deprecated.  It will not be updated in future
+versions of libguestfs.  New code should not use this function.  Use
+the core API functions instead, see L<guestfs(3)/INSPECTION>.

 
 =cut
 
 
 =cut
 


@@ -1409,14 +1006,21 @@ sub _check_for_applications
     if ($osn eq "linux") {
         my $package_format = $os->{package_format};
         if (defined $package_format && $package_format eq "rpm") {
     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;
             foreach (@lines) {
                 if (m/^(.*) (.*) (.*) (.*) (.*)$/) {
                     my $epoch = $2;

-                    $epoch = "" if $epoch eq "(none)";
+                    undef $epoch if $epoch eq "(none)";

                     my $app = {
                         name => $1,
                         epoch => $epoch,
                     my $app = {
                         name => $1,
                         epoch => $epoch,


@@ -1427,6 +1031,30 @@ sub _check_for_applications
                     push @apps, $app
                 }
             }
                     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
         }
     } elsif ($osn eq "windows") {
         # XXX


@@ -1480,7 +1108,7 @@ sub _find_grub_prefix
     die(__"Can't find grub on guest") unless($g->exists('/boot/grub/menu.lst'));
 
     # Look for the most specific mount point in mounts
     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 /) {
+    foreach my $path (qw(/boot/grub /boot /)) {

         if(exists($mounts->{$path})) {
             return "" if($path eq '/');
             return $path;
         if(exists($mounts->{$path})) {
             return "" if($path eq '/');
             return $path;


@@ -1494,11 +1122,17 @@ 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}
 
         my $grub = _find_grub_prefix($g, $os);
         # 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;
 
 
         my @boot_configs;
 


@@ -1518,7 +1152,7 @@ sub _check_for_kernels
         my @configs = ();
         # Get all configurations from grub
         foreach my $bootable
         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);
         {
             my %config = ();
             $config{title} = $g->aug_get($bootable);


@@ -1552,8 +1186,14 @@ 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, $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)) {
 
                 # Check the kernel was recognised
                 if(defined($kernel)) {


@@ -1591,11 +1231,8 @@ sub _check_for_kernels
 
         # Add the default configuration
         eval {
 
         # 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;
     }
 
         $os->{boot} = \%boot;
     }


@@ -1607,11 +1244,9 @@ sub _check_for_kernels
 
 =head2 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>.
+This function is deprecated.  It will not be updated in future
+versions of libguestfs.  New code should not use this function.  Use
+the core API functions instead, see L<guestfs(3)/INSPECTION>.

 
 =cut
 
 
 =cut
 


@@ -1702,19 +1337,12 @@ sub _find_modprobe_aliases
     # Initialise augeas
     $g->aug_init("/", 16);
 
     # 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;
 
     my %modprobe_aliases;
 

-    for my $pattern qw(/files/etc/conf.modules/alias
-                       /files/etc/modules.conf/alias
-                       /files/etc/modprobe.conf/alias
-                       /files/etc/modprobe.d/*/alias) {
+    for my $pattern (qw(/files/etc/conf.modules/alias
+                        /files/etc/modules.conf/alias
+                        /files/etc/modprobe.conf/alias
+                        /files/etc/modprobe.d/*/alias)) {

         for my $path ( $g->aug_match($pattern) ) {
             $path =~ m{^/files(.*)/alias(?:\[\d*\])?$}
                 or die __x("{path} doesn't match augeas pattern",
         for my $path ( $g->aug_match($pattern) ) {
             $path =~ m{^/files(.*)/alias(?:\[\d*\])?$}
                 or die __x("{path} doesn't match augeas pattern",


@@ -1749,7 +1377,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.
     # 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);
         };
         eval {
             @modules = $g->initrd_list ($path);
         };


@@ -1772,7 +1400,7 @@ sub _inspect_initrd
 
 =head1 COPYRIGHT
 
 
 =head1 COPYRIGHT
 

-Copyright (C) 2009 Red Hat Inc.
+Copyright (C) 2009-2010 Red Hat Inc.

 
 =head1 LICENSE
 
 
 =head1 LICENSE