X-Git-Url: http://git.annexia.org/?a=blobdiff_plain;f=inspector%2Fvirt-inspector.pl;h=4ee0e08a29d0d911abec84096f34b26c32ce078d;hb=ff9c8dfcd178dcd3a35ae3e368b461f3bf44b2ad;hp=c8c045e12f02728fcab59259e3cb4f4597f697fb;hpb=6f2929c4635c3f2af4a9211981d9edd1f58cce69;p=libguestfs.git

diff --git a/inspector/virt-inspector.pl b/inspector/virt-inspector.pl
index c8c045e..4ee0e08 100755
--- a/inspector/virt-inspector.pl
+++ b/inspector/virt-inspector.pl
@@ -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;
 }
 
 #----------------------------------------------------------------------
@@ -625,24 +681,132 @@ elsif ($output eq "perl") {
 
 # Plain text output (the default).
 elsif ($output eq "text") {
-    # XXX text output.
+    output_text ();
+}
 
+# XML output.
+elsif ($output eq "xml") {
+    output_xml ();
+}
 
+sub output_text
+{
+    output_text_os ($oses{$_}) foreach sort keys %oses;
+}
 
+sub output_text_os
+{
+    my $os = shift;
 
+    print $os->{os}, " " if exists $os->{os};
+    print $os->{distro}, " " if exists $os->{distro};
+    print $os->{version}, " " if exists $os->{version};
+    print "on ", $os->{root_device}, ":\n";
 
-}
+    print "  Mountpoints:\n";
+    my $mounts = $os->{mounts};
+    foreach (sort keys %$mounts) {
+	printf "    %-30s %s\n", $mounts->{$_}, $_
+    }
 
-# XML output.
-elsif ($output eq "xml") {
-    # XXX XML output.
+    print "  Filesystems:\n";
+    my $filesystems = $os->{filesystems};
+    foreach (sort keys %$filesystems) {
+	print "    $_:\n";
+	print "      label: $filesystems->{$_}{label}\n"
+	    if exists $filesystems->{$_}{label};
+	print "      UUID: $filesystems->{$_}{uuid}\n"
+	    if exists $filesystems->{$_}{uuid};
+	print "      type: $filesystems->{$_}{fstype}\n"
+	    if exists $filesystems->{$_}{fstype};
+	print "      content: $filesystems->{$_}{content}\n"
+	    if exists $filesystems->{$_}{content};
+    }
+
+    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
+{
+    print "<operatingsystems>\n";
+    output_xml_os ($oses{$_}) foreach sort keys %oses;
+    print "</operatingsystems>\n";
+}
 
+sub output_xml_os
+{
+    my $os = shift;
 
+    print "<operatingsystem>\n";
 
+    print "<os>", $os->{os}, "</os>\n" if exists $os->{os};
+    print "<distro>", $os->{distro}, "</distro>\n" if exists $os->{distro};
+    print "<version>", $os->{version}, "</version>\n" if exists $os->{version};
+    print "<root>", $os->{root_device}, "</root>\n";
 
+    print "<mountpoints>\n";
+    my $mounts = $os->{mounts};
+    foreach (sort keys %$mounts) {
+	printf "<mountpoint dev='%s'>%s</mountpoint>\n",
+	  $mounts->{$_}, $_
+    }
+    print "</mountpoints>\n";
+
+    print "<filesystems>\n";
+    my $filesystems = $os->{filesystems};
+    foreach (sort keys %$filesystems) {
+	print "<filesystem dev='$_'>\n";
+	print "<label>$filesystems->{$_}{label}</label>\n"
+	    if exists $filesystems->{$_}{label};
+	print "<uuid>$filesystems->{$_}{uuid}</uuid>\n"
+	    if exists $filesystems->{$_}{uuid};
+	print "<type>$filesystems->{$_}{fstype}</type>\n"
+	    if exists $filesystems->{$_}{fstype};
+	print "<content>$filesystems->{$_}{content}</content>\n"
+	    if exists $filesystems->{$_}{content};
+	print "</filesystem>\n";
+    }
+    print "</filesystems>\n";
+
+    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";
 }
 
 =head1 SEE ALSO