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 This flag is ignored for compatibility with earlier releases of the
 168 software.
 169
 170 In this version, if L<Win::Hivex(3)> is available, then we attempt to
 171 parse information out of the Registry for any Windows guest.
 172
 173 =back
 174
 175 =cut
 176
 177 GetOptions ("help|?" => \$help,
 178             "version" => \$version,
 179             "connect|c=s" => \$uri,
 180             "text" => sub { $output = "text" },
 181             "none" => sub { $output = "none" },
 182             "xml" => sub { $output = "xml" },
 183             "yaml" => sub { $output = "yaml" },
 184             "perl" => sub { $output = "perl" },
 185             "fish" => sub { $output = "fish" },
 186             "guestfish" => sub { $output = "fish" },
 187             "ro-fish" => sub { $output = "ro-fish" },
 188             "ro-guestfish" => sub { $output = "ro-fish" },
 189             "query" => sub { $output = "query" },
 190             "windows-registry" => \$windows_registry,
 191     ) or pod2usage (2);
 192 pod2usage (1) if $help;
 193 if ($version) {
 194     my $g = Sys::Guestfs->new ();
 195     my %h = $g->version ();
 196     print "$h{major}.$h{minor}.$h{release}$h{extra}\n";
 197     exit
 198 }
 199 pod2usage (__"virt-inspector: no image or VM names given") if @ARGV == 0;
 200
 201 my $rw = 0;
 202
 203 # XXX This is a bug: Originally we intended to open the guest with
 204 # rw=>1 in order to tell Sys::Guestfs::Lib that we should disallow
 205 # active domains.  However this also has the effect of opening the
 206 # disk image in write mode, and in any case we don't use this option
 207 # in guestfish any more since we moved all the inspection code into
 208 # the core library.  We should drop the fish output modes completely.
 209 $rw = 1 if $output eq "fish";
 210
 211 my $g;
 212 my @images;
 213 if ($uri) {
 214     my ($conn, $dom);
 215     ($g, $conn, $dom, @images) =
 216         open_guest (\@ARGV, rw => $rw, address => $uri);
 217 } else {
 218     my ($conn, $dom);
 219     ($g, $conn, $dom, @images) =
 220         open_guest (\@ARGV, rw => $rw);
 221 }
 222
 223 $g->launch ();
 224
 225 =head1 OUTPUT FORMAT
 226
 227  Operating system(s)
 228  -------------------
 229  Linux (distro + version)
 230  Windows (version)
 231     |
 232     |
 233     +--- Filesystems ---------- Installed apps --- Kernel & drivers
 234          -----------            --------------     ----------------
 235          mount point => device  List of apps       Extra information
 236          mount point => device  and versions       about kernel(s)
 237               ...                                  and drivers
 238          swap => swap device
 239          (plus lots of extra information
 240          about each filesystem)
 241
 242 The output of virt-inspector is a complex two-level data structure.
 243
 244 At the top level is a list of the operating systems installed on the
 245 guest.  (For the vast majority of guests, only a single OS is
 246 installed.)  The data returned for the OS includes the name (Linux,
 247 Windows), the distribution and version.
 248
 249 The diagram above shows what we return for each OS.
 250
 251 With the I<--xml> option the output is mapped into an XML document.
 252 There is a RELAX-NG schema for this XML in the file
 253 I<virt-inspector.rng> which normally ships with virt-inspector, or can
 254 be found in the source.
 255
 256 With the I<--fish> or I<--ro-fish> option the mount points are mapped to
 257 L<guestfish(1)> command line parameters, so that you can go in
 258 afterwards and inspect the guest with everything mounted in the
 259 right place.  For example:
 260
 261  guestfish $(virt-inspector --ro-fish guest.img)
 262  ==> guestfish --ro -a guest.img -m /dev/VG/LV:/ -m /dev/sda1:/boot
 263
 264 =cut
 265
 266 # List of possible filesystems.
 267 my @partitions = get_partitions ($g);
 268
 269 # Now query each one to build up a picture of what's in it.
 270 my %fses =
 271     inspect_all_partitions ($g, \@partitions);
 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, try installing perl-YAML or libyaml-perl\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 " (", $os->{product_name}, ")" if exists $os->{product_name};
 363     print " ";
 364     print "on ", $os->{root_device}, ":\n";
 365
 366     print __"  Mountpoints:\n";
 367     my $mounts = $os->{mounts};
 368     foreach (sort keys %$mounts) {
 369         printf "    %-30s %s\n", $mounts->{$_}, $_
 370     }
 371
 372     print __"  Filesystems:\n";
 373     my $filesystems = $os->{filesystems};
 374     foreach (sort keys %$filesystems) {
 375         print "    $_:\n";
 376         print "      label: $filesystems->{$_}{label}\n"
 377             if exists $filesystems->{$_}{label};
 378         print "      UUID: $filesystems->{$_}{uuid}\n"
 379             if exists $filesystems->{$_}{uuid};
 380         print "      type: $filesystems->{$_}{fstype}\n"
 381             if exists $filesystems->{$_}{fstype};
 382         print "      content: $filesystems->{$_}{content}\n"
 383             if exists $filesystems->{$_}{content};
 384     }
 385
 386     if (exists $os->{modprobe_aliases}) {
 387         my %aliases = %{$os->{modprobe_aliases}};
 388         my @keys = sort keys %aliases;
 389         if (@keys) {
 390             print __"  Modprobe aliases:\n";
 391             foreach (@keys) {
 392                 printf "    %-30s %s\n", $_, $aliases{$_}->{modulename}
 393             }
 394         }
 395     }
 396
 397     if (exists $os->{initrd_modules}) {
 398         my %modvers = %{$os->{initrd_modules}};
 399         my @keys = sort keys %modvers;
 400         if (@keys) {
 401             print __"  Initrd modules:\n";
 402             foreach (@keys) {
 403                 my @modules = @{$modvers{$_}};
 404                 print "    $_:\n";
 405                 print "      $_\n" foreach @modules;
 406             }
 407         }
 408     }
 409
 410     print __"  Applications:\n";
 411     my @apps =  @{$os->{apps}};
 412     foreach (@apps) {
 413         print "    $_->{name} $_->{version}\n"
 414     }
 415
 416     if ($os->{kernels}) {
 417         print __"  Kernels:\n";
 418         my @kernels = @{$os->{kernels}};
 419         foreach (@kernels) {
 420             print "    $_->{version} ($_->{arch})\n";
 421             my @modules = @{$_->{modules}};
 422             foreach (@modules) {
 423                 print "      $_\n";
 424             }
 425         }
 426     }
 427
 428     if (exists $os->{root}->{registry}) {
 429         print __"  Windows Registry entries:\n";
 430         # These are just lumps of text - dump them out.
 431         foreach (@{$os->{root}->{registry}}) {
 432             print "$_\n";
 433         }
 434     }
 435 }
 436
 437 sub output_xml
 438 {
 439     my $xml = new XML::Writer(DATA_MODE => 1, DATA_INDENT => 2);
 440
 441     $xml->startTag("operatingsystems");
 442     output_xml_os ($oses->{$_}, $xml) foreach sort keys %$oses;
 443     $xml->endTag("operatingsystems");
 444
 445     $xml->end();
 446 }
 447
 448 sub output_xml_os
 449 {
 450     my ($os, $xml) = @_;
 451
 452     $xml->startTag("operatingsystem");
 453
 454     foreach ( [ "name" => "os" ],
 455               [ "distro" => "distro" ],
 456               [ "product_name" => "product_name" ],
 457               [ "arch" => "arch" ],
 458               [ "major_version" => "major_version" ],
 459               [ "minor_version" => "minor_version" ],
 460               [ "package_format" => "package_format" ],
 461               [ "package_management" => "package_management" ],
 462               [ "root" => "root_device" ] ) {
 463         $xml->dataElement($_->[0], $os->{$_->[1]}) if exists $os->{$_->[1]};
 464     }
 465
 466     $xml->startTag("mountpoints");
 467     my $mounts = $os->{mounts};
 468     foreach (sort keys %$mounts) {
 469         $xml->dataElement("mountpoint", $_, "dev" => $mounts->{$_});
 470     }
 471     $xml->endTag("mountpoints");
 472
 473     $xml->startTag("filesystems");
 474     my $filesystems = $os->{filesystems};
 475     foreach (sort keys %$filesystems) {
 476         $xml->startTag("filesystem", "dev" => $_);
 477
 478         foreach my $field ( [ "label" => "label" ],
 479                             [ "uuid" => "uuid" ],
 480                             [ "type" => "fstype" ],
 481                             [ "content" => "content" ],
 482                             [ "spec" => "spec" ] ) {
 483             $xml->dataElement($field->[0], $filesystems->{$_}{$field->[1]})
 484                 if exists $filesystems->{$_}{$field->[1]};
 485         }
 486
 487         $xml->endTag("filesystem");
 488     }
 489     $xml->endTag("filesystems");
 490
 491     if (exists $os->{modprobe_aliases}) {
 492         my %aliases = %{$os->{modprobe_aliases}};
 493         my @keys = sort keys %aliases;
 494         if (@keys) {
 495             $xml->startTag("modprobealiases");
 496             foreach (@keys) {
 497                 $xml->startTag("alias", "device" => $_);
 498
 499                 foreach my $field ( [ "modulename" => "modulename" ],
 500                                     [ "augeas" => "augeas" ],
 501                                     [ "file" => "file" ] ) {
 502                     $xml->dataElement($field->[0], $aliases{$_}->{$field->[1]});
 503                 }
 504
 505                 $xml->endTag("alias");
 506             }
 507             $xml->endTag("modprobealiases");
 508         }
 509     }
 510
 511     if (exists $os->{initrd_modules}) {
 512         my %modvers = %{$os->{initrd_modules}};
 513         my @keys = sort keys %modvers;
 514         if (@keys) {
 515             $xml->startTag("initrds");
 516             foreach (@keys) {
 517                 my @modules = @{$modvers{$_}};
 518                 $xml->startTag("initrd", "version" => $_);
 519                 $xml->dataElement("module", $_) foreach @modules;
 520                 $xml->endTag("initrd");
 521             }
 522             $xml->endTag("initrds");
 523         }
 524     }
 525
 526     $xml->startTag("applications");
 527     my @apps =  @{$os->{apps}};
 528     foreach (@apps) {
 529         $xml->startTag("application");
 530         $xml->dataElement("name", $_->{name});
 531         $xml->dataElement("epoch", $_->{epoch}) if defined $_->{epoch};
 532         $xml->dataElement("version", $_->{version});
 533         $xml->dataElement("release", $_->{release});
 534         $xml->dataElement("arch", $_->{arch});
 535         $xml->endTag("application");
 536     }
 537     $xml->endTag("applications");
 538
 539     if(defined($os->{boot}) && defined($os->{boot}->{configs})) {
 540         my $default = $os->{boot}->{default};
 541         my $configs = $os->{boot}->{configs};
 542
 543         $xml->startTag("boot");
 544         for(my $i = 0; $i < scalar(@$configs); $i++) {
 545             my $config = $configs->[$i];
 546
 547             my @attrs = ();
 548             push(@attrs, ("default" => 1)) if($default == $i);
 549             $xml->startTag("config", @attrs);
 550             $xml->dataElement("title", $config->{title});
 551             $xml->dataElement("kernel", $config->{kernel}->{version})
 552                 if(defined($config->{kernel}));
 553             $xml->dataElement("cmdline", $config->{cmdline})
 554                 if(defined($config->{cmdline}));
 555             $xml->endTag("config");
 556         }
 557         $xml->endTag("boot");
 558     }
 559
 560     if ($os->{kernels}) {
 561         $xml->startTag("kernels");
 562         my @kernels = @{$os->{kernels}};
 563         foreach (@kernels) {
 564             $xml->startTag("kernel",
 565                            "version" => $_->{version},
 566                            "arch" => $_->{arch});
 567             $xml->startTag("modules");
 568             my @modules = @{$_->{modules}};
 569             foreach (@modules) {
 570                 $xml->dataElement("module", $_);
 571             }
 572             $xml->endTag("modules");
 573             $xml->dataElement("path", $_->{path}) if(defined($_->{path}));
 574             $xml->dataElement("package", $_->{package}) if(defined($_->{package}));
 575             $xml->endTag("kernel");
 576         }
 577         $xml->endTag("kernels");
 578     }
 579
 580     if (exists $os->{root}->{registry}) {
 581         $xml->startTag("windowsregistryentries");
 582         # These are just lumps of text - dump them out.
 583         foreach (@{$os->{root}->{registry}}) {
 584             $xml->dataElement("windowsregistryentry", $_);
 585         }
 586         $xml->endTag("windowsregistryentries");
 587     }
 588
 589     $xml->endTag("operatingsystem");
 590 }
 591
 592 =head1 QUERY MODE
 593
 594 When you use C<virt-inspector --query>, the output is a series of
 595 lines of the form:
 596
 597  windows=no
 598  linux=yes
 599  fullvirt=yes
 600  xen_pv_drivers=no
 601
 602 (each answer is usually C<yes> or C<no>, or the line is completely
 603 missing if we could not determine the answer at all).
 604
 605 If the guest is multiboot, you can get apparently conflicting answers
 606 (eg. C<windows=yes> and C<linux=yes>, or a guest which is both
 607 fullvirt and has a Xen PV kernel).  This is normal, and just means
 608 that the guest can do both things, although it might require operator
 609 intervention such as selecting a boot option when the guest is
 610 booting.
 611
 612 This section describes the full range of answers possible.
 613
 614 =over 4
 615
 616 =cut
 617
 618 sub output_query
 619 {
 620     output_query_windows ();
 621     output_query_linux ();
 622     output_query_rhel ();
 623     output_query_fedora ();
 624     output_query_debian ();
 625     output_query_fullvirt ();
 626     output_query_xen_domU_kernel ();
 627     output_query_xen_pv_drivers ();
 628     output_query_virtio_drivers ();
 629     output_query_kernel_arch ();
 630     output_query_userspace_arch ();
 631 }
 632
 633 =item windows=(yes|no)
 634
 635 Answer C<yes> if Microsoft Windows is installed in the guest.
 636
 637 =cut
 638
 639 sub output_query_windows
 640 {
 641     my $windows = "no";
 642     foreach my $os (keys %$oses) {
 643         $windows="yes" if $oses->{$os}->{os} eq "windows";
 644     }
 645     print "windows=$windows\n";
 646 }
 647
 648 =item linux=(yes|no)
 649
 650 Answer C<yes> if a Linux kernel is installed in the guest.
 651
 652 =cut
 653
 654 sub output_query_linux
 655 {
 656     my $linux = "no";
 657     foreach my $os (keys %$oses) {
 658         $linux="yes" if $oses->{$os}->{os} eq "linux";
 659     }
 660     print "linux=$linux\n";
 661 }
 662
 663 =item rhel=(yes|no)
 664
 665 Answer C<yes> if the guest contains Red Hat Enterprise Linux.
 666
 667 =cut
 668
 669 sub output_query_rhel
 670 {
 671     my $rhel = "no";
 672     foreach my $os (keys %$oses) {
 673         $rhel="yes" if ($oses->{$os}->{os} eq "linux" &&
 674                         $oses->{$os}->{distro} eq "rhel");
 675     }
 676     print "rhel=$rhel\n";
 677 }
 678
 679 =item fedora=(yes|no)
 680
 681 Answer C<yes> if the guest contains the Fedora Linux distribution.
 682
 683 =cut
 684
 685 sub output_query_fedora
 686 {
 687     my $fedora = "no";
 688     foreach my $os (keys %$oses) {
 689         $fedora="yes" if $oses->{$os}->{os} eq "linux" && $oses->{$os}->{distro} eq "fedora";
 690     }
 691     print "fedora=$fedora\n";
 692 }
 693
 694 =item debian=(yes|no)
 695
 696 Answer C<yes> if the guest contains the Debian Linux distribution.
 697
 698 =cut
 699
 700 sub output_query_debian
 701 {
 702     my $debian = "no";
 703     foreach my $os (keys %$oses) {
 704         $debian="yes" if $oses->{$os}->{os} eq "linux" && $oses->{$os}->{distro} eq "debian";
 705     }
 706     print "debian=$debian\n";
 707 }
 708
 709 =item fullvirt=(yes|no)
 710
 711 Answer C<yes> if there is at least one operating system kernel
 712 installed in the guest which runs fully virtualized.  Such a guest
 713 would require a hypervisor which supports full system virtualization.
 714
 715 =cut
 716
 717 sub output_query_fullvirt
 718 {
 719     # The assumption is full-virt, unless all installed kernels
 720     # are identified as paravirt.
 721     # XXX Fails on Windows guests.
 722     foreach my $os (keys %$oses) {
 723         foreach my $kernel (@{$oses->{$os}->{kernels}}) {
 724             my $is_pv = $kernel->{version} =~ m/xen/;
 725             unless ($is_pv) {
 726                 print "fullvirt=yes\n";
 727                 return;
 728             }
 729         }
 730     }
 731     print "fullvirt=no\n";
 732 }
 733
 734 =item xen_domU_kernel=(yes|no)
 735
 736 Answer C<yes> if there is at least one Linux kernel installed in
 737 the guest which is compiled as a Xen DomU (a Xen paravirtualized
 738 guest).
 739
 740 =cut
 741
 742 sub output_query_xen_domU_kernel
 743 {
 744     foreach my $os (keys %$oses) {
 745         foreach my $kernel (@{$oses->{$os}->{kernels}}) {
 746             my $is_xen = $kernel->{version} =~ m/xen/;
 747             if ($is_xen) {
 748                 print "xen_domU_kernel=yes\n";
 749                 return;
 750             }
 751         }
 752     }
 753     print "xen_domU_kernel=no\n";
 754 }
 755
 756 =item xen_pv_drivers=(yes|no)
 757
 758 Answer C<yes> if the guest has Xen paravirtualized drivers installed
 759 (usually the kernel itself will be fully virtualized, but the PV
 760 drivers have been installed by the administrator for performance
 761 reasons).
 762
 763 =cut
 764
 765 sub output_query_xen_pv_drivers
 766 {
 767     foreach my $os (keys %$oses) {
 768         foreach my $kernel (@{$oses->{$os}->{kernels}}) {
 769             foreach my $module (@{$kernel->{modules}}) {
 770                 if ($module =~ m/xen-/) {
 771                     print "xen_pv_drivers=yes\n";
 772                     return;
 773                 }
 774             }
 775         }
 776     }
 777     print "xen_pv_drivers=no\n";
 778 }
 779
 780 =item virtio_drivers=(yes|no)
 781
 782 Answer C<yes> if the guest has virtio paravirtualized drivers
 783 installed.  Virtio drivers are commonly used to improve the
 784 performance of KVM.
 785
 786 =cut
 787
 788 sub output_query_virtio_drivers
 789 {
 790     foreach my $os (keys %$oses) {
 791         foreach my $kernel (@{$oses->{$os}->{kernels}}) {
 792             foreach my $module (@{$kernel->{modules}}) {
 793                 if ($module =~ m/virtio_/) {
 794                     print "virtio_drivers=yes\n";
 795                     return;
 796                 }
 797             }
 798         }
 799     }
 800     print "virtio_drivers=no\n";
 801 }
 802
 803 =item userspace_arch=(x86_64|...)
 804
 805 Print the architecture of userspace.
 806
 807 NB. For multi-boot VMs this can print several lines.
 808
 809 =cut
 810
 811 sub output_query_userspace_arch
 812 {
 813     my %arches;
 814
 815     foreach my $os (keys %$oses) {
 816         $arches{$oses->{$os}->{arch}} = 1 if exists $oses->{$os}->{arch};
 817     }
 818
 819     foreach (sort keys %arches) {
 820         print "userspace_arch=$_\n";
 821     }
 822 }
 823
 824 =item kernel_arch=(x86_64|...)
 825
 826 Print the architecture of the kernel.
 827
 828 NB. For multi-boot VMs this can print several lines.
 829
 830 =cut
 831
 832 sub output_query_kernel_arch
 833 {
 834     my %arches;
 835
 836     foreach my $os (keys %$oses) {
 837         foreach my $kernel (@{$oses->{$os}->{kernels}}) {
 838             $arches{$kernel->{arch}} = 1 if exists $kernel->{arch};
 839         }
 840     }
 841
 842     foreach (sort keys %arches) {
 843         print "kernel_arch=$_\n";
 844     }
 845 }
 846
 847 =back
 848
 849 =head1 SEE ALSO
 850
 851 L<guestfs(3)>,
 852 L<guestfish(1)>,
 853 L<Sys::Guestfs(3)>,
 854 L<Sys::Guestfs::Lib(3)>,
 855 L<Sys::Virt(3)>,
 856 L<http://libguestfs.org/>.
 857
 858 =head1 AUTHORS
 859
 860 Richard W.M. Jones L<http://people.redhat.com/~rjones/>
 861
 862 Matthew Booth L<mbooth@redhat.com>
 863
 864 =head1 COPYRIGHT
 865
 866 Copyright (C) 2009 Red Hat Inc.
 867
 868 This program is free software; you can redistribute it and/or modify
 869 it under the terms of the GNU General Public License as published by
 870 the Free Software Foundation; either version 2 of the License, or
 871 (at your option) any later version.
 872
 873 This program is distributed in the hope that it will be useful,
 874 but WITHOUT ANY WARRANTY; without even the implied warranty of
 875 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 876 GNU General Public License for more details.
 877
 878 You should have received a copy of the GNU General Public License
 879 along with this program; if not, write to the Free Software
 880 Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.