Add 'add_drive_ro' call. Fix up documentation. Plus a couple of minor code improvemen...

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

diff --git a/inspector/virt-inspector.pl b/inspector/virt-inspector.pl
index 2169431..6d3c472 100755 (executable)
--- a/inspector/virt-inspector.pl
+++ b/inspector/virt-inspector.pl
@@ -213,7 +213,7 @@ if (-e $ARGV[0]) {
 
 # We've now got the list of @images, so feed them to libguestfs.
 my $g = Sys::Guestfs->new ();
-$g->add_drive ($_) foreach @images;
+$g->add_drive_ro ($_) foreach @images;
 $g->launch ();
 $g->wait_ready ();
 
@@ -434,8 +434,7 @@ sub check_windows_root
     local $_;
     my $r = shift;
 
-    # XXX Windows version.
-    # List of applications.
+    # Windows version?
 }
 
 sub check_grub
@@ -443,7 +442,7 @@ sub check_grub
     local $_;
     my $r = shift;
 
-    # XXX Kernel versions, grub version.
+    # Grub version, if we care.
 }
 
 #print Dumper (\%fses);
@@ -566,12 +565,6 @@ if ($output !~ /.*fish$/) {
        check_for_applications ($root_dev);
        check_for_kernels ($root_dev);
 
-       # umount_all in libguestfs is buggy - it doesn't unmount
-       # filesystems in the correct order.  So let's unmount them
-       # in reverse first before calling umount_all as a last resort.
-       foreach (sort { $b cmp $a } keys %$mounts) {
-           eval "\$g->umount ('$_')";
-       }
        $g->umount_all ();
     }
 }
@@ -581,7 +574,40 @@ sub check_for_applications
     local $_;
     my $root_dev = shift;
 
-    # XXX rpm -qa, look in Program Files, or whatever
+    my @apps;
+
+    my $os = $oses{$root_dev}->{os};
+    if ($os eq "linux") {
+       my $distro = $oses{$root_dev}->{distro};
+       if ($distro eq "redhat") {
+           my @lines = $g->command_lines
+               (["rpm", "-q", "-a", "--qf",
+                 "%{name} %{epoch} %{version} %{release} %{arch}\n"]);
+           foreach (@lines) {
+               if (m/^(.*) (.*) (.*) (.*) (.*)$/) {
+                   my $epoch = $2;
+                   $epoch = "" if $epoch eq "(none)";
+                   my $app = {
+                       name => $1,
+                       epoch => $epoch,
+                       version => $3,
+                       release => $4,
+                       arch => $5
+                   };
+                   push @apps, $app
+               }
+           }
+       }
+    } elsif ($os eq "windows") {
+       # XXX
+       # I worked out a general plan for this, but haven't
+       # implemented it yet.  We can iterate over /Program Files
+       # looking for *.EXE files, which we download, then use
+       # i686-pc-mingw32-windres on, to find the VERSIONINFO
+       # section, which has a lot of useful information.
+    }
+
+    $oses{$root_dev}->{apps} = \@apps;
 }
 
 sub check_for_kernels
@@ -589,7 +615,37 @@ sub check_for_kernels
     local $_;
     my $root_dev = shift;
 
-    # XXX
+    my @kernels;
+
+    my $os = $oses{$root_dev}->{os};
+    if ($os eq "linux") {
+       # Installed kernels will have a corresponding /lib/modules/<version>
+       # directory, which is the easiest way to find out what kernels
+       # are installed, and what modules are available.
+       foreach ($g->ls ("/lib/modules")) {
+           if ($g->is_dir ("/lib/modules/$_")) {
+               my %kernel;
+               $kernel{version} = $_;
+
+               # List modules.
+               my @modules;
+               foreach ($g->find ("/lib/modules/$_")) {
+                   if (m,/([^/]+)\.ko,) {
+                       push @modules, $1;
+                   }
+               }
+
+               $kernel{modules} = \@modules;
+
+               push @kernels, \%kernel;
+           }
+       }
+
+    } elsif ($os eq "windows") {
+       # XXX
+    }
+
+    $oses{$root_dev}->{kernels} = \@kernels;
 }
 
 #----------------------------------------------------------------------
@@ -667,8 +723,21 @@ sub output_text_os
            if exists $filesystems->{$_}{content};
     }
 
-    # XXX Applications.
-    # XXX Kernel.
+    print "  Applications:\n";
+    my @apps =  @{$os->{apps}};
+    foreach (@apps) {
+       print "    $_->{name} $_->{version}\n"
+    }
+
+    print "  Kernels:\n";
+    my @kernels = @{$os->{kernels}};
+    foreach (@kernels) {
+       print "    $_->{version}\n";
+       my @modules = @{$_->{modules}};
+       foreach (@modules) {
+           print "      $_\n";
+       }
+    }
 }
 
 sub output_xml
@@ -713,8 +782,30 @@ sub output_xml_os
     }
     print "</filesystems>\n";
 
-    # XXX Applications.
-    # XXX Kernel.
+    print "<applications>\n";
+    my @apps =  @{$os->{apps}};
+    foreach (@apps) {
+       print "<application>\n";
+       print "<name>$_->{name}</name><version>$_->{version}</version>\n";
+       print "</application>\n";
+    }
+    print "</applications>\n";
+
+    print "<kernels>\n";
+    my @kernels = @{$os->{kernels}};
+    foreach (@kernels) {
+       print "<kernel>\n";
+       print "<version>$_->{version}</version>\n";
+       print "<modules>\n";
+       my @modules = @{$_->{modules}};
+       foreach (@modules) {
+           print "<module>$_</module>\n";
+       }
+       print "</modules>\n";
+       print "</kernel>\n";
+    }
+    print "</kernels>\n";
+
     print "</operatingsystem>\n";
 }