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 Unfortunately there is no clear schema for this document
 251 (contributions welcome) but you can get an idea of the format by
 252 looking at other documents and as a last resort the source for this
 253 program.
 254
 255 With the I<--fish> or I<--ro-fish> option the mount points are mapped to
 256 L<guestfish(1)> command line parameters, so that you can go in
 257 afterwards and inspect the guest with everything mounted in the
 258 right place.  For example:
 259
 260  guestfish $(virt-inspector --ro-fish guest.img)
 261  ==> guestfish --ro -a guest.img -m /dev/VG/LV:/ -m /dev/sda1:/boot
 262
 263 =cut
 264
 265 # List of possible filesystems.
 266 my @partitions = get_partitions ($g);
 267
 268 # Now query each one to build up a picture of what's in it.
 269 my %fses =
 270     inspect_all_partitions ($g, \@partitions,
 271       use_windows_registry => $windows_registry);
 272
 273 #print "fses -----------\n";
 274 #print Dumper(\%fses);
 275
 276 my $oses = inspect_operating_systems ($g, \%fses);
 277
 278 #print "oses -----------\n";
 279 #print Dumper($oses);
 280
 281 # Mount up the disks so we can check for applications
 282 # and kernels.  Skip this if the output is "*fish" because
 283 # we don't need to know.
 284
 285 if ($output !~ /.*fish$/) {
 286     my $root_dev;
 287     foreach $root_dev (sort keys %$oses) {
 288         my $os = $oses->{$root_dev};
 289         mount_operating_system ($g, $os);
 290         inspect_in_detail ($g, $os);
 291         $g->umount_all ();
 292     }
 293 }
 294
 295 #----------------------------------------------------------------------
 296 # Output.
 297
 298 if ($output eq "fish" || $output eq "ro-fish") {
 299     my @osdevs = keys %$oses;
 300     # This only works if there is a single OS.
 301     die __"--fish output is only possible with a single OS\n" if @osdevs != 1;
 302
 303     my $root_dev = $osdevs[0];
 304
 305     if ($output eq "ro-fish") {
 306         print "--ro ";
 307     }
 308
 309     print "-a $_ " foreach @images;
 310
 311     my $mounts = $oses->{$root_dev}->{mounts};
 312     # Have to mount / first.  Luckily '/' is early in the ASCII
 313     # character set, so this should be OK.
 314     foreach (sort keys %$mounts) {
 315         print "-m $mounts->{$_}:$_ " if $_ ne "swap" && $_ ne "none";
 316     }
 317     print "\n"
 318 }
 319
 320 # Perl output.
 321 elsif ($output eq "perl") {
 322     print Dumper(%$oses);
 323 }
 324
 325 # YAML output
 326 elsif ($output eq "yaml") {
 327     die __"virt-inspector: no YAML support\n"
 328         unless exists $INC{"YAML/Any.pm"};
 329
 330     print Dump(%$oses);
 331 }
 332
 333 # Plain text output (the default).
 334 elsif ($output eq "text") {
 335     output_text ();
 336 }
 337
 338 # XML output.
 339 elsif ($output eq "xml") {
 340     output_xml ();
 341 }
 342
 343 # Query mode.
 344 elsif ($output eq "query") {
 345     output_query ();
 346 }
 347
 348 sub output_text
 349 {
 350     output_text_os ($oses->{$_}) foreach sort keys %$oses;
 351 }
 352
 353 sub output_text_os
 354 {
 355     my $os = shift;
 356
 357     print $os->{os}, " " if exists $os->{os};
 358     print $os->{distro}, " " if exists $os->{distro};
 359     print $os->{arch}, " " if exists $os->{arch};
 360     print $os->{major_version} if exists $os->{major_version};
 361     print ".", $os->{minor_version} if exists $os->{minor_version};
 362     print " ";
 363     print "on ", $os->{root_device}, ":\n";
 364
 365     print __"  Mountpoints:\n";
 366     my $mounts = $os->{mounts};
 367     foreach (sort keys %$mounts) {
 368         printf "    %-30s %s\n", $mounts->{$_}, $_
 369     }
 370
 371     print __"  Filesystems:\n";
 372     my $filesystems = $os->{filesystems};
 373     foreach (sort keys %$filesystems) {
 374         print "    $_:\n";
 375         print "      label: $filesystems->{$_}{label}\n"
 376             if exists $filesystems->{$_}{label};
 377         print "      UUID: $filesystems->{$_}{uuid}\n"
 378             if exists $filesystems->{$_}{uuid};
 379         print "      type: $filesystems->{$_}{fstype}\n"
 380             if exists $filesystems->{$_}{fstype};
 381         print "      content: $filesystems->{$_}{content}\n"
 382             if exists $filesystems->{$_}{content};
 383     }
 384
 385     if (exists $os->{modprobe_aliases}) {
 386         my %aliases = %{$os->{modprobe_aliases}};
 387         my @keys = sort keys %aliases;
 388         if (@keys) {
 389             print __"  Modprobe aliases:\n";
 390             foreach (@keys) {
 391                 printf "    %-30s %s\n", $_, $aliases{$_}->{modulename}
 392             }
 393         }
 394     }
 395
 396     if (exists $os->{initrd_modules}) {
 397         my %modvers = %{$os->{initrd_modules}};
 398         my @keys = sort keys %modvers;
 399         if (@keys) {
 400             print __"  Initrd modules:\n";
 401             foreach (@keys) {
 402                 my @modules = @{$modvers{$_}};
 403                 print "    $_:\n";
 404                 print "      $_\n" foreach @modules;
 405             }
 406         }
 407     }
 408
 409     print __"  Applications:\n";
 410     my @apps =  @{$os->{apps}};
 411     foreach (@apps) {
 412         print "    $_->{name} $_->{version}\n"
 413     }
 414
 415     print __"  Kernels:\n";
 416     my @kernels = @{$os->{kernels}};
 417     foreach (@kernels) {
 418         print "    $_->{version} ($_->{arch})\n";
 419         my @modules = @{$_->{modules}};
 420         foreach (@modules) {
 421             print "      $_\n";
 422         }
 423     }
 424
 425     if (exists $os->{root}->{registry}) {
 426         print __"  Windows Registry entries:\n";
 427         # These are just lumps of text - dump them out.
 428         foreach (@{$os->{root}->{registry}}) {
 429             print "$_\n";
 430         }
 431     }
 432 }
 433
 434 sub output_xml
 435 {
 436     my $xml = new XML::Writer(DATA_MODE => 1, DATA_INDENT => 2);
 437
 438     $xml->startTag("operatingsystems");
 439     output_xml_os ($oses->{$_}, $xml) foreach sort keys %$oses;
 440     $xml->endTag("operatingsystems");
 441
 442     $xml->end();
 443 }
 444
 445 sub output_xml_os
 446 {
 447     my ($os, $xml) = @_;
 448
 449     $xml->startTag("operatingsystem");
 450
 451     foreach ( [ "name" => "os" ],
 452               [ "distro" => "distro" ],
 453               [ "arch" => "arch" ],
 454               [ "major_version" => "major_version" ],
 455               [ "minor_version" => "minor_version" ],
 456               [ "package_format" => "package_format" ],
 457               [ "package_management" => "package_management" ],
 458               [ "root" => "root_device" ] ) {
 459         $xml->dataElement($_->[0], $os->{$_->[1]}) if exists $os->{$_->[1]};
 460     }
 461
 462     $xml->startTag("mountpoints");
 463     my $mounts = $os->{mounts};
 464     foreach (sort keys %$mounts) {
 465         $xml->dataElement("mountpoint", $_, "dev" => $mounts->{$_});
 466     }
 467     $xml->endTag("mountpoints");
 468
 469     $xml->startTag("filesystems");
 470     my $filesystems = $os->{filesystems};
 471     foreach (sort keys %$filesystems) {
 472         $xml->startTag("filesystem", "dev" => $_);
 473
 474         foreach my $field ( [ "label" => "label" ],
 475                             [ "uuid" => "uuid" ],
 476                             [ "type" => "fstype" ],
 477                             [ "content" => "content" ],
 478                             [ "spec" => "spec" ] ) {
 479             $xml->dataElement($field->[0], $filesystems->{$_}{$field->[1]})
 480                 if exists $filesystems->{$_}{$field->[1]};
 481         }
 482
 483         $xml->endTag("filesystem");
 484     }
 485     $xml->endTag("filesystems");
 486
 487     if (exists $os->{modprobe_aliases}) {
 488         my %aliases = %{$os->{modprobe_aliases}};
 489         my @keys = sort keys %aliases;
 490         if (@keys) {
 491             $xml->startTag("modprobealiases");
 492             foreach (@keys) {
 493                 $xml->startTag("alias", "device" => $_);
 494
 495                 foreach my $field ( [ "modulename" => "modulename" ],
 496                                     [ "augeas" => "augeas" ],
 497                                     [ "file" => "file" ] ) {
 498                     $xml->dataElement($field->[0], $aliases{$_}->{$field->[1]});
 499                 }
 500
 501                 $xml->endTag("alias");
 502             }
 503             $xml->endTag("modprobealiases");
 504         }
 505     }
 506
 507     if (exists $os->{initrd_modules}) {
 508         my %modvers = %{$os->{initrd_modules}};
 509         my @keys = sort keys %modvers;
 510         if (@keys) {
 511             $xml->startTag("initrds");
 512             foreach (@keys) {
 513                 my @modules = @{$modvers{$_}};
 514                 $xml->startTag("initrd", "version" => $_);
 515                 $xml->dataElement("module", $_) foreach @modules;
 516                 $xml->endTag("initrd");
 517             }
 518             $xml->endTag("initrds");
 519         }
 520     }
 521
 522     $xml->startTag("applications");
 523     my @apps =  @{$os->{apps}};
 524     foreach (@apps) {
 525         $xml->startTag("application");
 526         $xml->dataElement("name", $_->{name});
 527         $xml->dataElement("version", $_->{version});
 528         $xml->endTag("application");
 529     }
 530     $xml->endTag("applications");
 531
 532     if(defined($os->{boot}) && defined($os->{boot}->{configs})) {
 533         my $default = $os->{boot}->{default};
 534         my $configs = $os->{boot}->{configs};
 535
 536         $xml->startTag("boot");
 537         for(my $i = 0; $i < scalar(@$configs); $i++) {
 538             my $config = $configs->[$i];
 539
 540             my @attrs = ();
 541             push(@attrs, ("default" => 1)) if($default == $i);
 542             $xml->startTag("config", @attrs);
 543             $xml->dataElement("title", $config->{title});
 544             $xml->dataElement("kernel", $config->{kernel}->{version})
 545                 if(defined($config->{kernel}));
 546             $xml->dataElement("cmdline", $config->{cmdline})
 547                 if(defined($config->{cmdline}));
 548             $xml->endTag("config");
 549         }
 550         $xml->endTag("boot");
 551     }
 552
 553     if ($os->{kernels}) {
 554         $xml->startTag("kernels");
 555         my @kernels = @{$os->{kernels}};
 556         foreach (@kernels) {
 557             $xml->startTag("kernel",
 558                            "version" => $_->{version},
 559                            "arch" => $_->{arch});
 560             $xml->startTag("modules");
 561             my @modules = @{$_->{modules}};
 562             foreach (@modules) {
 563                 $xml->dataElement("module", $_);
 564             }
 565             $xml->endTag("modules");
 566             $xml->dataElement("path", $_->{path}) if(defined($_->{path}));
 567             $xml->dataElement("package", $_->{package}) if(defined($_->{package}));
 568             $xml->endTag("kernel");
 569         }
 570         $xml->endTag("kernels");
 571     }
 572
 573     if (exists $os->{root}->{registry}) {
 574         $xml->startTag("windowsregistryentries");
 575         # These are just lumps of text - dump them out.
 576         foreach (@{$os->{root}->{registry}}) {
 577             $xml->dataElement("windowsregistryentry", $_);
 578         }
 579         $xml->endTag("windowsregistryentries");
 580     }
 581
 582     $xml->endTag("operatingsystem");
 583 }
 584
 585 =head1 QUERY MODE
 586
 587 When you use C<virt-inspector --query>, the output is a series of
 588 lines of the form:
 589
 590  windows=no
 591  linux=yes
 592  fullvirt=yes
 593  xen_pv_drivers=no
 594
 595 (each answer is usually C<yes> or C<no>, or the line is completely
 596 missing if we could not determine the answer at all).
 597
 598 If the guest is multiboot, you can get apparently conflicting answers
 599 (eg. C<windows=yes> and C<linux=yes>, or a guest which is both
 600 fullvirt and has a Xen PV kernel).  This is normal, and just means
 601 that the guest can do both things, although it might require operator
 602 intervention such as selecting a boot option when the guest is
 603 booting.
 604
 605 This section describes the full range of answers possible.
 606
 607 =over 4
 608
 609 =cut
 610
 611 sub output_query
 612 {
 613     output_query_windows ();
 614     output_query_linux ();
 615     output_query_rhel ();
 616     output_query_fedora ();
 617     output_query_debian ();
 618     output_query_fullvirt ();
 619     output_query_xen_domU_kernel ();
 620     output_query_xen_pv_drivers ();
 621     output_query_virtio_drivers ();
 622     output_query_kernel_arch ();
 623     output_query_userspace_arch ();
 624 }
 625
 626 =item windows=(yes|no)
 627
 628 Answer C<yes> if Microsoft Windows is installed in the guest.
 629
 630 =cut
 631
 632 sub output_query_windows
 633 {
 634     my $windows = "no";
 635     foreach my $os (keys %$oses) {
 636         $windows="yes" if $oses->{$os}->{os} eq "windows";
 637     }
 638     print "windows=$windows\n";
 639 }
 640
 641 =item linux=(yes|no)
 642
 643 Answer C<yes> if a Linux kernel is installed in the guest.
 644
 645 =cut
 646
 647 sub output_query_linux
 648 {
 649     my $linux = "no";
 650     foreach my $os (keys %$oses) {
 651         $linux="yes" if $oses->{$os}->{os} eq "linux";
 652     }
 653     print "linux=$linux\n";
 654 }
 655
 656 =item rhel=(yes|no)
 657
 658 Answer C<yes> if the guest contains Red Hat Enterprise Linux.
 659
 660 =cut
 661
 662 sub output_query_rhel
 663 {
 664     my $rhel = "no";
 665     foreach my $os (keys %$oses) {
 666         $rhel="yes" if ($oses->{$os}->{os} eq "linux" &&
 667                         $oses->{$os}->{distro} eq "rhel");
 668     }
 669     print "rhel=$rhel\n";
 670 }
 671
 672 =item fedora=(yes|no)
 673
 674 Answer C<yes> if the guest contains the Fedora Linux distribution.
 675
 676 =cut
 677
 678 sub output_query_fedora
 679 {
 680     my $fedora = "no";
 681     foreach my $os (keys %$oses) {
 682         $fedora="yes" if $oses->{$os}->{os} eq "linux" && $oses->{$os}->{distro} eq "fedora";
 683     }
 684     print "fedora=$fedora\n";
 685 }
 686
 687 =item debian=(yes|no)
 688
 689 Answer C<yes> if the guest contains the Debian Linux distribution.
 690
 691 =cut
 692
 693 sub output_query_debian
 694 {
 695     my $debian = "no";
 696     foreach my $os (keys %$oses) {
 697         $debian="yes" if $oses->{$os}->{os} eq "linux" && $oses->{$os}->{distro} eq "debian";
 698     }
 699     print "debian=$debian\n";
 700 }
 701
 702 =item fullvirt=(yes|no)
 703
 704 Answer C<yes> if there is at least one operating system kernel
 705 installed in the guest which runs fully virtualized.  Such a guest
 706 would require a hypervisor which supports full system virtualization.
 707
 708 =cut
 709
 710 sub output_query_fullvirt
 711 {
 712     # The assumption is full-virt, unless all installed kernels
 713     # are identified as paravirt.
 714     # XXX Fails on Windows guests.
 715     foreach my $os (keys %$oses) {
 716         foreach my $kernel (@{$oses->{$os}->{kernels}}) {
 717             my $is_pv = $kernel->{version} =~ m/xen/;
 718             unless ($is_pv) {
 719                 print "fullvirt=yes\n";
 720                 return;
 721             }
 722         }
 723     }
 724     print "fullvirt=no\n";
 725 }
 726
 727 =item xen_domU_kernel=(yes|no)
 728
 729 Answer C<yes> if there is at least one Linux kernel installed in
 730 the guest which is compiled as a Xen DomU (a Xen paravirtualized
 731 guest).
 732
 733 =cut
 734
 735 sub output_query_xen_domU_kernel
 736 {
 737     foreach my $os (keys %$oses) {
 738         foreach my $kernel (@{$oses->{$os}->{kernels}}) {
 739             my $is_xen = $kernel->{version} =~ m/xen/;
 740             if ($is_xen) {
 741                 print "xen_domU_kernel=yes\n";
 742                 return;
 743             }
 744         }
 745     }
 746     print "xen_domU_kernel=no\n";
 747 }
 748
 749 =item xen_pv_drivers=(yes|no)
 750
 751 Answer C<yes> if the guest has Xen paravirtualized drivers installed
 752 (usually the kernel itself will be fully virtualized, but the PV
 753 drivers have been installed by the administrator for performance
 754 reasons).
 755
 756 =cut
 757
 758 sub output_query_xen_pv_drivers
 759 {
 760     foreach my $os (keys %$oses) {
 761         foreach my $kernel (@{$oses->{$os}->{kernels}}) {
 762             foreach my $module (@{$kernel->{modules}}) {
 763                 if ($module =~ m/xen-/) {
 764                     print "xen_pv_drivers=yes\n";
 765                     return;
 766                 }
 767             }
 768         }
 769     }
 770     print "xen_pv_drivers=no\n";
 771 }
 772
 773 =item virtio_drivers=(yes|no)
 774
 775 Answer C<yes> if the guest has virtio paravirtualized drivers
 776 installed.  Virtio drivers are commonly used to improve the
 777 performance of KVM.
 778
 779 =cut
 780
 781 sub output_query_virtio_drivers
 782 {
 783     foreach my $os (keys %$oses) {
 784         foreach my $kernel (@{$oses->{$os}->{kernels}}) {
 785             foreach my $module (@{$kernel->{modules}}) {
 786                 if ($module =~ m/virtio_/) {
 787                     print "virtio_drivers=yes\n";
 788                     return;
 789                 }
 790             }
 791         }
 792     }
 793     print "virtio_drivers=no\n";
 794 }
 795
 796 =item userspace_arch=(x86_64|...)
 797
 798 Print the architecture of userspace.
 799
 800 NB. For multi-boot VMs this can print several lines.
 801
 802 =cut
 803
 804 sub output_query_userspace_arch
 805 {
 806     my %arches;
 807
 808     foreach my $os (keys %$oses) {
 809         $arches{$oses->{$os}->{arch}} = 1 if exists $oses->{$os}->{arch};
 810     }
 811
 812     foreach (sort keys %arches) {
 813         print "userspace_arch=$_\n";
 814     }
 815 }
 816
 817 =item kernel_arch=(x86_64|...)
 818
 819 Print the architecture of the kernel.
 820
 821 NB. For multi-boot VMs this can print several lines.
 822
 823 =cut
 824
 825 sub output_query_kernel_arch
 826 {
 827     my %arches;
 828
 829     foreach my $os (keys %$oses) {
 830         foreach my $kernel (@{$oses->{$os}->{kernels}}) {
 831             $arches{$kernel->{arch}} = 1 if exists $kernel->{arch};
 832         }
 833     }
 834
 835     foreach (sort keys %arches) {
 836         print "kernel_arch=$_\n";
 837     }
 838 }
 839
 840 =back
 841
 842 =head1 SEE ALSO
 843
 844 L<guestfs(3)>,
 845 L<guestfish(1)>,
 846 L<Sys::Guestfs(3)>,
 847 L<Sys::Guestfs::Lib(3)>,
 848 L<Sys::Virt(3)>,
 849 L<http://libguestfs.org/>.
 850
 851 For Windows registry parsing we require the C<reged> program
 852 from L<http://home.eunet.no/~pnordahl/ntpasswd/>.
 853
 854 =head1 AUTHOR
 855
 856 Richard W.M. Jones L<http://et.redhat.com/~rjones/>
 857
 858 Matthew Booth L<mbooth@redhat.com>
 859
 860 =head1 COPYRIGHT
 861
 862 Copyright (C) 2009 Red Hat Inc.
 863
 864 This program is free software; you can redistribute it and/or modify
 865 it under the terms of the GNU General Public License as published by
 866 the Free Software Foundation; either version 2 of the License, or
 867 (at your option) any later version.
 868
 869 This program is distributed in the hope that it will be useful,
 870 but WITHOUT ANY WARRANTY; without even the implied warranty of
 871 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 872 GNU General Public License for more details.
 873
 874 You should have received a copy of the GNU General Public License
 875 along with this program; if not, write to the Free Software
 876 Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.