use Pod::Usage;
use Getopt::Long;
use Data::Dumper;
+use File::Temp qw/tempdir/;
# Optional:
eval "use Sys::Virt;";
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.
See section I<QUERY MODE> below.
+=cut
+
+my $windows_registry;
+
+=item B<--windows-registry>
+
+If this item is passed, I<and> the guest is Windows, I<and> the
+external program C<reged> 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
"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;
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
$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";
}
}
+# 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 = <F>; }
+ 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
# 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};
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 ();
}
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;
$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 = <P>; }
+ 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 (<P>) {
+ 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.
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"
}
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) {
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 "</filesystems>\n";
+ if (exists $os->{modprobe_aliases}) {
+ my %aliases = %{$os->{modprobe_aliases}};
+ my @keys = sort keys %aliases;
+ if (@keys) {
+ print "<modprobealiases>\n";
+ foreach (@keys) {
+ printf "<alias device=\"%s\">%s</alias>\n", $_, $aliases{$_}
+ }
+ print "</modprobealiases>\n";
+ }
+ }
+
+ if (exists $os->{initrd_modules}) {
+ my %modvers = %{$os->{initrd_modules}};
+ my @keys = sort keys %modvers;
+ if (@keys) {
+ print "<initrds>\n";
+ foreach (@keys) {
+ my @modules = @{$modvers{$_}};
+ print "<initrd version=\"$_\">\n";
+ print "<module>$_</module>\n" foreach @modules;
+ print "</initrd>\n";
+ }
+ print "</initrds>\n";
+ }
+ }
+
print "<applications>\n";
my @apps = @{$os->{apps}};
foreach (@apps) {
}
print "</kernels>\n";
+ if (exists $os->{root}->{registry}) {
+ print "<windowsregistryentries>\n";
+ # These are just lumps of text - dump them out.
+ foreach (@{$os->{root}->{registry}}) {
+ print "<windowsregistryentry>\n";
+ print escape_xml($_), "\n";
+ print "</windowsregistryentry>\n";
+ }
+ print "</windowsregistryentries>\n";
+ }
+
print "</operatingsystem>\n";
}
+sub escape_xml
+{
+ local $_ = shift;
+
+ s/&/&/g;
+ s/</</g;
+ s/>/>/g;
+ return $_;
+}
+
=head1 QUERY MODE
When you use C<virt-inspector --query>, the output is a series of
L<guestfs(3)>,
L<guestfish(1)>,
L<Sys::Guestfs(3)>,
-L<Sys::Virt(3)>
+L<Sys::Virt(3)>,
+L<http://libguestfs.org/>.
+
+For Windows registry parsing we require the C<reged> program
+from L<http://home.eunet.no/~pnordahl/ntpasswd/>.
=head1 AUTHOR
git.annexia.org / libguestfs.git / blobdiff