X-Git-Url: http://git.annexia.org/?a=blobdiff_plain;ds=inline;f=inspector%2Fvirt-inspector.pl;h=c5c3813571ca4941b6fb0275e232d1e96c9ba88c;hb=cead6fe22d32e8fcdb26c60fdad5db49bf3f0ec0;hp=216943104433462aa262c5e2dc8c7f29ca465ec0;hpb=0aa45a5662bcb96348bd4753fb0404991f713319;p=libguestfs.git

diff --git a/inspector/virt-inspector.pl b/inspector/virt-inspector.pl
index 2169431..c5c3813 100755
--- a/inspector/virt-inspector.pl
+++ b/inspector/virt-inspector.pl
@@ -566,12 +566,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 +575,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
@@ -667,7 +694,12 @@ sub output_text_os
 	    if exists $filesystems->{$_}{content};
     }
 
-    # XXX Applications.
+    print "  Applications:\n";
+    my @apps =  @{$os->{apps}};
+    foreach (@apps) {
+	print "    $_->{name} $_->{version}\n"
+    }
+
     # XXX Kernel.
 }
 
@@ -713,8 +745,17 @@ sub output_xml_os
     }
     print "</filesystems>\n";
 
-    # XXX Applications.
+    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";
+
     # XXX Kernel.
+
     print "</operatingsystem>\n";
 }