X-Git-Url: http://git.annexia.org/?p=libguestfs.git;a=blobdiff_plain;f=inspector%2Fvirt-inspector.pl;h=6aa63ad364d3f225154d1423aef20dd66f5a55f0;hp=08c4a899a4d955a6ba7eeb75a18f7732739b98e0;hb=215041c7178922341ecbfdb23eb203f2bb8c29c4;hpb=f18af71ff43dd87d343b459134a470900f84b833 diff --git a/inspector/virt-inspector.pl b/inspector/virt-inspector.pl index 08c4a89..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 @@ -144,7 +147,7 @@ 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. @@ -156,6 +159,20 @@ 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 @@ -172,6 +189,7 @@ GetOptions ("help|?" => \$help, "ro-fish" => sub { $output = "ro-fish" }, "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; @@ -188,8 +206,10 @@ if (-e $ARGV[0]) { } } } 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; @@ -215,14 +235,9 @@ 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. @@ -283,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 @@ -375,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"; @@ -443,12 +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; - # Windows version? + 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 @@ -566,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}; @@ -578,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 (); } @@ -593,10 +747,11 @@ 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/^(.*) (.*) (.*) (.*) (.*)$/) { my $epoch = $2; @@ -662,6 +817,83 @@ sub check_for_kernels $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; +} + #---------------------------------------------------------------------- # Output. @@ -672,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" } @@ -742,6 +973,30 @@ sub output_text_os if exists $filesystems->{$_}{content}; } + 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) { @@ -757,6 +1012,14 @@ sub output_text_os 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 @@ -801,6 +1064,33 @@ sub output_xml_os } print "\n"; + 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) { @@ -825,9 +1115,30 @@ sub output_xml_os } 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 @@ -1043,7 +1354,11 @@ sub output_query_virtio_drivers L, L, L, -L +L, +L. + +For Windows registry parsing we require the C program +from L. =head1 AUTHOR