X-Git-Url: http://git.annexia.org/?p=libguestfs.git;a=blobdiff_plain;f=inspector%2Fvirt-inspector.pl;h=d2acf0620a3b0ce24ca80110d567e65f6f36e82f;hp=982d286c3e00788460b5e445145989098e66a9fe;hb=06df9ec2413d7f5ae366bfab1b2177d7b3929837;hpb=5ca50cbee961aa2f8592b3a38fba41e2a732b282 diff --git a/inspector/virt-inspector.pl b/inspector/virt-inspector.pl index 982d286..d2acf06 100755 --- a/inspector/virt-inspector.pl +++ b/inspector/virt-inspector.pl @@ -20,12 +20,17 @@ use warnings; use strict; use Sys::Guestfs; +use Sys::Guestfs::Lib qw(open_guest get_partitions resolve_windows_path + inspect_all_partitions inspect_partition + inspect_operating_systems mount_operating_system inspect_in_detail); use Pod::Usage; use Getopt::Long; use Data::Dumper; +use XML::Writer; +use Locale::TextDomain 'libguestfs'; # Optional: -eval "use Sys::Virt;"; +eval "use YAML::Any;"; =encoding utf8 @@ -84,6 +89,14 @@ Display brief help. =cut +my $version; + +=item B<--version> + +Display version number and exit. + +=cut + my $uri; =item B<--connect URI> | B<-c URI> @@ -97,135 +110,117 @@ then libvirt is not used at all. =cut -my $force; +my $output = "text"; -=item B<--force> +=back -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. +The following options select the output format. Use only one of them. +The default is a readable text report. -=cut - -my $output = "text"; +=over 4 =item B<--text> (default) -=item B<--xml> +Plain text report. -=item B<--fish> +=item B<--none> -=item B<--ro-fish> +Produce no output at all. -Select the output format. The default is a readable text report. +=item B<--xml> 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 +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 GetOptions ("help|?" => \$help, + "version" => \$version, "connect|c=s" => \$uri, - "force" => \$force, + "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" }) - 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; - -# Domain name or guest image(s)? +if ($version) { + my $g = Sys::Guestfs->new (); + my %h = $g->version (); + print "$h{major}.$h{minor}.$h{release}$h{extra}\n"; + exit +} +pod2usage (__"virt-inspector: no image or VM names given") if @ARGV == 0; +my $rw = 0; +$rw = 1 if $output eq "fish"; +my $g; 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"); - } - } +if ($uri) { + my ($conn, $dom); + ($g, $conn, $dom, @images) = + open_guest (\@ARGV, rw => $rw, address => $uri); } else { - die "no libvirt support (install Sys::Virt)" - unless exists $INC{"Sys/Virt.pm"}; - - pod2usage ("$0: too many domains listed on command line") if @ARGV > 1; - - my $vmm; - if (defined $uri) { - $vmm = Sys::Virt->new (uri => $uri, readonly => 1); - } else { - $vmm = Sys::Virt->new (readonly => 1); - } - die "cannot connect to libvirt $uri\n" unless $vmm; - - my @doms = $vmm->list_defined_domains (); - my $dom; - foreach (@doms) { - if ($_->get_name () eq $ARGV[0]) { - $dom = $_; - last; - } - } - die "$ARGV[0] is not the name of an inactive libvirt domain\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 ($conn, $dom); + ($g, $conn, $dom, @images) = + open_guest (\@ARGV, rw => $rw); } -# We've now got the list of @images, so feed them to libguestfs. -my $g = Sys::Guestfs->new (); -$g->add_drive ($_) foreach @images; $g->launch (); $g->wait_ready (); -# We want to get the list of LVs and partitions (ie. anything that -# could contain a filesystem). Discard any partitions which are PVs. -my @partitions = $g->list_partitions (); -my @pvs = $g->pvs (); -sub is_pv { - my $t = shift; - foreach (@pvs) { - return 1 if $_ eq $t; - } - 0; -} -@partitions = grep { ! is_pv ($_) } @partitions; - -my @lvs = $g->lvs (); - =head1 OUTPUT FORMAT Operating system(s) @@ -263,362 +258,581 @@ 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 # List of possible filesystems. -my @devices = sort (@lvs, @partitions); +my @partitions = get_partitions ($g); # Now query each one to build up a picture of what's in it. -my %fses = map { $_ => check_fs ($_) } @devices; - -# Now the complex checking code itself. -# check_fs takes a device name (LV or partition name) and returns -# a hashref containing everything we can find out about the device. -sub check_fs { - local $_; - my $dev = shift; # LV or partition name. - - my %r; # Result hash. - - # First try 'file(1)' on it. - my $file = $g->file ($dev); - if ($file =~ /ext2 filesystem data/) { - $r{fstype} = "ext2"; - $r{fsos} = "linux"; - } elsif ($file =~ /ext3 filesystem data/) { - $r{fstype} = "ext3"; - $r{fsos} = "linux"; - } elsif ($file =~ /ext4 filesystem data/) { - $r{fstype} = "ext4"; - $r{fsos} = "linux"; - } elsif ($file =~ m{Linux/i386 swap file}) { - $r{fstype} = "swap"; - $r{fsos} = "linux"; - $r{is_swap} = 1; +my %fses = + inspect_all_partitions ($g, \@partitions, + use_windows_registry => $windows_registry); + +#print "fses -----------\n"; +#print Dumper(\%fses); + +my $oses = inspect_operating_systems ($g, \%fses); + +#print "oses -----------\n"; +#print Dumper($oses); + +# Mount up the disks so we can check for applications +# and kernels. Skip this if the output is "*fish" because +# we don't need to know. + +if ($output !~ /.*fish$/) { + my $root_dev; + foreach $root_dev (sort keys %$oses) { + my $os = $oses->{$root_dev}; + mount_operating_system ($g, $os); + inspect_in_detail ($g, $os); + $g->umount_all (); } +} - # If it's ext2/3/4, then we want the UUID and label. - if (exists $r{fstype} && $r{fstype} =~ /^ext/) { - $r{uuid} = $g->get_e2uuid ($dev); - $r{label} = $g->get_e2label ($dev); +#---------------------------------------------------------------------- +# Output. + +if ($output eq "fish" || $output eq "ro-fish") { + my @osdevs = keys %$oses; + # This only works if there is a single OS. + die __"--fish output is only possible with a single OS\n" if @osdevs != 1; + + my $root_dev = $osdevs[0]; + + if ($output eq "ro-fish") { + print "--ro "; } - # Try mounting it, fnarrr. - if (!$r{is_swap}) { - $r{is_mountable} = 1; - eval { $g->mount_ro ($dev, "/") }; - if ($@) { - # It's not mountable, probably empty or some format - # we don't understand. - $r{is_mountable} = 0; - goto OUT; - } + print "-a $_ " foreach @images; - # Grub /boot? - if ($g->is_file ("/grub/menu.lst") || - $g->is_file ("/grub/grub.conf")) { - $r{content} = "linux-grub"; - check_grub (\%r); - goto OUT; - } + 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" && $_ ne "none"; + } + print "\n" +} + +# Perl output. +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); +} - # Linux root? - if ($g->is_dir ("/etc") && $g->is_dir ("/bin") && - $g->is_file ("/etc/fstab")) { - $r{content} = "linux-root"; - $r{is_root} = 1; - check_linux_root (\%r); - goto OUT; +# Plain text output (the default). +elsif ($output eq "text") { + output_text (); +} + +# XML output. +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; +} + +sub output_text_os +{ + my $os = shift; + + print $os->{os}, " " if exists $os->{os}; + print $os->{distro}, " " if exists $os->{distro}; + print $os->{arch}, " " if exists $os->{arch}; + print $os->{major_version} if exists $os->{major_version}; + print ".", $os->{minor_version} if exists $os->{minor_version}; + print " "; + print "on ", $os->{root_device}, ":\n"; + + print __" Mountpoints:\n"; + my $mounts = $os->{mounts}; + foreach (sort keys %$mounts) { + printf " %-30s %s\n", $mounts->{$_}, $_ + } + + print __" Filesystems:\n"; + my $filesystems = $os->{filesystems}; + foreach (sort keys %$filesystems) { + print " $_:\n"; + print " label: $filesystems->{$_}{label}\n" + if exists $filesystems->{$_}{label}; + print " UUID: $filesystems->{$_}{uuid}\n" + if exists $filesystems->{$_}{uuid}; + print " type: $filesystems->{$_}{fstype}\n" + if exists $filesystems->{$_}{fstype}; + print " content: $filesystems->{$_}{content}\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{$_}->{modulename} + } } + } - # Linux /usr/local. - if ($g->is_dir ("/etc") && $g->is_dir ("/bin") && - $g->is_dir ("/share") && !$g->exists ("/local") && - !$g->is_file ("/etc/fstab")) { - $r{content} = "linux-usrlocal"; - goto OUT; + 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" + } - # Linux /usr. - if ($g->is_dir ("/etc") && $g->is_dir ("/bin") && - $g->is_dir ("/share") && $g->exists ("/local") && - !$g->is_file ("/etc/fstab")) { - $r{content} = "linux-usr"; - goto OUT; + print __" Kernels:\n"; + my @kernels = @{$os->{kernels}}; + foreach (@kernels) { + print " $_->{version} ($_->{arch})\n"; + my @modules = @{$_->{modules}}; + foreach (@modules) { + print " $_\n"; } + } - # Windows root? - if ($g->is_file ("/AUTOEXEC.BAT") || - $g->is_file ("/autoexec.bat") || - $g->is_dir ("/Program Files") || - $g->is_dir ("/WINDOWS") || - $g->is_file ("/ntldr")) { - $r{fstype} = "ntfs"; # XXX this is a guess - $r{fsos} = "windows"; - $r{content} = "windows-root"; - $r{is_root} = 1; - check_windows_root (\%r); - goto OUT; + 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 +{ + 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"); - OUT: - $g->umount_all (); - return \%r; + $xml->end(); } -sub check_linux_root +sub output_xml_os { - local $_; - my $r = shift; - - # Look into /etc to see if we recognise the operating system. - if ($g->is_file ("/etc/redhat-release")) { - $_ = $g->cat ("/etc/redhat-release"); - if (/Fedora release (\d+\.\d+)/) { - $r->{osdistro} = "fedora"; - $r->{osversion} = "$1" - } elsif (/(Red Hat Enterprise Linux|CentOS|Scientific Linux).*release (\d+).*Update (\d+)/) { - $r->{osdistro} = "redhat"; - $r->{osversion} = "$2.$3"; - } elsif (/(Red Hat Enterprise Linux|CentOS|Scientific Linux).*release (\d+(?:\.(\d+))?)/) { - $r->{osdistro} = "redhat"; - $r->{osversion} = "$2"; - } else { - $r->{osdistro} = "redhat"; - } - } elsif ($g->is_file ("/etc/debian_version")) { - $_ = $g->cat ("/etc/debian_version"); - if (/(\d+\.\d+)/) { - $r->{osdistro} = "debian"; - $r->{osversion} = "$1"; - } else { - $r->{osdistro} = "debian"; + my ($os, $xml) = @_; + + $xml->startTag("operatingsystem"); + + foreach ( [ "name" => "os" ], + [ "distro" => "distro" ], + [ "arch" => "arch" ], + [ "major_version" => "major_version" ], + [ "minor_version" => "minor_version" ], + [ "package_format" => "package_format" ], + [ "package_management" => "package_management" ], + [ "root" => "root_device" ] ) { + $xml->dataElement($_->[0], $os->{$_->[1]}) if exists $os->{$_->[1]}; + } + + $xml->startTag("mountpoints"); + my $mounts = $os->{mounts}; + foreach (sort keys %$mounts) { + $xml->dataElement("mountpoint", $_, "dev" => $mounts->{$_}); + } + $xml->endTag("mountpoints"); + + $xml->startTag("filesystems"); + my $filesystems = $os->{filesystems}; + foreach (sort keys %$filesystems) { + $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"); + } + $xml->endTag("filesystems"); + + if (exists $os->{modprobe_aliases}) { + my %aliases = %{$os->{modprobe_aliases}}; + my @keys = sort keys %aliases; + if (@keys) { + $xml->startTag("modprobealiases"); + foreach (@keys) { + $xml->startTag("alias", "device" => $_); + + foreach my $field ( [ "modulename" => "modulename" ], + [ "augeas" => "augeas" ], + [ "file" => "file" ] ) { + $xml->dataElement($field->[0], $aliases{$_}->{$field->[1]}); + } + + $xml->endTag("alias"); + } + $xml->endTag("modprobealiases"); } } - # Parse the contents of /etc/fstab. This is pretty vital so - # we can determine where filesystems are supposed to be mounted. - eval "\$_ = \$g->cat ('/etc/fstab');"; - if (!$@ && $_) { - my @lines = split /\n/; - my @fstab; - foreach (@lines) { - my @fields = split /[ \t]+/; - if (@fields >= 2) { - my $spec = $fields[0]; # first column (dev/label/uuid) - my $file = $fields[1]; # second column (mountpoint) - if ($spec =~ m{^/} || - $spec =~ m{^LABEL=} || - $spec =~ m{^UUID=} || - $file eq "swap") { - push @fstab, [$spec, $file] - } + if (exists $os->{initrd_modules}) { + my %modvers = %{$os->{initrd_modules}}; + my @keys = sort keys %modvers; + if (@keys) { + $xml->startTag("initrds"); + foreach (@keys) { + my @modules = @{$modvers{$_}}; + $xml->startTag("initrd", "version" => $_); + $xml->dataElement("module", $_) foreach @modules; + $xml->endTag("initrd"); } + $xml->endTag("initrds"); } - $r->{fstab} = \@fstab if @fstab; } + + $xml->startTag("applications"); + my @apps = @{$os->{apps}}; + foreach (@apps) { + $xml->startTag("application"); + $xml->dataElement("name", $_->{name}); + $xml->dataElement("version", $_->{version}); + $xml->endTag("application"); + } + $xml->endTag("applications"); + + $xml->startTag("kernels"); + my @kernels = @{$os->{kernels}}; + foreach (@kernels) { + $xml->startTag("kernel", + "version" => $_->{version}, + "arch" => $_->{arch}); + $xml->startTag("modules"); + my @modules = @{$_->{modules}}; + foreach (@modules) { + $xml->dataElement("module", $_); + } + $xml->endTag("modules"); + $xml->endTag("kernel"); + } + $xml->endTag("kernels"); + + 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"); } -sub check_windows_root -{ - local $_; - my $r = shift; +=head1 QUERY MODE + +When you use C, the output is a series of +lines of the form: - # XXX Windows version. - # List of applications. + 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 (); + output_query_kernel_arch (); + output_query_userspace_arch (); } -sub check_grub +=item windows=(yes|no) + +Answer C if Microsoft Windows is installed in the guest. + +=cut + +sub output_query_windows { - local $_; - my $r = shift; + my $windows = "no"; + foreach my $os (keys %$oses) { + $windows="yes" if $oses->{$os}->{os} eq "windows"; + } + print "windows=$windows\n"; +} + +=item linux=(yes|no) - # XXX Kernel versions, grub version. +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"; } -#print Dumper (\%fses); +=item rhel=(yes|no) -#---------------------------------------------------------------------- -# Now find out how many operating systems we've got. Usually just one. - -my %oses = (); - -foreach (sort keys %fses) { - if ($fses{$_}->{is_root}) { - my %r = ( - root => $fses{$_}, - root_device => $_ - ); - get_os_version (\%r); - assign_mount_points (\%r); - $oses{$_} = \%r; +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 "rhel"); } + print "rhel=$rhel\n"; } -sub get_os_version +=item fedora=(yes|no) + +Answer C if the guest contains the Fedora Linux distribution. + +=cut + +sub output_query_fedora { - local $_; - my $r = shift; + 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 - $r->{os} = $r->{root}->{fsos} if exists $r->{root}->{fsos}; - $r->{distro} = $r->{root}->{osdistro} if exists $r->{root}->{osdistro}; - $r->{version} = $r->{root}->{osversion} if exists $r->{root}->{osversion}; +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"; } -sub assign_mount_points +=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 { - local $_; - my $r = shift; - - $r->{mounts} = { "/" => $r->{root_device} }; - $r->{filesystems} = { $r->{root_device} => $r->{root} }; - - # Use /etc/fstab if we have it to mount the rest. - if (exists $r->{root}->{fstab}) { - my @fstab = @{$r->{root}->{fstab}}; - foreach (@fstab) { - my ($spec, $file) = @$_; - - my ($dev, $fs) = find_filesystem ($spec); - if ($dev) { - $r->{mounts}->{$file} = $dev; - $r->{filesystems}->{$dev} = $fs; - if (exists $fs->{used}) { - $fs->{used}++ - } else { - $fs->{used} = 1 - } + # 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"; } -# Find filesystem by device name, LABEL=.. or UUID=.. -sub find_filesystem +=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 { - local $_ = shift; - - if (/^LABEL=(.*)/) { - my $label = $1; - foreach (sort keys %fses) { - if (exists $fses{$_}->{label} && - $fses{$_}->{label} eq $label) { - return ($_, $fses{$_}); + 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; } } - warn "unknown filesystem label $label\n"; - return (); - } elsif (/^UUID=(.*)/) { - my $uuid = $1; - foreach (sort keys %fses) { - if (exists $fses{$_}->{uuid} && - $fses{$_}->{uuid} eq $uuid) { - return ($_, $fses{$_}); - } - } - warn "unknown filesystem UUID $uuid\n"; - return (); - } else { - return ($_, $fses{$_}) if exists $fses{$_}; + } + print "xen_domU_kernel=no\n"; +} - if (m{^/dev/hd(.*)} && exists $fses{"/dev/sd$1"}) { - return ("/dev/sd$1", $fses{"/dev/sd$1"}); - } - if (m{^/dev/xvd(.*)} && exists $fses{"/dev/sd$1"}) { - return ("/dev/sd$1", $fses{"/dev/sd$1"}); - } +=item xen_pv_drivers=(yes|no) - return () if m{/dev/cdrom}; +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 - warn "unknown filesystem $_\n"; - return (); +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"; } -#print Dumper(\%oses); +=item virtio_drivers=(yes|no) -#---------------------------------------------------------------------- -# Mount up the disks so we can check for applications -# and kernels. Skip this if the output is "*fish" because -# we don't need to know. - -if ($output !~ /.*fish$/) { - my $root_dev; - foreach $root_dev (sort keys %oses) { - 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) { - $g->mount_ro ($mounts->{$_}, $_) - if $_ ne "swap" && ($_ eq '/' || $g->is_dir ($_)); - } +Answer C if the guest has virtio paravirtualized drivers +installed. Virtio drivers are commonly used to improve the +performance of KVM. - check_for_applications ($root_dev); - check_for_kernels ($root_dev); +=cut - umount_all (); +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"; } -sub check_for_applications -{ - local $_; - my $root_dev = shift; +=item userspace_arch=(x86_64|...) - # XXX rpm -qa, look in Program Files, or whatever -} +Print the architecture of userspace. -sub check_for_kernels +NB. For multi-boot VMs this can print several lines. + +=cut + +sub output_query_userspace_arch { - local $_; - my $root_dev = shift; + my %arches; + + foreach my $os (keys %$oses) { + $arches{$oses->{$os}->{arch}} = 1 if exists $oses->{$os}->{arch}; + } - # XXX + foreach (sort keys %arches) { + print "userspace_arch=$_\n"; + } } -#---------------------------------------------------------------------- -# Output. +=item kernel_arch=(x86_64|...) -if ($output eq "fish" || $output eq "ro-fish") { - my @osdevs = keys %oses; - # This only works if there is a single OS. - die "--fish output is only possible with a single OS\n" if @osdevs != 1; +Print the architecture of the kernel. - my $root_dev = $osdevs[0]; +NB. For multi-boot VMs this can print several lines. - print "guestfish"; - if ($output eq "ro-fish") { - print " --ro"; - } +=cut - print " -a $_" foreach @images; +sub output_query_kernel_arch +{ + my %arches; - 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"; + foreach my $os (keys %$oses) { + foreach my $kernel (@{$oses->{$os}->{kernels}}) { + $arches{$kernel->{arch}} = 1 if exists $kernel->{arch}; + } } - print "\n" -} + foreach (sort keys %arches) { + print "kernel_arch=$_\n"; + } +} +=back =head1 SEE ALSO L, L, L, -L +L, +L, +L. + +For Windows registry parsing we require the C program +from L. =head1 AUTHOR Richard W.M. Jones L +Matthew Booth L + =head1 COPYRIGHT Copyright (C) 2009 Red Hat Inc.