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