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