X-Git-Url: http://git.annexia.org/?p=libguestfs.git;a=blobdiff_plain;f=inspector%2Fvirt-inspector.pl;h=8417675ea1e182f6c0e8fcf6f17d30cfa8119cbc;hp=247a8b6a6f7a8586d3352d55930f471f6d4f84cd;hb=247225c4415b28d02a82b7fc4dfdd35728437711;hpb=42b90f2d0d5b16da948f77e99e84c9192e742a4e diff --git a/inspector/virt-inspector.pl b/inspector/virt-inspector.pl index 247a8b6..8417675 100755 --- a/inspector/virt-inspector.pl +++ b/inspector/virt-inspector.pl @@ -27,6 +27,9 @@ use File::Temp qw/tempdir/; # Optional: eval "use Sys::Virt;"; +eval "use XML::XPath;"; +eval "use XML::XPath::XMLParser;"; +eval "use YAML::Any;"; =encoding utf8 @@ -132,6 +135,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 +153,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 +165,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 +189,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 +213,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 +229,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 +243,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 +311,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 +403,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 +472,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 @@ -685,14 +844,47 @@ 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 ) { + my $alias; + $alias = $g->aug_get($path); + + my $modulename; + $modulename = $g->aug_get($path.'/modulename'); + + $modprobe_aliases{$alias} = $modulename; + } } $oses{$root_dev}->{modprobe_aliases} = \%modprobe_aliases; @@ -758,18 +950,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 +970,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 (); @@ -867,6 +1066,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 @@ -962,9 +1169,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 @@ -1180,7 +1408,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