X-Git-Url: http://git.annexia.org/?p=libguestfs.git;a=blobdiff_plain;f=inspector%2Fvirt-inspector.pl;h=6aa63ad364d3f225154d1423aef20dd66f5a55f0;hp=a5ba00502bcf7883594370448bbcdcc12e4e58e6;hb=215041c7178922341ecbfdb23eb203f2bb8c29c4;hpb=0faa5dde7b992ba11bb88f77b3424676c7c492e4 diff --git a/inspector/virt-inspector.pl b/inspector/virt-inspector.pl index a5ba005..6aa63ad 100755 --- a/inspector/virt-inspector.pl +++ b/inspector/virt-inspector.pl @@ -23,9 +23,12 @@ use Sys::Guestfs; use Pod::Usage; use Getopt::Long; use Data::Dumper; +use File::Temp qw/tempdir/; # Optional: eval "use Sys::Virt;"; +eval "use XML::XPath;"; +eval "use XML::XPath::XMLParser;"; =encoding utf8 @@ -101,41 +104,75 @@ my $force; =item B<--force> -Force reading a particular guest even if it appears to -be active, or if the guest image is writable. This is -dangerous and can even corrupt the guest image. +Force reading a particular guest even if it appears to be active. In +earlier versions of virt-inspector, this could be dangerous (for +example, corrupting the guest's disk image). However in more recent +versions, it should not cause corruption, but might cause +virt-inspector to crash or produce incorrect results. =cut my $output = "text"; -=item B<--text> (default) +=back -=item B<--xml> +The following options select the output format. Use only one of them. +The default is a readable text report. -=item B<--perl> +=over 4 -=item B<--fish> +=item B<--text> (default) -=item B<--ro-fish> +Plain text report. -Select the output format. The default is a readable text report. +=item B<--none> + +Produce no output at all. + +=item B<--xml> If you select I<--xml> then you get XML output which can be fed to other programs. +=item B<--perl> + If you select I<--perl> then you get Perl structures output which can be used directly in another Perl program. +=item B<--fish> + +=item B<--ro-fish> + 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: - eval `virt-inspector --fish guest.img` + guestfish $(virt-inspector --fish guest.img) I<--ro-fish> is the same, but the I<--ro> option is passed to guestfish so that the filesystems are mounted read-only. +=item B<--query> + +In "query mode" we answer common questions about the guest, such +as whether it is fullvirt or needs a Xen hypervisor to run. + +See section I below. + +=cut + +my $windows_registry; + +=item B<--windows-registry> + +If this item is passed, I the guest is Windows, I the +external program C is available (see SEE ALSO section), then we +attempt to parse the Windows registry. This allows much more +information to be gathered for Windows guests. + +This is quite an expensive and slow operation, so we don't do it by +default. + =back =cut @@ -143,13 +180,17 @@ guestfish so that the filesystems are mounted read-only. GetOptions ("help|?" => \$help, "connect|c=s" => \$uri, "force" => \$force, + "text" => sub { $output = "text" }, + "none" => sub { $output = "none" }, "xml" => sub { $output = "xml" }, "perl" => sub { $output = "perl" }, "fish" => sub { $output = "fish" }, "guestfish" => sub { $output = "fish" }, "ro-fish" => sub { $output = "ro-fish" }, - "ro-guestfish" => sub { $output = "ro-fish" }) - or pod2usage (2); + "ro-guestfish" => sub { $output = "ro-fish" }, + "query" => sub { $output = "query" }, + "windows-registry" => \$windows_registry, + ) or pod2usage (2); pod2usage (1) if $help; pod2usage ("$0: no image or VM names given") if @ARGV == 0; @@ -159,23 +200,16 @@ my @images; if (-e $ARGV[0]) { @images = @ARGV; - # Until we get an 'add_drive_ro' call, we must check that qemu - # will only open this image in readonly mode. - # XXX Remove this hack at some point ... or at least push it - # into libguestfs. - foreach (@images) { if (! -r $_) { die "guest image $_ does not exist or is not readable\n" - } elsif (-w $_ && !$force) { - die ("guest image $_ is writable! REFUSING TO PROCEED.\n". - "You can use --force to override this BUT that action\n". - "MAY CORRUPT THE DISK IMAGE.\n"); - } + } } } else { - die "no libvirt support (install Sys::Virt)" - unless exists $INC{"Sys/Virt.pm"}; + die "virt-inspector: no libvirt support (install Sys::Virt, XML::XPath and XML::XPath::XMLParser)\n" + unless exists $INC{"Sys/Virt.pm"} && + exists $INC{"XML/XPath.pm"} && + exists $INC{"XML/XPath/XMLParser.pm"}; pod2usage ("$0: too many domains listed on command line") if @ARGV > 1; @@ -201,19 +235,14 @@ if (-e $ARGV[0]) { # Get the names of the image(s). my $xml = $dom->get_xml_description (); - my $p = new XML::XPath::XMLParser (xml => $xml); - my $disks = $p->find ("//devices/disk"); - print "disks:\n"; - foreach ($disks->get_nodelist) { - print XML::XPath::XMLParser::as_string($_); - } - - die "XXX" + my $p = XML::XPath->new (xml => $xml); + my @disks = $p->findnodes ('//devices/disk/source/@dev'); + @images = map { $_->getData } @disks; } # 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 (); @@ -269,7 +298,7 @@ L command line parameters, so that you can go in afterwards and inspect the guest with everything mounted in the right place. For example: - eval `virt-inspector --ro-fish guest.img` + guestfish $(virt-inspector --ro-fish guest.img) ==> guestfish --ro -a guest.img -m /dev/VG/LV:/ -m /dev/sda1:/boot =cut @@ -361,6 +390,7 @@ sub check_fs { $g->is_file ("/autoexec.bat") || $g->is_dir ("/Program Files") || $g->is_dir ("/WINDOWS") || + $g->is_file ("/boot.ini") || $g->is_file ("/ntldr")) { $r{fstype} = "ntfs"; # XXX this is a guess $r{fsos} = "windows"; @@ -429,13 +459,143 @@ sub check_linux_root } } +# We only support NT. The control file /boot.ini contains a list of +# Windows installations and their %systemroot%s in a simple text +# format. +# +# XXX We could parse this better. This won't work if /boot.ini is on +# a different drive from the %systemroot%, and in other unusual cases. + sub check_windows_root { local $_; my $r = shift; - # XXX Windows version. - # List of applications. + my $boot_ini = resolve_windows_path ("/", "boot.ini"); + $r->{boot_ini} = $boot_ini; + + if (defined $r->{boot_ini}) { + $_ = $g->cat ($boot_ini); + my @lines = split /\n/; + my $section; + my $systemroot; + foreach (@lines) { + if (m/\[.*\]/) { + $section = $1; + } elsif (m/^default=.*?\\(\w+)$/i) { + $systemroot = $1; + last; + } elsif (m/\\(\w+)=/) { + $systemroot = $1; + last; + } + } + + if (defined $systemroot) { + $r->{systemroot} = resolve_windows_path ("/", $systemroot); + if (defined $r->{systemroot} && $windows_registry) { + check_windows_registry ($r, $r->{systemroot}); + } + } + } +} + +sub check_windows_registry +{ + local $_; + my $r = shift; + my $systemroot = shift; + + # Download the system registry files. Only download the + # interesting ones, and we don't bother with user profiles at all. + my $system32 = resolve_windows_path ($systemroot, "system32"); + if (defined $system32) { + my $config = resolve_windows_path ($system32, "config"); + if (defined $config) { + my $software = resolve_windows_path ($config, "software"); + if (defined $software) { + load_windows_registry ($r, $software, + "HKEY_LOCAL_MACHINE\\SOFTWARE"); + } + my $system = resolve_windows_path ($config, "system"); + if (defined $system) { + load_windows_registry ($r, $system, + "HKEY_LOCAL_MACHINE\\System"); + } + } + } +} + +sub load_windows_registry +{ + local $_; + my $r = shift; + my $regfile = shift; + my $prefix = shift; + + my $dir = tempdir (CLEANUP => 1); + + $g->download ($regfile, "$dir/reg"); + + # 'reged' command is particularly noisy. Redirect stdout and + # stderr to /dev/null temporarily. + open SAVEOUT, ">&STDOUT"; + open SAVEERR, ">&STDERR"; + open STDOUT, ">/dev/null"; + open STDERR, ">/dev/null"; + + my @cmd = ("reged", "-x", "$dir/reg", "$prefix", "\\", "$dir/out"); + my $res = system (@cmd); + + close STDOUT; + close STDERR; + open STDOUT, ">&SAVEOUT"; + open STDERR, ">&SAVEERR"; + close SAVEOUT; + close SAVEERR; + + unless ($res == 0) { + warn "reged command failed: $?"; + return; + } + + # Some versions of reged segfault on inputs. If that happens we + # may get no / partial output file. Anyway, if it exists, load + # it. + my $content; + unless (open F, "$dir/out") { + warn "no output from reged command: $!"; + return; + } + { local $/ = undef; $content = ; } + close F; + + my @registry = (); + @registry = @{$r->{registry}} if exists $r->{registry}; + push @registry, $content; + $r->{registry} = \@registry; +} + +# Because of case sensitivity, the actual path might have a different +# name, and ntfs-3g is always case sensitive. Find out what the real +# path is. Returns the correct full path, or undef. +sub resolve_windows_path +{ + local $_; + my $parent = shift; # Must exist, with correct case. + my $dir = shift; + + foreach ($g->ls ($parent)) { + if (lc ($_) eq lc ($dir)) { + if ($parent eq "/") { + return "/$_" + } else { + return "$parent/$_" + } + } + } + + undef; } sub check_grub @@ -443,7 +603,7 @@ sub check_grub local $_; my $r = shift; - # XXX Kernel versions, grub version. + # Grub version, if we care. } #print Dumper (\%fses); @@ -553,6 +713,9 @@ sub find_filesystem # we don't need to know. if ($output !~ /.*fish$/) { + # Temporary directory for use by check_for_initrd. + my $dir = tempdir (CLEANUP => 1); + my $root_dev; foreach $root_dev (sort keys %oses) { my $mounts = $oses{$root_dev}->{mounts}; @@ -565,6 +728,10 @@ if ($output !~ /.*fish$/) { check_for_applications ($root_dev); check_for_kernels ($root_dev); + if ($oses{$root_dev}->{os} eq "linux") { + check_for_modprobe_aliases ($root_dev); + check_for_initrd ($root_dev, $dir); + } $g->umount_all (); } @@ -580,13 +747,14 @@ sub check_for_applications my $os = $oses{$root_dev}->{os}; if ($os eq "linux") { my $distro = $oses{$root_dev}->{distro}; - if ($distro eq "redhat") { + if (defined $distro && ($distro eq "redhat" || $distro eq "fedora")) { my @lines = $g->command_lines - (["rpm", "-q", "-a", "--qf", - "%{name} %{epoch} %{version} %{release} %{arch}\n"]); + (["rpm", + "-q", "-a", + "--qf", "%{name} %{epoch} %{version} %{release} %{arch}\n"]); foreach (@lines) { if (m/^(.*) (.*) (.*) (.*) (.*)$/) { - $epoch = $2; + my $epoch = $2; $epoch = "" if $epoch eq "(none)"; my $app = { name => $1, @@ -600,9 +768,15 @@ sub check_for_applications } } } elsif ($os eq "windows") { - # This sucks ... XXX - XXX + # 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 @@ -610,7 +784,114 @@ 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/ + # 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$, || m,([^/]+)\.o$,) { + push @modules, $1; + } + } + + $kernel{modules} = \@modules; + + push @kernels, \%kernel; + } + } + + } elsif ($os eq "windows") { + # XXX + } + + $oses{$root_dev}->{kernels} = \@kernels; +} + +# Check /etc/modprobe.conf to see if there are any specified +# drivers associated with network (ethX) or hard drives. Normally +# one might find something like: +# +# alias eth0 xennet +# alias scsi_hostadapter xenblk +# +# XXX This doesn't look beyond /etc/modprobe.conf, eg. in /etc/modprobe.d/ + +sub check_for_modprobe_aliases +{ + local $_; + my $root_dev = shift; + + my @lines; + eval { @lines = $g->read_lines ("/etc/modprobe.conf"); }; + return if $@ || !@lines; + + my %modprobe_aliases; + + foreach (@lines) { + $modprobe_aliases{$1} = $2 if /^\s*alias\s+(\S+)\s+(\S+)/; + } + + $oses{$root_dev}->{modprobe_aliases} = \%modprobe_aliases; +} + +# Get a listing of device drivers in any initrd corresponding to a +# kernel. This is an indication of what can possibly be booted. + +sub check_for_initrd +{ + local $_; + my $root_dev = shift; + my $dir = shift; + + my %initrd_modules; + + foreach my $initrd ($g->ls ("/boot")) { + if ($initrd =~ m/^initrd-(.*)\.img$/ && $g->is_file ("/boot/$initrd")) { + my $version = $1; + my @modules = (); + # We have to download these to a temporary file. + $g->download ("/boot/$initrd", "$dir/initrd"); + + my $cmd = "zcat $dir/initrd | file -"; + open P, "$cmd |" or die "$cmd: $!"; + my $lines; + { local $/ = undef; $lines =

; } + close P; + if ($lines =~ /ext\d filesystem data/) { + # Before initramfs came along, these were compressed + # ext2 filesystems. We could run another libguestfs + # instance to unpack these, but punt on them for now. (XXX) + warn "initrd image is unsupported ext2/3/4 filesystem\n"; + } + elsif ($lines =~ /cpio/) { + my $cmd = "zcat $dir/initrd | cpio --quiet -it"; + open P, "$cmd |" or die "$cmd: $!"; + while (

) { + push @modules, $1 + if m,([^/]+)\.ko$, || m,([^/]+)\.o$,; + } + close P; + unlink "$dir/initrd"; + $initrd_modules{$version} = \@modules; + } + else { + # What? + warn "unrecognized initrd image: $lines\n"; + } + } + } + + $oses{$root_dev}->{initrd_modules} = \%initrd_modules; } #---------------------------------------------------------------------- @@ -623,18 +904,17 @@ if ($output eq "fish" || $output eq "ro-fish") { my $root_dev = $osdevs[0]; - print "guestfish"; if ($output eq "ro-fish") { - print " --ro"; + print "--ro "; } - print " -a $_" foreach @images; + 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 "-m $mounts->{$_}:$_ " if $_ ne "swap"; } print "\n" } @@ -654,6 +934,11 @@ elsif ($output eq "xml") { output_xml (); } +# Query mode. +elsif ($output eq "query") { + output_query (); +} + sub output_text { output_text_os ($oses{$_}) foreach sort keys %oses; @@ -688,8 +973,53 @@ sub output_text_os if exists $filesystems->{$_}{content}; } - # XXX Applications. - # XXX Kernel. + if (exists $os->{modprobe_aliases}) { + my %aliases = %{$os->{modprobe_aliases}}; + my @keys = sort keys %aliases; + if (@keys) { + print " Modprobe aliases:\n"; + foreach (@keys) { + printf " %-30s %s\n", $_, $aliases{$_} + } + } + } + + if (exists $os->{initrd_modules}) { + my %modvers = %{$os->{initrd_modules}}; + my @keys = sort keys %modvers; + if (@keys) { + print " Initrd modules:\n"; + foreach (@keys) { + my @modules = @{$modvers{$_}}; + print " $_:\n"; + print " $_\n" foreach @modules; + } + } + } + + 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"; + } + } + + if (exists $os->{root}->{registry}) { + print " Windows Registry entries:\n"; + # These are just lumps of text - dump them out. + foreach (@{$os->{root}->{registry}}) { + print "$_\n"; + } + } } sub output_xml @@ -734,17 +1064,301 @@ sub output_xml_os } print "\n"; - # XXX Applications. - # XXX Kernel. + if (exists $os->{modprobe_aliases}) { + my %aliases = %{$os->{modprobe_aliases}}; + my @keys = sort keys %aliases; + if (@keys) { + print "\n"; + foreach (@keys) { + printf "%s\n", $_, $aliases{$_} + } + print "\n"; + } + } + + if (exists $os->{initrd_modules}) { + my %modvers = %{$os->{initrd_modules}}; + my @keys = sort keys %modvers; + if (@keys) { + print "\n"; + foreach (@keys) { + my @modules = @{$modvers{$_}}; + print "\n"; + print "$_\n" foreach @modules; + 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"; + + if (exists $os->{root}->{registry}) { + print "\n"; + # These are just lumps of text - dump them out. + foreach (@{$os->{root}->{registry}}) { + print "\n"; + print escape_xml($_), "\n"; + print "\n"; + } + print "\n"; + } + print "\n"; } +sub escape_xml +{ + local $_ = shift; + + s/&/&/g; + s//>/g; + return $_; +} + +=head1 QUERY MODE + +When you use C, the output is a series of +lines of the form: + + windows=no + linux=yes + fullvirt=yes + xen_pv_drivers=no + +(each answer is usually C or C, or the line is completely +missing if we could not determine the answer at all). + +If the guest is multiboot, you can get apparently conflicting answers +(eg. C and C, or a guest which is both +fullvirt and has a Xen PV kernel). This is normal, and just means +that the guest can do both things, although it might require operator +intervention such as selecting a boot option when the guest is +booting. + +This section describes the full range of answers possible. + +=over 4 + +=cut + +sub output_query +{ + output_query_windows (); + output_query_linux (); + output_query_rhel (); + output_query_fedora (); + output_query_debian (); + output_query_fullvirt (); + output_query_xen_domU_kernel (); + output_query_xen_pv_drivers (); + output_query_virtio_drivers (); +} + +=item windows=(yes|no) + +Answer C if Microsoft Windows is installed in the guest. + +=cut + +sub output_query_windows +{ + my $windows = "no"; + foreach my $os (keys %oses) { + $windows="yes" if $oses{$os}->{os} eq "windows"; + } + print "windows=$windows\n"; +} + +=item linux=(yes|no) + +Answer C if a Linux kernel is installed in the guest. + +=cut + +sub output_query_linux +{ + my $linux = "no"; + foreach my $os (keys %oses) { + $linux="yes" if $oses{$os}->{os} eq "linux"; + } + print "linux=$linux\n"; +} + +=item rhel=(yes|no) + +Answer C if the guest contains Red Hat Enterprise Linux. + +=cut + +sub output_query_rhel +{ + my $rhel = "no"; + foreach my $os (keys %oses) { + $rhel="yes" if $oses{$os}->{os} eq "linux" && $oses{$os}->{distro} eq "redhat"; + } + print "rhel=$rhel\n"; +} + +=item fedora=(yes|no) + +Answer C if the guest contains the Fedora Linux distribution. + +=cut + +sub output_query_fedora +{ + my $fedora = "no"; + foreach my $os (keys %oses) { + $fedora="yes" if $oses{$os}->{os} eq "linux" && $oses{$os}->{distro} eq "fedora"; + } + print "fedora=$fedora\n"; +} + +=item debian=(yes|no) + +Answer C if the guest contains the Debian Linux distribution. + +=cut + +sub output_query_debian +{ + my $debian = "no"; + foreach my $os (keys %oses) { + $debian="yes" if $oses{$os}->{os} eq "linux" && $oses{$os}->{distro} eq "debian"; + } + print "debian=$debian\n"; +} + +=item fullvirt=(yes|no) + +Answer C if there is at least one operating system kernel +installed in the guest which runs fully virtualized. Such a guest +would require a hypervisor which supports full system virtualization. + +=cut + +sub output_query_fullvirt +{ + # The assumption is full-virt, unless all installed kernels + # are identified as paravirt. + # XXX Fails on Windows guests. + foreach my $os (keys %oses) { + foreach my $kernel (@{$oses{$os}->{kernels}}) { + my $is_pv = $kernel->{version} =~ m/xen/; + unless ($is_pv) { + print "fullvirt=yes\n"; + return; + } + } + } + print "fullvirt=no\n"; +} + +=item xen_domU_kernel=(yes|no) + +Answer C if there is at least one Linux kernel installed in +the guest which is compiled as a Xen DomU (a Xen paravirtualized +guest). + +=cut + +sub output_query_xen_domU_kernel +{ + foreach my $os (keys %oses) { + foreach my $kernel (@{$oses{$os}->{kernels}}) { + my $is_xen = $kernel->{version} =~ m/xen/; + if ($is_xen) { + print "xen_domU_kernel=yes\n"; + return; + } + } + } + print "xen_domU_kernel=no\n"; +} + +=item xen_pv_drivers=(yes|no) + +Answer C if the guest has Xen paravirtualized drivers installed +(usually the kernel itself will be fully virtualized, but the PV +drivers have been installed by the administrator for performance +reasons). + +=cut + +sub output_query_xen_pv_drivers +{ + foreach my $os (keys %oses) { + foreach my $kernel (@{$oses{$os}->{kernels}}) { + foreach my $module (@{$kernel->{modules}}) { + if ($module =~ m/xen-/) { + print "xen_pv_drivers=yes\n"; + return; + } + } + } + } + print "xen_pv_drivers=no\n"; +} + +=item virtio_drivers=(yes|no) + +Answer C if the guest has virtio paravirtualized drivers +installed. Virtio drivers are commonly used to improve the +performance of KVM. + +=cut + +sub output_query_virtio_drivers +{ + foreach my $os (keys %oses) { + foreach my $kernel (@{$oses{$os}->{kernels}}) { + foreach my $module (@{$kernel->{modules}}) { + if ($module =~ m/virtio_/) { + print "virtio_drivers=yes\n"; + return; + } + } + } + } + print "virtio_drivers=no\n"; +} + +=back + =head1 SEE ALSO L, L, L, -L +L, +L. + +For Windows registry parsing we require the C program +from L. =head1 AUTHOR