X-Git-Url: http://git.annexia.org/?p=libguestfs.git;a=blobdiff_plain;f=inspector%2Fvirt-inspector.pl;h=b2983b3d35664d74a8ef3d26c39ef3d6c3340f4f;hp=12851c2575f59fe8043eb2929bc1b79a24c7860a;hb=e4733575efff31742444b180cdcfbc2504b144c8;hpb=5aa57fbd34eb34922719d08712303b9d73ec215f

diff --git a/inspector/virt-inspector.pl b/inspector/virt-inspector.pl
index 12851c2..b2983b3 100755
--- a/inspector/virt-inspector.pl
+++ b/inspector/virt-inspector.pl
@@ -113,6 +113,8 @@ my $output = "text";
 
 =item B<--xml>
 
+=item B<--perl>
+
 =item B<--fish>
 
 =item B<--ro-fish>
@@ -122,6 +124,9 @@ Select the output format.  The default is a readable text report.
 If you select I<--xml> then you get XML output which can be fed
 to other programs.
 
+If you select I<--perl> then you get Perl structures output which
+can be used directly in another Perl program.
+
 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:
@@ -139,6 +144,7 @@ GetOptions ("help|?" => \$help,
 	    "connect|c=s" => \$uri,
 	    "force" => \$force,
 	    "xml" => sub { $output = "xml" },
+	    "perl" => sub { $output = "perl" },
 	    "fish" => sub { $output = "fish" },
 	    "guestfish" => sub { $output = "fish" },
 	    "ro-fish" => sub { $output = "ro-fish" },
@@ -442,6 +448,7 @@ sub check_grub
 
 #print Dumper (\%fses);
 
+#----------------------------------------------------------------------
 # Now find out how many operating systems we've got.  Usually just one.
 
 my %oses = ();
@@ -523,18 +530,187 @@ sub find_filesystem
 	return ();
     } else {
 	return ($_, $fses{$_}) if exists $fses{$_};
+
+	if (m{^/dev/hd(.*)} && 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"});
+	}
+
+	return () if m{/dev/cdrom};
+
 	warn "unknown filesystem $_\n";
 	return ();
     }
 }
 
-print Dumper (\%oses);
+#print Dumper(\%oses);
+
+#----------------------------------------------------------------------
+# Mount up the disks so we can check for applications
+# and kernels.  Skip this if the output is "*fish" because
+# we don't need to know.
+
+if ($output !~ /.*fish$/) {
+    my $root_dev;
+    foreach $root_dev (sort keys %oses) {
+	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) {
+	    $g->mount_ro ($mounts->{$_}, $_)
+		if $_ ne "swap" && ($_ eq '/' || $g->is_dir ($_));
+	}
+
+	check_for_applications ($root_dev);
+	check_for_kernels ($root_dev);
+
+	$g->umount_all ();
+    }
+}
+
+sub check_for_applications
+{
+    local $_;
+    my $root_dev = shift;
+
+    # XXX rpm -qa, look in Program Files, or whatever
+}
+
+sub check_for_kernels
+{
+    local $_;
+    my $root_dev = shift;
+
+    # XXX
+}
+
+#----------------------------------------------------------------------
+# Output.
 
+if ($output eq "fish" || $output eq "ro-fish") {
+    my @osdevs = keys %oses;
+    # This only works if there is a single OS.
+    die "--fish output is only possible with a single OS\n" if @osdevs != 1;
 
+    my $root_dev = $osdevs[0];
 
+    print "guestfish";
+    if ($output eq "ro-fish") {
+	print " --ro";
+    }
 
+    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 "\n"
+}
+
+# Perl output.
+elsif ($output eq "perl") {
+    print Dumper(\%oses);
+}
 
+# Plain text output (the default).
+elsif ($output eq "text") {
+    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->{$_}, $_
+    }
+
+    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};
+    }
+
+    # XXX Applications.
+    # XXX Kernel.
+}
+
+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";
+
+    # XXX Applications.
+    # XXX Kernel.
+    print "</operatingsystem>\n";
+}
 
 =head1 SEE ALSO