inspector/virt-inspector

   1 #!/usr/bin/perl -w
   2 # virt-inspector
   3 # Copyright (C) 2009 Red Hat Inc.
   4 #
   5 # This program is free software; you can redistribute it and/or modify
   6 # it under the terms of the GNU General Public License as published by
   7 # the Free Software Foundation; either version 2 of the License, or
   8 # (at your option) any later version.
   9 #
  10 # This program is distributed in the hope that it will be useful,
  11 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13 # GNU General Public License for more details.
  14 #
  15 # You should have received a copy of the GNU General Public License
  16 # along with this program; if not, write to the Free Software
  17 # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  18
  19 use warnings;
  20 use strict;
  21
  22 use Sys::Guestfs;
  23 use Sys::Guestfs::Lib qw(open_guest get_partitions resolve_windows_path
  24   inspect_all_partitions inspect_partition
  25   inspect_operating_systems mount_operating_system inspect_in_detail);
  26 use Pod::Usage;
  27 use Getopt::Long;
  28 use Data::Dumper;
  29 use XML::Writer;
  30 use Locale::TextDomain 'libguestfs';
  31
  32 # Optional:
  33 eval "use YAML::Any;";
  34
  35 =encoding utf8
  36
  37 =head1 NAME
  38
  39 virt-inspector - Display OS version, kernel, drivers, mount points, applications, etc. in a virtual machine
  40
  41 =head1 SYNOPSIS
  42
  43  virt-inspector [--connect URI] domname
  44
  45  virt-inspector guest.img [guest.img ...]
  46
  47 =head1 DESCRIPTION
  48
  49 B<virt-inspector> examines a virtual machine and tries to determine
  50 the version of the OS, the kernel version, what drivers are installed,
  51 whether the virtual machine is fully virtualized (FV) or
  52 para-virtualized (PV), what applications are installed and more.
  53
  54 Virt-inspector can produce output in several formats, including a
  55 readable text report, and XML for feeding into other programs.
  56
  57 Virt-inspector should only be run on I<inactive> virtual machines.
  58 The program tries to determine that the machine is inactive and will
  59 refuse to run if it thinks you are trying to inspect a running domain.
  60
  61 In the normal usage, use C<virt-inspector domname> where C<domname> is
  62 the libvirt domain (see: C<virsh list --all>).
  63
  64 You can also run virt-inspector directly on disk images from a single
  65 virtual machine.  Use C<virt-inspector guest.img>.  In rare cases a
  66 domain has several block devices, in which case you should list them
  67 one after another, with the first corresponding to the guest's
  68 C</dev/sda>, the second to the guest's C</dev/sdb> and so on.
  69
  70 Virt-inspector can only inspect and report upon I<one domain at a
  71 time>.  To inspect several virtual machines, you have to run
  72 virt-inspector several times (for example, from a shell script
  73 for-loop).
  74
  75 Because virt-inspector needs direct access to guest images, it won't
  76 normally work over remote libvirt connections.
  77
  78 =head1 OPTIONS
  79
  80 =over 4
  81
  82 =cut
  83
  84 my $help;
  85
  86 =item B<--help>
  87
  88 Display brief help.
  89
  90 =cut
  91
  92 my $version;
  93
  94 =item B<--version>
  95
  96 Display version number and exit.
  97
  98 =cut
  99
 100 my $uri;
 101
 102 =item B<--connect URI> | B<-c URI>
 103
 104 If using libvirt, connect to the given I<URI>.  If omitted,
 105 then we connect to the default libvirt hypervisor.
 106
 107 Libvirt is only used if you specify a C<domname> on the
 108 command line.  If you specify guest block devices directly,
 109 then libvirt is not used at all.
 110
 111 =cut
 112
 113 my $output = "text";
 114
 115 =back
 116
 117 The following options select the output format.  Use only one of them.
 118 The default is a readable text report.
 119
 120 =over 4
 121
 122 =item B<--text> (default)
 123
 124 Plain text report.
 125
 126 =item B<--none>
 127
 128 Produce no output at all.
 129
 130 =item B<--xml>
 131
 132 If you select I<--xml> then you get XML output which can be fed
 133 to other programs.
 134
 135 =item B<--yaml>
 136
 137 If you select I<--yaml> then you get YAML output which can be fed
 138 to other programs.
 139
 140 =item B<--perl>
 141
 142 If you select I<--perl> then you get Perl structures output which
 143 can be used directly in another Perl program.
 144
 145 =item B<--fish>
 146
 147 =item B<--ro-fish>
 148
 149 If you select I<--fish> then we print a L<guestfish(1)> command
 150 line which will automatically mount up the filesystems on the
 151 correct mount points.  Try this for example:
 152
 153  guestfish $(virt-inspector --fish guest.img)
 154
 155 I<--ro-fish> is the same, but the I<--ro> option is passed to
 156 guestfish so that the filesystems are mounted read-only.
 157
 158 =item B<--query>
 159
 160 In "query mode" we answer common questions about the guest, such
 161 as whether it is fullvirt or needs a Xen hypervisor to run.
 162
 163 See section I<QUERY MODE> below.
 164
 165 =cut
 166
 167 my $windows_registry;
 168
 169 =item B<--windows-registry>
 170
 171 If this item is passed, I<and> the guest is Windows, I<and> the
 172 external program C<reged> is available (see SEE ALSO section), then we
 173 attempt to parse the Windows registry.  This allows much more
 174 information to be gathered for Windows guests.
 175
 176 This is quite an expensive and slow operation, so we don't do it by
 177 default.
 178
 179 =back
 180
 181 =cut
 182
 183 GetOptions ("help|?" => \$help,
 184             "version" => \$version,
 185             "connect|c=s" => \$uri,
 186             "text" => sub { $output = "text" },
 187             "none" => sub { $output = "none" },
 188             "xml" => sub { $output = "xml" },
 189             "yaml" => sub { $output = "yaml" },
 190             "perl" => sub { $output = "perl" },
 191             "fish" => sub { $output = "fish" },
 192             "guestfish" => sub { $output = "fish" },
 193             "ro-fish" => sub { $output = "ro-fish" },
 194             "ro-guestfish" => sub { $output = "ro-fish" },
 195             "query" => sub { $output = "query" },
 196             "windows-registry" => \$windows_registry,
 197     ) or pod2usage (2);
 198 pod2usage (1) if $help;
 199 if ($version) {
 200     my $g = Sys::Guestfs->new ();
 201     my %h = $g->version ();
 202     print "$h{major}.$h{minor}.$h{release}$h{extra}\n";
 203     exit
 204 }
 205 pod2usage (__"virt-inspector: no image or VM names given") if @ARGV == 0;
 206
 207 my $rw = 0;
 208 $rw = 1 if $output eq "fish";
 209 my $g;
 210 my @images;
 211 if ($uri) {
 212     my ($conn, $dom);
 213     ($g, $conn, $dom, @images) =
 214         open_guest (\@ARGV, rw => $rw, address => $uri);
 215 } else {
 216     my ($conn, $dom);
 217     ($g, $conn, $dom, @images) =
 218         open_guest (\@ARGV, rw => $rw);
 219 }
 220
 221 $g->launch ();
 222
 223 =head1 OUTPUT FORMAT
 224
 225  Operating system(s)
 226  -------------------
 227  Linux (distro + version)
 228  Windows (version)
 229     |
 230     |
 231     +--- Filesystems ---------- Installed apps --- Kernel & drivers
 232          -----------            --------------     ----------------
 233          mount point => device  List of apps       Extra information
 234          mount point => device  and versions       about kernel(s)
 235               ...                                  and drivers
 236          swap => swap device
 237          (plus lots of extra information
 238          about each filesystem)
 239
 240 The output of virt-inspector is a complex two-level data structure.
 241
 242 At the top level is a list of the operating systems installed on the
 243 guest.  (For the vast majority of guests, only a single OS is
 244 installed.)  The data returned for the OS includes the name (Linux,
 245 Windows), the distribution and version.
 246
 247 The diagram above shows what we return for each OS.
 248
 249 With the I<--xml> option the output is mapped into an XML document.
 250 There is a RELAX-NG schema for this XML in the file
 251 I<virt-inspector.rng> which normally ships with virt-inspector, or can
 252 be found in the source.
 253
 254 With the I<--fish> or I<--ro-fish> option the mount points are mapped to
 255 L<guestfish(1)> command line parameters, so that you can go in
 256 afterwards and inspect the guest with everything mounted in the
 257 right place.  For example:
 258
 259  guestfish $(virt-inspector --ro-fish guest.img)
 260  ==> guestfish --ro -a guest.img -m /dev/VG/LV:/ -m /dev/sda1:/boot
 261
 262 =cut
 263
 264 # List of possible filesystems.
 265 my @partitions = get_partitions ($g);
 266
 267 # Now query each one to build up a picture of what's in it.
 268 my %fses =
 269     inspect_all_partitions ($g, \@partitions,
 270       use_windows_registry => $windows_registry);
 271
 272 #print "fses -----------\n";
 273 #print Dumper(\%fses);
 274
 275 my $oses = inspect_operating_systems ($g, \%fses);
 276
 277 #print "oses -----------\n";
 278 #print Dumper($oses);
 279
 280 # Mount up the disks so we can check for applications
 281 # and kernels.  Skip this if the output is "*fish" because
 282 # we don't need to know.
 283
 284 if ($output !~ /.*fish$/) {
 285     my $root_dev;
 286     foreach $root_dev (sort keys %$oses) {
 287         my $os = $oses->{$root_dev};
 288         mount_operating_system ($g, $os);
 289         inspect_in_detail ($g, $os);
 290         $g->umount_all ();
 291     }
 292 }
 293
 294 #----------------------------------------------------------------------
 295 # Output.
 296
 297 if ($output eq "fish" || $output eq "ro-fish") {
 298     my @osdevs = keys %$oses;
 299     # This only works if there is a single OS.
 300     die __"--fish output is only possible with a single OS\n" if @osdevs != 1;
 301
 302     my $root_dev = $osdevs[0];
 303
 304     if ($output eq "ro-fish") {
 305         print "--ro ";
 306     }
 307
 308     print "-a $_ " foreach @images;
 309
 310     my $mounts = $oses->{$root_dev}->{mounts};
 311     # Have to mount / first.  Luckily '/' is early in the ASCII
 312     # character set, so this should be OK.
 313     foreach (sort keys %$mounts) {
 314         print "-m $mounts->{$_}:$_ " if $_ ne "swap" && $_ ne "none";
 315     }
 316     print "\n"
 317 }
 318
 319 # Perl output.
 320 elsif ($output eq "perl") {
 321     print Dumper(%$oses);
 322 }
 323
 324 # YAML output
 325 elsif ($output eq "yaml") {
 326     die __"virt-inspector: no YAML support\n"
 327         unless exists $INC{"YAML/Any.pm"};
 328
 329     print Dump(%$oses);
 330 }
 331
 332 # Plain text output (the default).
 333 elsif ($output eq "text") {
 334     output_text ();
 335 }
 336
 337 # XML output.
 338 elsif ($output eq "xml") {
 339     output_xml ();
 340 }
 341
 342 # Query mode.
 343 elsif ($output eq "query") {
 344     output_query ();
 345 }
 346
 347 sub output_text
 348 {
 349     output_text_os ($oses->{$_}) foreach sort keys %$oses;
 350 }
 351
 352 sub output_text_os
 353 {
 354     my $os = shift;
 355
 356     print $os->{os}, " " if exists $os->{os};
 357     print $os->{distro}, " " if exists $os->{distro};
 358     print $os->{arch}, " " if exists $os->{arch};
 359     print $os->{major_version} if exists $os->{major_version};
 360     print ".", $os->{minor_version} if exists $os->{minor_version};
 361     print " ";
 362     print "on ", $os->{root_device}, ":\n";
 363
 364     print __"  Mountpoints:\n";
 365     my $mounts = $os->{mounts};
 366     foreach (sort keys %$mounts) {
 367         printf "    %-30s %s\n", $mounts->{$_}, $_
 368     }
 369
 370     print __"  Filesystems:\n";
 371     my $filesystems = $os->{filesystems};
 372     foreach (sort keys %$filesystems) {
 373         print "    $_:\n";
 374         print "      label: $filesystems->{$_}{label}\n"
 375             if exists $filesystems->{$_}{label};
 376         print "      UUID: $filesystems->{$_}{uuid}\n"
 377             if exists $filesystems->{$_}{uuid};
 378         print "      type: $filesystems->{$_}{fstype}\n"
 379             if exists $filesystems->{$_}{fstype};
 380         print "      content: $filesystems->{$_}{content}\n"
 381             if exists $filesystems->{$_}{content};
 382     }
 383
 384     if (exists $os->{modprobe_aliases}) {
 385         my %aliases = %{$os->{modprobe_aliases}};
 386         my @keys = sort keys %aliases;
 387         if (@keys) {
 388             print __"  Modprobe aliases:\n";
 389             foreach (@keys) {
 390                 printf "    %-30s %s\n", $_, $aliases{$_}->{modulename}
 391             }
 392         }
 393     }
 394
 395     if (exists $os->{initrd_modules}) {
 396         my %modvers = %{$os->{initrd_modules}};
 397         my @keys = sort keys %modvers;
 398         if (@keys) {
 399             print __"  Initrd modules:\n";
 400             foreach (@keys) {
 401                 my @modules = @{$modvers{$_}};
 402                 print "    $_:\n";
 403                 print "      $_\n" foreach @modules;
 404             }
 405         }
 406     }
 407
 408     print __"  Applications:\n";
 409     my @apps =  @{$os->{apps}};
 410     foreach (@apps) {
 411         print "    $_->{name} $_->{version}\n"
 412     }
 413
 414     print __"  Kernels:\n";
 415     my @kernels = @{$os->{kernels}};
 416     foreach (@kernels) {
 417         print "    $_->{version} ($_->{arch})\n";
 418         my @modules = @{$_->{modules}};
 419         foreach (@modules) {
 420             print "      $_\n";
 421         }
 422     }
 423
 424     if (exists $os->{root}->{registry}) {
 425         print __"  Windows Registry entries:\n";
 426         # These are just lumps of text - dump them out.
 427         foreach (@{$os->{root}->{registry}}) {
 428             print "$_\n";
 429         }
 430     }
 431 }
 432
 433 sub output_xml
 434 {
 435     my $xml = new XML::Writer(DATA_MODE => 1, DATA_INDENT => 2);
 436
 437     $xml->startTag("operatingsystems");
 438     output_xml_os ($oses->{$_}, $xml) foreach sort keys %$oses;
 439     $xml->endTag("operatingsystems");
 440
 441     $xml->end();
 442 }
 443
 444 sub output_xml_os
 445 {
 446     my ($os, $xml) = @_;
 447
 448     $xml->startTag("operatingsystem");
 449
 450     foreach ( [ "name" => "os" ],
 451               [ "distro" => "distro" ],
 452               [ "arch" => "arch" ],
 453               [ "major_version" => "major_version" ],
 454               [ "minor_version" => "minor_version" ],
 455               [ "package_format" => "package_format" ],
 456               [ "package_management" => "package_management" ],
 457               [ "root" => "root_device" ] ) {
 458         $xml->dataElement($_->[0], $os->{$_->[1]}) if exists $os->{$_->[1]};
 459     }
 460
 461     $xml->startTag("mountpoints");
 462     my $mounts = $os->{mounts};
 463     foreach (sort keys %$mounts) {
 464         $xml->dataElement("mountpoint", $_, "dev" => $mounts->{$_});
 465     }
 466     $xml->endTag("mountpoints");
 467
 468     $xml->startTag("filesystems");
 469     my $filesystems = $os->{filesystems};
 470     foreach (sort keys %$filesystems) {
 471         $xml->startTag("filesystem", "dev" => $_);
 472
 473         foreach my $field ( [ "label" => "label" ],
 474                             [ "uuid" => "uuid" ],
 475                             [ "type" => "fstype" ],
 476                             [ "content" => "content" ],
 477                             [ "spec" => "spec" ] ) {
 478             $xml->dataElement($field->[0], $filesystems->{$_}{$field->[1]})
 479                 if exists $filesystems->{$_}{$field->[1]};
 480         }
 481
 482         $xml->endTag("filesystem");
 483     }
 484     $xml->endTag("filesystems");
 485
 486     if (exists $os->{modprobe_aliases}) {
 487         my %aliases = %{$os->{modprobe_aliases}};
 488         my @keys = sort keys %aliases;
 489         if (@keys) {
 490             $xml->startTag("modprobealiases");
 491             foreach (@keys) {
 492                 $xml->startTag("alias", "device" => $_);
 493
 494                 foreach my $field ( [ "modulename" => "modulename" ],
 495                                     [ "augeas" => "augeas" ],
 496                                     [ "file" => "file" ] ) {
 497                     $xml->dataElement($field->[0], $aliases{$_}->{$field->[1]});
 498                 }
 499
 500                 $xml->endTag("alias");
 501             }
 502             $xml->endTag("modprobealiases");
 503         }
 504     }
 505
 506     if (exists $os->{initrd_modules}) {
 507         my %modvers = %{$os->{initrd_modules}};
 508         my @keys = sort keys %modvers;
 509         if (@keys) {
 510             $xml->startTag("initrds");
 511             foreach (@keys) {
 512                 my @modules = @{$modvers{$_}};
 513                 $xml->startTag("initrd", "version" => $_);
 514                 $xml->dataElement("module", $_) foreach @modules;
 515                 $xml->endTag("initrd");
 516             }
 517             $xml->endTag("initrds");
 518         }
 519     }
 520
 521     $xml->startTag("applications");
 522     my @apps =  @{$os->{apps}};
 523     foreach (@apps) {
 524         $xml->startTag("application");
 525         $xml->dataElement("name", $_->{name});
 526         $xml->dataElement("version", $_->{version});
 527         $xml->endTag("application");
 528     }
 529     $xml->endTag("applications");
 530
 531     if(defined($os->{boot}) && defined($os->{boot}->{configs})) {
 532         my $default = $os->{boot}->{default};
 533         my $configs = $os->{boot}->{configs};
 534
 535         $xml->startTag("boot");
 536         for(my $i = 0; $i < scalar(@$configs); $i++) {
 537             my $config = $configs->[$i];
 538
 539             my @attrs = ();
 540             push(@attrs, ("default" => 1)) if($default == $i);
 541             $xml->startTag("config", @attrs);
 542             $xml->dataElement("title", $config->{title});
 543             $xml->dataElement("kernel", $config->{kernel}->{version})
 544                 if(defined($config->{kernel}));
 545             $xml->dataElement("cmdline", $config->{cmdline})
 546                 if(defined($config->{cmdline}));
 547             $xml->endTag("config");
 548         }
 549         $xml->endTag("boot");
 550     }
 551
 552     if ($os->{kernels}) {
 553         $xml->startTag("kernels");
 554         my @kernels = @{$os->{kernels}};
 555         foreach (@kernels) {
 556             $xml->startTag("kernel",
 557                            "version" => $_->{version},
 558                            "arch" => $_->{arch});
 559             $xml->startTag("modules");
 560             my @modules = @{$_->{modules}};
 561             foreach (@modules) {
 562                 $xml->dataElement("module", $_);
 563             }
 564             $xml->endTag("modules");
 565             $xml->dataElement("path", $_->{path}) if(defined($_->{path}));
 566             $xml->dataElement("package", $_->{package}) if(defined($_->{package}));
 567             $xml->endTag("kernel");
 568         }
 569         $xml->endTag("kernels");
 570     }
 571
 572     if (exists $os->{root}->{registry}) {
 573         $xml->startTag("windowsregistryentries");
 574         # These are just lumps of text - dump them out.
 575         foreach (@{$os->{root}->{registry}}) {
 576             $xml->dataElement("windowsregistryentry", $_);
 577         }
 578         $xml->endTag("windowsregistryentries");
 579     }
 580
 581     $xml->endTag("operatingsystem");
 582 }
 583
 584 =head1 QUERY MODE
 585
 586 When you use C<virt-inspector --query>, the output is a series of
 587 lines of the form:
 588
 589  windows=no
 590  linux=yes
 591  fullvirt=yes
 592  xen_pv_drivers=no
 593
 594 (each answer is usually C<yes> or C<no>, or the line is completely
 595 missing if we could not determine the answer at all).
 596
 597 If the guest is multiboot, you can get apparently conflicting answers
 598 (eg. C<windows=yes> and C<linux=yes>, or a guest which is both
 599 fullvirt and has a Xen PV kernel).  This is normal, and just means
 600 that the guest can do both things, although it might require operator
 601 intervention such as selecting a boot option when the guest is
 602 booting.
 603
 604 This section describes the full range of answers possible.
 605
 606 =over 4
 607
 608 =cut
 609
 610 sub output_query
 611 {
 612     output_query_windows ();
 613     output_query_linux ();
 614     output_query_rhel ();
 615     output_query_fedora ();
 616     output_query_debian ();
 617     output_query_fullvirt ();
 618     output_query_xen_domU_kernel ();
 619     output_query_xen_pv_drivers ();
 620     output_query_virtio_drivers ();
 621     output_query_kernel_arch ();
 622     output_query_userspace_arch ();
 623 }
 624
 625 =item windows=(yes|no)
 626
 627 Answer C<yes> if Microsoft Windows is installed in the guest.
 628
 629 =cut
 630
 631 sub output_query_windows
 632 {
 633     my $windows = "no";
 634     foreach my $os (keys %$oses) {
 635         $windows="yes" if $oses->{$os}->{os} eq "windows";
 636     }
 637     print "windows=$windows\n";
 638 }
 639
 640 =item linux=(yes|no)
 641
 642 Answer C<yes> if a Linux kernel is installed in the guest.
 643
 644 =cut
 645
 646 sub output_query_linux
 647 {
 648     my $linux = "no";
 649     foreach my $os (keys %$oses) {
 650         $linux="yes" if $oses->{$os}->{os} eq "linux";
 651     }
 652     print "linux=$linux\n";
 653 }
 654
 655 =item rhel=(yes|no)
 656
 657 Answer C<yes> if the guest contains Red Hat Enterprise Linux.
 658
 659 =cut
 660
 661 sub output_query_rhel
 662 {
 663     my $rhel = "no";
 664     foreach my $os (keys %$oses) {
 665         $rhel="yes" if ($oses->{$os}->{os} eq "linux" &&
 666                         $oses->{$os}->{distro} eq "rhel");
 667     }
 668     print "rhel=$rhel\n";
 669 }
 670
 671 =item fedora=(yes|no)
 672
 673 Answer C<yes> if the guest contains the Fedora Linux distribution.
 674
 675 =cut
 676
 677 sub output_query_fedora
 678 {
 679     my $fedora = "no";
 680     foreach my $os (keys %$oses) {
 681         $fedora="yes" if $oses->{$os}->{os} eq "linux" && $oses->{$os}->{distro} eq "fedora";
 682     }
 683     print "fedora=$fedora\n";
 684 }
 685
 686 =item debian=(yes|no)
 687
 688 Answer C<yes> if the guest contains the Debian Linux distribution.
 689
 690 =cut
 691
 692 sub output_query_debian
 693 {
 694     my $debian = "no";
 695     foreach my $os (keys %$oses) {
 696         $debian="yes" if $oses->{$os}->{os} eq "linux" && $oses->{$os}->{distro} eq "debian";
 697     }
 698     print "debian=$debian\n";
 699 }
 700
 701 =item fullvirt=(yes|no)
 702
 703 Answer C<yes> if there is at least one operating system kernel
 704 installed in the guest which runs fully virtualized.  Such a guest
 705 would require a hypervisor which supports full system virtualization.
 706
 707 =cut
 708
 709 sub output_query_fullvirt
 710 {
 711     # The assumption is full-virt, unless all installed kernels
 712     # are identified as paravirt.
 713     # XXX Fails on Windows guests.
 714     foreach my $os (keys %$oses) {
 715         foreach my $kernel (@{$oses->{$os}->{kernels}}) {
 716             my $is_pv = $kernel->{version} =~ m/xen/;
 717             unless ($is_pv) {
 718                 print "fullvirt=yes\n";
 719                 return;
 720             }
 721         }
 722     }
 723     print "fullvirt=no\n";
 724 }
 725
 726 =item xen_domU_kernel=(yes|no)
 727
 728 Answer C<yes> if there is at least one Linux kernel installed in
 729 the guest which is compiled as a Xen DomU (a Xen paravirtualized
 730 guest).
 731
 732 =cut
 733
 734 sub output_query_xen_domU_kernel
 735 {
 736     foreach my $os (keys %$oses) {
 737         foreach my $kernel (@{$oses->{$os}->{kernels}}) {
 738             my $is_xen = $kernel->{version} =~ m/xen/;
 739             if ($is_xen) {
 740                 print "xen_domU_kernel=yes\n";
 741                 return;
 742             }
 743         }
 744     }
 745     print "xen_domU_kernel=no\n";
 746 }
 747
 748 =item xen_pv_drivers=(yes|no)
 749
 750 Answer C<yes> if the guest has Xen paravirtualized drivers installed
 751 (usually the kernel itself will be fully virtualized, but the PV
 752 drivers have been installed by the administrator for performance
 753 reasons).
 754
 755 =cut
 756
 757 sub output_query_xen_pv_drivers
 758 {
 759     foreach my $os (keys %$oses) {
 760         foreach my $kernel (@{$oses->{$os}->{kernels}}) {
 761             foreach my $module (@{$kernel->{modules}}) {
 762                 if ($module =~ m/xen-/) {
 763                     print "xen_pv_drivers=yes\n";
 764                     return;
 765                 }
 766             }
 767         }
 768     }
 769     print "xen_pv_drivers=no\n";
 770 }
 771
 772 =item virtio_drivers=(yes|no)
 773
 774 Answer C<yes> if the guest has virtio paravirtualized drivers
 775 installed.  Virtio drivers are commonly used to improve the
 776 performance of KVM.
 777
 778 =cut
 779
 780 sub output_query_virtio_drivers
 781 {
 782     foreach my $os (keys %$oses) {
 783         foreach my $kernel (@{$oses->{$os}->{kernels}}) {
 784             foreach my $module (@{$kernel->{modules}}) {
 785                 if ($module =~ m/virtio_/) {
 786                     print "virtio_drivers=yes\n";
 787                     return;
 788                 }
 789             }
 790         }
 791     }
 792     print "virtio_drivers=no\n";
 793 }
 794
 795 =item userspace_arch=(x86_64|...)
 796
 797 Print the architecture of userspace.
 798
 799 NB. For multi-boot VMs this can print several lines.
 800
 801 =cut
 802
 803 sub output_query_userspace_arch
 804 {
 805     my %arches;
 806
 807     foreach my $os (keys %$oses) {
 808         $arches{$oses->{$os}->{arch}} = 1 if exists $oses->{$os}->{arch};
 809     }
 810
 811     foreach (sort keys %arches) {
 812         print "userspace_arch=$_\n";
 813     }
 814 }
 815
 816 =item kernel_arch=(x86_64|...)
 817
 818 Print the architecture of the kernel.
 819
 820 NB. For multi-boot VMs this can print several lines.
 821
 822 =cut
 823
 824 sub output_query_kernel_arch
 825 {
 826     my %arches;
 827
 828     foreach my $os (keys %$oses) {
 829         foreach my $kernel (@{$oses->{$os}->{kernels}}) {
 830             $arches{$kernel->{arch}} = 1 if exists $kernel->{arch};
 831         }
 832     }
 833
 834     foreach (sort keys %arches) {
 835         print "kernel_arch=$_\n";
 836     }
 837 }
 838
 839 =back
 840
 841 =head1 SEE ALSO
 842
 843 L<guestfs(3)>,
 844 L<guestfish(1)>,
 845 L<Sys::Guestfs(3)>,
 846 L<Sys::Guestfs::Lib(3)>,
 847 L<Sys::Virt(3)>,
 848 L<http://libguestfs.org/>.
 849
 850 For Windows registry parsing we require the C<reged> program
 851 from L<http://home.eunet.no/~pnordahl/ntpasswd/>.
 852
 853 =head1 AUTHOR
 854
 855 Richard W.M. Jones L<http://et.redhat.com/~rjones/>
 856
 857 Matthew Booth L<mbooth@redhat.com>
 858
 859 =head1 COPYRIGHT
 860
 861 Copyright (C) 2009 Red Hat Inc.
 862
 863 This program is free software; you can redistribute it and/or modify
 864 it under the terms of the GNU General Public License as published by
 865 the Free Software Foundation; either version 2 of the License, or
 866 (at your option) any later version.
 867
 868 This program is distributed in the hope that it will be useful,
 869 but WITHOUT ANY WARRANTY; without even the implied warranty of
 870 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 871 GNU General Public License for more details.
 872
 873 You should have received a copy of the GNU General Public License
 874 along with this program; if not, write to the Free Software
 875 Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.