X-Git-Url: http://git.annexia.org/?a=blobdiff_plain;f=inspector%2Fvirt-inspector.pl;h=4ee0e08a29d0d911abec84096f34b26c32ce078d;hb=ff9c8dfcd178dcd3a35ae3e368b461f3bf44b2ad;hp=12851c2575f59fe8043eb2929bc1b79a24c7860a;hpb=5aa57fbd34eb34922719d08712303b9d73ec215f;p=libguestfs.git diff --git a/inspector/virt-inspector.pl b/inspector/virt-inspector.pl index 12851c2..4ee0e08 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 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" }, @@ -428,8 +434,7 @@ sub check_windows_root local $_; my $r = shift; - # XXX Windows version. - # List of applications. + # Windows version? } sub check_grub @@ -437,11 +442,12 @@ sub check_grub local $_; my $r = shift; - # XXX Kernel versions, grub version. + # Grub version, if we care. } #print Dumper (\%fses); +#---------------------------------------------------------------------- # Now find out how many operating systems we've got. Usually just one. my %oses = (); @@ -523,18 +529,285 @@ 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; + + 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 +{ + local $_; + my $root_dev = shift; + + my @kernels; + + my $os = $oses{$root_dev}->{os}; + if ($os eq "linux") { + # Installed kernels will have a corresponding /lib/modules/ + # 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; +} + +#---------------------------------------------------------------------- +# 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}; + } + + 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 "\n"; + output_xml_os ($oses{$_}) foreach sort keys %oses; + print "\n"; +} + +sub output_xml_os +{ + my $os = shift; + + print "\n"; + + print "", $os->{os}, "\n" if exists $os->{os}; + print "", $os->{distro}, "\n" if exists $os->{distro}; + print "", $os->{version}, "\n" if exists $os->{version}; + print "", $os->{root_device}, "\n"; + + print "\n"; + my $mounts = $os->{mounts}; + foreach (sort keys %$mounts) { + printf "%s\n", + $mounts->{$_}, $_ + } + print "\n"; + + print "\n"; + my $filesystems = $os->{filesystems}; + foreach (sort keys %$filesystems) { + print "\n"; + print "\n" + if exists $filesystems->{$_}{label}; + print "$filesystems->{$_}{uuid}\n" + if exists $filesystems->{$_}{uuid}; + print "$filesystems->{$_}{fstype}\n" + if exists $filesystems->{$_}{fstype}; + print "$filesystems->{$_}{content}\n" + if exists $filesystems->{$_}{content}; + print "\n"; + } + print "\n"; + + print "\n"; + my @apps = @{$os->{apps}}; + foreach (@apps) { + print "\n"; + print "$_->{name}$_->{version}\n"; + print "\n"; + } + print "\n"; + + print "\n"; + my @kernels = @{$os->{kernels}}; + foreach (@kernels) { + print "\n"; + print "$_->{version}\n"; + print "\n"; + my @modules = @{$_->{modules}}; + foreach (@modules) { + print "$_\n"; + } + print "\n"; + print "\n"; + } + print "\n"; + + print "\n"; +} =head1 SEE ALSO