Make virt-inspector look in more places for module aliases

[libguestfs.git] / inspector / virt-inspector.pl

diff --git a/inspector/virt-inspector.pl b/inspector/virt-inspector.pl
index 00d3ae7..8417675 100755 (executable)
--- a/inspector/virt-inspector.pl
+++ b/inspector/virt-inspector.pl
@@ -27,6 +27,9 @@ use File::Temp qw/tempdir/;
 
 # Optional:
 eval "use Sys::Virt;";
+eval "use XML::XPath;";
+eval "use XML::XPath::XMLParser;";
+eval "use YAML::Any;";
 
 =encoding utf8
 
@@ -132,6 +135,11 @@ Produce no output at all.
 If you select I<--xml> then you get XML output which can be fed
 to other programs.
 
+=item B<--yaml>
+
+If you select I<--yaml> then you get YAML output which can be fed
+to other programs.
+
 =item B<--perl>
 
 If you select I<--perl> then you get Perl structures output which
@@ -145,7 +153,7 @@ If you select I<--fish> then we print a L<guestfish(1)> command
 line which will automatically mount up the filesystems on the
 correct mount points.  Try this for example:
 
- eval `virt-inspector --fish guest.img`
+ guestfish $(virt-inspector --fish guest.img)
 
 I<--ro-fish> is the same, but the I<--ro> option is passed to
 guestfish so that the filesystems are mounted read-only.
@@ -181,6 +189,7 @@ GetOptions ("help|?" => \$help,
            "text" => sub { $output = "text" },
            "none" => sub { $output = "none" },
            "xml" => sub { $output = "xml" },
+           "yaml" => sub { $output = "yaml" },
            "perl" => sub { $output = "perl" },
            "fish" => sub { $output = "fish" },
            "guestfish" => sub { $output = "fish" },
@@ -204,8 +213,10 @@ if (-e $ARGV[0]) {
        }
     }
 } else {
-    die "no libvirt support (install Sys::Virt)"
-       unless exists $INC{"Sys/Virt.pm"};
+    die "virt-inspector: no libvirt support (install Sys::Virt, XML::XPath and XML::XPath::XMLParser)\n"
+       unless exists $INC{"Sys/Virt.pm"} &&
+       exists $INC{"XML/XPath.pm"} &&
+       exists $INC{"XML/XPath/XMLParser.pm"};
 
     pod2usage ("$0: too many domains listed on command line") if @ARGV > 1;
 
@@ -218,6 +229,13 @@ if (-e $ARGV[0]) {
     die "cannot connect to libvirt $uri\n" unless $vmm;
 
     my @doms = $vmm->list_defined_domains ();
+    my $isitinactive = "an inactive libvirt domain";
+    if ($output ne "fish") {
+       # In the special case where we want read-only access to
+       # a domain, allow the user to specify an active domain too.
+       push @doms, $vmm->list_domains ();
+       $isitinactive = "a libvirt domain";
+    }
     my $dom;
     foreach (@doms) {
        if ($_->get_name () eq $ARGV[0]) {
@@ -225,20 +243,14 @@ if (-e $ARGV[0]) {
            last;
        }
     }
-    die "$ARGV[0] is not the name of an inactive libvirt domain\n"
-       unless $dom;
+    die "$ARGV[0] is not the name of $isitinactive\n" unless $dom;
 
     # Get the names of the image(s).
     my $xml = $dom->get_xml_description ();
 
-    my $p = new XML::XPath::XMLParser (xml => $xml);
-    my $disks = $p->find ("//devices/disk");
-    print "disks:\n";
-    foreach ($disks->get_nodelist) {
-       print XML::XPath::XMLParser::as_string($_);
-    }
-
-    die "XXX"
+    my $p = XML::XPath->new (xml => $xml);
+    my @disks = $p->findnodes ('//devices/disk/source/@dev');
+    @images = map { $_->getData } @disks;
 }
 
 # We've now got the list of @images, so feed them to libguestfs.
@@ -299,7 +311,7 @@ L<guestfish(1)> command line parameters, so that you can go in
 afterwards and inspect the guest with everything mounted in the
 right place.  For example:
 
- eval `virt-inspector --ro-fish guest.img`
+ guestfish $(virt-inspector --ro-fish guest.img)
  ==> guestfish --ro -a guest.img -m /dev/VG/LV:/ -m /dev/sda1:/boot
 
 =cut
@@ -832,14 +844,47 @@ sub check_for_modprobe_aliases
     local $_;
     my $root_dev = shift;
 
-    my @lines;
-    eval { @lines = $g->read_lines ("/etc/modprobe.conf"); };
-    return if $@ || !@lines;
+    # Initialise augeas
+    my $success = 0;
+    $success = $g->aug_init("/", 16);
+
+    # Register /etc/modules.conf and /etc/conf.modules to the Modprobe lens
+    my @results;
+    @results = $g->aug_match("/augeas/load/Modprobe/incl");
+
+    # Calculate the next index of /augeas/load/Modprobe/incl
+    my $i = 1;
+    foreach ( @results ) {
+        next unless m{/augeas/load/Modprobe/incl\[(\d*)]};
+        $i = $1 + 1 if ($1 == $i);
+    }
+
+    $success = $g->aug_set("/augeas/load/Modprobe/incl[$i]",
+                           "/etc/modules.conf");
+    $i++;
+    $success = $g->aug_set("/augeas/load/Modprobe/incl[$i]",
+                                  "/etc/conf.modules");
+
+    # Make augeas reload
+    $success = $g->aug_load();
 
     my %modprobe_aliases;
 
-    foreach (@lines) {
-       $modprobe_aliases{$1} = $2 if /^\s*alias\s+(\S+)\s+(\S+)/;
+    for my $pattern qw(/files/etc/conf.modules/alias
+                       /files/etc/modules.conf/alias
+                       /files/etc/modprobe.conf/alias
+                       /files/etc/modprobe.d/*/alias) {
+        @results = $g->aug_match($pattern);
+
+        for my $path ( @results ) {
+            my $alias;
+            $alias = $g->aug_get($path);
+
+            my $modulename;
+            $modulename = $g->aug_get($path.'/modulename');
+
+            $modprobe_aliases{$alias} = $modulename;
+        }
     }
 
     $oses{$root_dev}->{modprobe_aliases} = \%modprobe_aliases;
@@ -905,18 +950,17 @@ if ($output eq "fish" || $output eq "ro-fish") {
 
     my $root_dev = $osdevs[0];
 
-    print "guestfish";
     if ($output eq "ro-fish") {
-       print " --ro";
+       print "--ro ";
     }
 
-    print " -a $_" foreach @images;
+    print "-a $_ " foreach @images;
 
     my $mounts = $oses{$root_dev}->{mounts};
     # Have to mount / first.  Luckily '/' is early in the ASCII
     # character set, so this should be OK.
     foreach (sort keys %$mounts) {
-       print " -m $mounts->{$_}:$_" if $_ ne "swap";
+       print "-m $mounts->{$_}:$_ " if $_ ne "swap";
     }
     print "\n"
 }
@@ -926,6 +970,14 @@ elsif ($output eq "perl") {
     print Dumper(\%oses);
 }
 
+# YAML output
+elsif ($output eq "yaml") {
+    die "virt-inspector: no YAML support\n"
+       unless exists $INC{"YAML/Any.pm"};
+    
+    print Dump(\%oses);
+}
+
 # Plain text output (the default).
 elsif ($output eq "text") {
     output_text ();
@@ -1356,7 +1408,8 @@ sub output_query_virtio_drivers
 L<guestfs(3)>,
 L<guestfish(1)>,
 L<Sys::Guestfs(3)>,
-L<Sys::Virt(3)>.
+L<Sys::Virt(3)>,
+L<http://libguestfs.org/>.
 
 For Windows registry parsing we require the C<reged> program
 from L<http://home.eunet.no/~pnordahl/ntpasswd/>.