X-Git-Url: http://git.annexia.org/?p=libguestfs.git;a=blobdiff_plain;f=inspector%2Fvirt-inspector.pl;h=66b1553e5d583d3b2442b6ef6f92c9bb081259b4;hp=247a8b6a6f7a8586d3352d55930f471f6d4f84cd;hb=128f822e16bb96677c75b88125e18f48d7ccedaf;hpb=42b90f2d0d5b16da948f77e99e84c9192e742a4e diff --git a/inspector/virt-inspector.pl b/inspector/virt-inspector.pl index 247a8b6..66b1553 100755 --- a/inspector/virt-inspector.pl +++ b/inspector/virt-inspector.pl @@ -24,9 +24,13 @@ use Pod::Usage; use Getopt::Long; use Data::Dumper; use File::Temp qw/tempdir/; +use XML::Writer; # Optional: eval "use Sys::Virt;"; +eval "use XML::XPath;"; +eval "use XML::XPath::XMLParser;"; +eval "use YAML::Any;"; =encoding utf8 @@ -132,6 +136,11 @@ Produce no output at all. If you select I<--xml> then you get XML output which can be fed to other programs. +=item B<--yaml> + +If you select I<--yaml> then you get YAML output which can be fed +to other programs. + =item B<--perl> If you select I<--perl> then you get Perl structures output which @@ -145,7 +154,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. @@ -157,6 +166,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 @@ -167,12 +190,14 @@ GetOptions ("help|?" => \$help, "text" => sub { $output = "text" }, "none" => sub { $output = "none" }, "xml" => sub { $output = "xml" }, + "yaml" => sub { $output = "yaml" }, "perl" => sub { $output = "perl" }, "fish" => sub { $output = "fish" }, "guestfish" => sub { $output = "fish" }, "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; @@ -189,8 +214,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; @@ -203,6 +230,13 @@ if (-e $ARGV[0]) { die "cannot connect to libvirt $uri\n" unless $vmm; my @doms = $vmm->list_defined_domains (); + my $isitinactive = "an inactive libvirt domain"; + if ($output ne "fish") { + # In the special case where we want read-only access to + # a domain, allow the user to specify an active domain too. + push @doms, $vmm->list_domains (); + $isitinactive = "a libvirt domain"; + } my $dom; foreach (@doms) { if ($_->get_name () eq $ARGV[0]) { @@ -210,20 +244,14 @@ if (-e $ARGV[0]) { last; } } - die "$ARGV[0] is not the name of an inactive libvirt domain\n" - unless $dom; + die "$ARGV[0] is not the name of $isitinactive\n" unless $dom; # 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. @@ -284,7 +312,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 @@ -376,6 +404,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"; @@ -444,12 +473,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 @@ -512,6 +672,7 @@ sub assign_mount_points } else { $fs->{used} = 1 } + $fs->{spec} = $spec; } } } @@ -545,6 +706,12 @@ sub find_filesystem } else { return ($_, $fses{$_}) if exists $fses{$_}; + # The following is to handle the case where an fstab entry specifies a + # specific device rather than its label or uuid, and the libguestfs + # appliance has named the device differently due to the use of a + # different driver. + # This will work as long as the underlying drivers recognise devices in + # the same order. if (m{^/dev/hd(.*)} && exists $fses{"/dev/sd$1"}) { return ("/dev/sd$1", $fses{"/dev/sd$1"}); } @@ -567,9 +734,6 @@ 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}; @@ -584,7 +748,7 @@ if ($output !~ /.*fish$/) { check_for_kernels ($root_dev); if ($oses{$root_dev}->{os} eq "linux") { check_for_modprobe_aliases ($root_dev); - check_for_initrd ($root_dev, $dir); + check_for_initrd ($root_dev); } $g->umount_all (); @@ -685,14 +849,56 @@ sub check_for_modprobe_aliases local $_; my $root_dev = shift; - my @lines; - eval { @lines = $g->read_lines ("/etc/modprobe.conf"); }; - return if $@ || !@lines; + # Initialise augeas + my $success = 0; + $success = $g->aug_init("/", 16); + + # Register /etc/modules.conf and /etc/conf.modules to the Modprobe lens + my @results; + @results = $g->aug_match("/augeas/load/Modprobe/incl"); + + # Calculate the next index of /augeas/load/Modprobe/incl + my $i = 1; + foreach ( @results ) { + next unless m{/augeas/load/Modprobe/incl\[(\d*)]}; + $i = $1 + 1 if ($1 == $i); + } + + $success = $g->aug_set("/augeas/load/Modprobe/incl[$i]", + "/etc/modules.conf"); + $i++; + $success = $g->aug_set("/augeas/load/Modprobe/incl[$i]", + "/etc/conf.modules"); + + # Make augeas reload + $success = $g->aug_load(); my %modprobe_aliases; - foreach (@lines) { - $modprobe_aliases{$1} = $2 if /^\s*alias\s+(\S+)\s+(\S+)/; + for my $pattern qw(/files/etc/conf.modules/alias + /files/etc/modules.conf/alias + /files/etc/modprobe.conf/alias + /files/etc/modprobe.d/*/alias) { + @results = $g->aug_match($pattern); + + for my $path ( @results ) { + $path =~ m{^/files(.*)/alias(?:\[\d*\])?$} + or die("$path doesn't match augeas pattern"); + my $file = $1; + + my $alias; + $alias = $g->aug_get($path); + + my $modulename; + $modulename = $g->aug_get($path.'/modulename'); + + my %aliasinfo; + $aliasinfo{modulename} = $modulename; + $aliasinfo{augeas} = $path; + $aliasinfo{file} = $file; + + $modprobe_aliases{$alias} = \%aliasinfo; + } } $oses{$root_dev}->{modprobe_aliases} = \%modprobe_aliases; @@ -705,42 +911,22 @@ 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"; + my @modules; + + eval { + @modules = $g->initrd_list ("/boot/$initrd"); + }; + unless ($@) { + @modules = grep { m,([^/]+)\.ko$, || m,([^/]+)\.o$, } @modules; + $initrd_modules{$version} = \@modules + } else { + warn "/boot/$initrd: could not read initrd format" } } } @@ -758,18 +944,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" } @@ -779,6 +964,14 @@ elsif ($output eq "perl") { print Dumper(\%oses); } +# YAML output +elsif ($output eq "yaml") { + die "virt-inspector: no YAML support\n" + unless exists $INC{"YAML/Any.pm"}; + + print Dump(\%oses); +} + # Plain text output (the default). elsif ($output eq "text") { output_text (); @@ -834,7 +1027,7 @@ sub output_text_os if (@keys) { print " Modprobe aliases:\n"; foreach (@keys) { - printf " %-30s %s\n", $_, $aliases{$_} + printf " %-30s %s\n", $_, $aliases{$_}->{modulename} } } } @@ -867,59 +1060,82 @@ 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 { - print "\n"; - output_xml_os ($oses{$_}) foreach sort keys %oses; - print "\n"; + my $xml = new XML::Writer(DATA_MODE => 1, DATA_INDENT => 2); + + $xml->startTag("operatingsystems"); + output_xml_os ($oses{$_}, $xml) foreach sort keys %oses; + $xml->endTag("operatingsystems"); + + $xml->end(); } sub output_xml_os { - my $os = shift; + my ($os, $xml) = @_; - print "\n"; + $xml->startTag("operatingsystem"); - 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"; + foreach ( [ "name" => "os" ], + [ "distro" => "distro" ], + [ "version" => "version" ], + [ "root" => "root_device" ] ) { + $xml->dataElement($_->[0], $os->{$_->[1]}) if exists $os->{$_->[1]}; + } - print "\n"; + $xml->startTag("mountpoints"); my $mounts = $os->{mounts}; foreach (sort keys %$mounts) { - printf "%s\n", - $mounts->{$_}, $_ + $xml->dataElement("mountpoint", $_, "dev" => $mounts->{$_}); } - print "\n"; + $xml->endTag("mountpoints"); - print "\n"; + $xml->startTag("filesystems"); 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"; + $xml->startTag("filesystem", "dev" => $_); + + foreach my $field ( [ "label" => "label" ], + [ "uuid" => "uuid" ], + [ "type" => "fstype" ], + [ "content" => "content" ], + [ "spec" => "spec" ] ) { + $xml->dataElement($field->[0], $filesystems->{$_}{$field->[1]}) + if exists $filesystems->{$_}{$field->[1]}; + } + + $xml->endTag("filesystem"); } - print "\n"; + $xml->endTag("filesystems"); if (exists $os->{modprobe_aliases}) { my %aliases = %{$os->{modprobe_aliases}}; my @keys = sort keys %aliases; if (@keys) { - print "\n"; + $xml->startTag("modprobealiases"); foreach (@keys) { - printf "%s\n", $_, $aliases{$_} + $xml->startTag("alias", "device" => $_); + + foreach my $field ( [ "modulename" => "modulename" ], + [ "augeas" => "augeas" ], + [ "file" => "file" ] ) { + $xml->dataElement($field->[0], $aliases{$_}->{$field->[1]}); + } + + $xml->endTag("alias"); } - print "\n"; + $xml->endTag("modprobealiases"); } } @@ -927,42 +1143,51 @@ sub output_xml_os my %modvers = %{$os->{initrd_modules}}; my @keys = sort keys %modvers; if (@keys) { - print "\n"; + $xml->startTag("initrds"); foreach (@keys) { my @modules = @{$modvers{$_}}; - print "\n"; - print "$_\n" foreach @modules; - print "\n"; + $xml->startTag("initrd", "version" => $_); + $xml->dataElement("module", $_) foreach @modules; + $xml->endTag("initrd"); } - print "\n"; + $xml->endTag("initrds"); } } - print "\n"; + $xml->startTag("applications"); my @apps = @{$os->{apps}}; foreach (@apps) { - print "\n"; - print "$_->{name}$_->{version}\n"; - print "\n"; + $xml->startTag("application"); + $xml->dataElement("name", $_->{name}); + $xml->dataElement("version", $_->{version}); + $xml->endTag("application"); } - print "\n"; + $xml->endTag("applications"); - print "\n"; + $xml->startTag("kernels"); my @kernels = @{$os->{kernels}}; foreach (@kernels) { - print "\n"; - print "$_->{version}\n"; - print "\n"; + $xml->startTag("kernel", "version" => $_->{version}); + $xml->startTag("modules"); my @modules = @{$_->{modules}}; foreach (@modules) { - print "$_\n"; + $xml->dataElement("module", $_); } - print "\n"; - print "\n"; + $xml->endTag("modules"); + $xml->endTag("kernel"); } - print "\n"; + $xml->endTag("kernels"); - print "\n"; + if (exists $os->{root}->{registry}) { + $xml->startTag("windowsregistryentries"); + # These are just lumps of text - dump them out. + foreach (@{$os->{root}->{registry}}) { + $xml->dataElement("windowsregistryentry", $_); + } + $xml->endTag("windowsregistryentries"); + } + + $xml->endTag("operatingsystem"); } =head1 QUERY MODE @@ -1180,7 +1405,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