inspector/virt-inspector.pl

   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 Pod::Usage;
  24 use Getopt::Long;
  25 use Data::Dumper;
  26
  27 # Optional:
  28 eval "use Sys::Virt;";
  29
  30 =encoding utf8
  31
  32 =head1 NAME
  33
  34 virt-inspector - Display OS version, kernel, drivers, mount points, applications, etc. in a virtual machine
  35
  36 =head1 SYNOPSIS
  37
  38  virt-inspector [--connect URI] domname
  39
  40  virt-inspector guest.img [guest.img ...]
  41
  42 =head1 DESCRIPTION
  43
  44 B<virt-inspector> examines a virtual machine and tries to determine
  45 the version of the OS, the kernel version, what drivers are installed,
  46 whether the virtual machine is fully virtualized (FV) or
  47 para-virtualized (PV), what applications are installed and more.
  48
  49 Virt-inspector can produce output in several formats, including a
  50 readable text report, and XML for feeding into other programs.
  51
  52 Virt-inspector should only be run on I<inactive> virtual machines.
  53 The program tries to determine that the machine is inactive and will
  54 refuse to run if it thinks you are trying to inspect a running domain.
  55
  56 In the normal usage, use C<virt-inspector domname> where C<domname> is
  57 the libvirt domain (see: C<virsh list --all>).
  58
  59 You can also run virt-inspector directly on disk images from a single
  60 virtual machine.  Use C<virt-inspector guest.img>.  In rare cases a
  61 domain has several block devices, in which case you should list them
  62 one after another, with the first corresponding to the guest's
  63 C</dev/sda>, the second to the guest's C</dev/sdb> and so on.
  64
  65 Virt-inspector can only inspect and report upon I<one domain at a
  66 time>.  To inspect several virtual machines, you have to run
  67 virt-inspector several times (for example, from a shell script
  68 for-loop).
  69
  70 Because virt-inspector needs direct access to guest images, it won't
  71 normally work over remote libvirt connections.
  72
  73 =head1 OPTIONS
  74
  75 =over 4
  76
  77 =cut
  78
  79 my $help;
  80
  81 =item B<--help>
  82
  83 Display brief help.
  84
  85 =cut
  86
  87 my $uri;
  88
  89 =item B<--connect URI> | B<-c URI>
  90
  91 If using libvirt, connect to the given I<URI>.  If omitted,
  92 then we connect to the default libvirt hypervisor.
  93
  94 Libvirt is only used if you specify a C<domname> on the
  95 command line.  If you specify guest block devices directly,
  96 then libvirt is not used at all.
  97
  98 =cut
  99
 100 my $force;
 101
 102 =item B<--force>
 103
 104 Force reading a particular guest even if it appears to
 105 be active, or if the guest image is writable.  This is
 106 dangerous and can even corrupt the guest image.
 107
 108 =cut
 109
 110 my $output = "text";
 111
 112 =item B<--text> (default)
 113
 114 =item B<--xml>
 115
 116 =item B<--perl>
 117
 118 =item B<--fish>
 119
 120 =item B<--ro-fish>
 121
 122 Select the output format.  The default is a readable text report.
 123
 124 If you select I<--xml> then you get XML output which can be fed
 125 to other programs.
 126
 127 If you select I<--perl> then you get Perl structures output which
 128 can be used directly in another Perl program.
 129
 130 If you select I<--fish> then we print a L<guestfish(1)> command
 131 line which will automatically mount up the filesystems on the
 132 correct mount points.  Try this for example:
 133
 134  eval `virt-inspector --fish guest.img`
 135
 136 I<--ro-fish> is the same, but the I<--ro> option is passed to
 137 guestfish so that the filesystems are mounted read-only.
 138
 139 =back
 140
 141 =cut
 142
 143 GetOptions ("help|?" => \$help,
 144             "connect|c=s" => \$uri,
 145             "force" => \$force,
 146             "xml" => sub { $output = "xml" },
 147             "perl" => sub { $output = "perl" },
 148             "fish" => sub { $output = "fish" },
 149             "guestfish" => sub { $output = "fish" },
 150             "ro-fish" => sub { $output = "ro-fish" },
 151             "ro-guestfish" => sub { $output = "ro-fish" })
 152     or pod2usage (2);
 153 pod2usage (1) if $help;
 154 pod2usage ("$0: no image or VM names given") if @ARGV == 0;
 155
 156 # Domain name or guest image(s)?
 157
 158 my @images;
 159 if (-e $ARGV[0]) {
 160     @images = @ARGV;
 161
 162     # Until we get an 'add_drive_ro' call, we must check that qemu
 163     # will only open this image in readonly mode.
 164     # XXX Remove this hack at some point ...  or at least push it
 165     # into libguestfs.
 166
 167     foreach (@images) {
 168         if (! -r $_) {
 169             die "guest image $_ does not exist or is not readable\n"
 170         } elsif (-w $_ && !$force) {
 171             die ("guest image $_ is writable! REFUSING TO PROCEED.\n".
 172                  "You can use --force to override this BUT that action\n".
 173                  "MAY CORRUPT THE DISK IMAGE.\n");
 174         }
 175     }
 176 } else {
 177     die "no libvirt support (install Sys::Virt)"
 178         unless exists $INC{"Sys/Virt.pm"};
 179
 180     pod2usage ("$0: too many domains listed on command line") if @ARGV > 1;
 181
 182     my $vmm;
 183     if (defined $uri) {
 184         $vmm = Sys::Virt->new (uri => $uri, readonly => 1);
 185     } else {
 186         $vmm = Sys::Virt->new (readonly => 1);
 187     }
 188     die "cannot connect to libvirt $uri\n" unless $vmm;
 189
 190     my @doms = $vmm->list_defined_domains ();
 191     my $dom;
 192     foreach (@doms) {
 193         if ($_->get_name () eq $ARGV[0]) {
 194             $dom = $_;
 195             last;
 196         }
 197     }
 198     die "$ARGV[0] is not the name of an inactive libvirt domain\n"
 199         unless $dom;
 200
 201     # Get the names of the image(s).
 202     my $xml = $dom->get_xml_description ();
 203
 204     my $p = new XML::XPath::XMLParser (xml => $xml);
 205     my $disks = $p->find ("//devices/disk");
 206     print "disks:\n";
 207     foreach ($disks->get_nodelist) {
 208         print XML::XPath::XMLParser::as_string($_);
 209     }
 210
 211     die "XXX"
 212 }
 213
 214 # We've now got the list of @images, so feed them to libguestfs.
 215 my $g = Sys::Guestfs->new ();
 216 $g->add_drive ($_) foreach @images;
 217 $g->launch ();
 218 $g->wait_ready ();
 219
 220 # We want to get the list of LVs and partitions (ie. anything that
 221 # could contain a filesystem).  Discard any partitions which are PVs.
 222 my @partitions = $g->list_partitions ();
 223 my @pvs = $g->pvs ();
 224 sub is_pv {
 225     my $t = shift;
 226     foreach (@pvs) {
 227         return 1 if $_ eq $t;
 228     }
 229     0;
 230 }
 231 @partitions = grep { ! is_pv ($_) } @partitions;
 232
 233 my @lvs = $g->lvs ();
 234
 235 =head1 OUTPUT FORMAT
 236
 237  Operating system(s)
 238  -------------------
 239  Linux (distro + version)
 240  Windows (version)
 241     |
 242     |
 243     +--- Filesystems ---------- Installed apps --- Kernel & drivers
 244          -----------            --------------     ----------------
 245          mount point => device  List of apps       Extra information
 246          mount point => device  and versions       about kernel(s)
 247               ...                                  and drivers
 248          swap => swap device
 249          (plus lots of extra information
 250          about each filesystem)
 251
 252 The output of virt-inspector is a complex two-level data structure.
 253
 254 At the top level is a list of the operating systems installed on the
 255 guest.  (For the vast majority of guests, only a single OS is
 256 installed.)  The data returned for the OS includes the name (Linux,
 257 Windows), the distribution and version.
 258
 259 The diagram above shows what we return for each OS.
 260
 261 With the I<--xml> option the output is mapped into an XML document.
 262 Unfortunately there is no clear schema for this document
 263 (contributions welcome) but you can get an idea of the format by
 264 looking at other documents and as a last resort the source for this
 265 program.
 266
 267 With the I<--fish> or I<--ro-fish> option the mount points are mapped to
 268 L<guestfish(1)> command line parameters, so that you can go in
 269 afterwards and inspect the guest with everything mounted in the
 270 right place.  For example:
 271
 272  eval `virt-inspector --ro-fish guest.img`
 273  ==> guestfish --ro -a guest.img -m /dev/VG/LV:/ -m /dev/sda1:/boot
 274
 275 =cut
 276
 277 # List of possible filesystems.
 278 my @devices = sort (@lvs, @partitions);
 279
 280 # Now query each one to build up a picture of what's in it.
 281 my %fses = map { $_ => check_fs ($_) } @devices;
 282
 283 # Now the complex checking code itself.
 284 # check_fs takes a device name (LV or partition name) and returns
 285 # a hashref containing everything we can find out about the device.
 286 sub check_fs {
 287     local $_;
 288     my $dev = shift;            # LV or partition name.
 289
 290     my %r;                      # Result hash.
 291
 292     # First try 'file(1)' on it.
 293     my $file = $g->file ($dev);
 294     if ($file =~ /ext2 filesystem data/) {
 295         $r{fstype} = "ext2";
 296         $r{fsos} = "linux";
 297     } elsif ($file =~ /ext3 filesystem data/) {
 298         $r{fstype} = "ext3";
 299         $r{fsos} = "linux";
 300     } elsif ($file =~ /ext4 filesystem data/) {
 301         $r{fstype} = "ext4";
 302         $r{fsos} = "linux";
 303     } elsif ($file =~ m{Linux/i386 swap file}) {
 304         $r{fstype} = "swap";
 305         $r{fsos} = "linux";
 306         $r{is_swap} = 1;
 307     }
 308
 309     # If it's ext2/3/4, then we want the UUID and label.
 310     if (exists $r{fstype} && $r{fstype} =~ /^ext/) {
 311         $r{uuid} = $g->get_e2uuid ($dev);
 312         $r{label} = $g->get_e2label ($dev);
 313     }
 314
 315     # Try mounting it, fnarrr.
 316     if (!$r{is_swap}) {
 317         $r{is_mountable} = 1;
 318         eval { $g->mount_ro ($dev, "/") };
 319         if ($@) {
 320             # It's not mountable, probably empty or some format
 321             # we don't understand.
 322             $r{is_mountable} = 0;
 323             goto OUT;
 324         }
 325
 326         # Grub /boot?
 327         if ($g->is_file ("/grub/menu.lst") ||
 328             $g->is_file ("/grub/grub.conf")) {
 329             $r{content} = "linux-grub";
 330             check_grub (\%r);
 331             goto OUT;
 332         }
 333
 334         # Linux root?
 335         if ($g->is_dir ("/etc") && $g->is_dir ("/bin") &&
 336             $g->is_file ("/etc/fstab")) {
 337             $r{content} = "linux-root";
 338             $r{is_root} = 1;
 339             check_linux_root (\%r);
 340             goto OUT;
 341         }
 342
 343         # Linux /usr/local.
 344         if ($g->is_dir ("/etc") && $g->is_dir ("/bin") &&
 345             $g->is_dir ("/share") && !$g->exists ("/local") &&
 346             !$g->is_file ("/etc/fstab")) {
 347             $r{content} = "linux-usrlocal";
 348             goto OUT;
 349         }
 350
 351         # Linux /usr.
 352         if ($g->is_dir ("/etc") && $g->is_dir ("/bin") &&
 353             $g->is_dir ("/share") && $g->exists ("/local") &&
 354             !$g->is_file ("/etc/fstab")) {
 355             $r{content} = "linux-usr";
 356             goto OUT;
 357         }
 358
 359         # Windows root?
 360         if ($g->is_file ("/AUTOEXEC.BAT") ||
 361             $g->is_file ("/autoexec.bat") ||
 362             $g->is_dir ("/Program Files") ||
 363             $g->is_dir ("/WINDOWS") ||
 364             $g->is_file ("/ntldr")) {
 365             $r{fstype} = "ntfs"; # XXX this is a guess
 366             $r{fsos} = "windows";
 367             $r{content} = "windows-root";
 368             $r{is_root} = 1;
 369             check_windows_root (\%r);
 370             goto OUT;
 371         }
 372     }
 373
 374   OUT:
 375     $g->umount_all ();
 376     return \%r;
 377 }
 378
 379 sub check_linux_root
 380 {
 381     local $_;
 382     my $r = shift;
 383
 384     # Look into /etc to see if we recognise the operating system.
 385     if ($g->is_file ("/etc/redhat-release")) {
 386         $_ = $g->cat ("/etc/redhat-release");
 387         if (/Fedora release (\d+\.\d+)/) {
 388             $r->{osdistro} = "fedora";
 389             $r->{osversion} = "$1"
 390         } elsif (/(Red Hat Enterprise Linux|CentOS|Scientific Linux).*release (\d+).*Update (\d+)/) {
 391             $r->{osdistro} = "redhat";
 392             $r->{osversion} = "$2.$3";
 393         } elsif (/(Red Hat Enterprise Linux|CentOS|Scientific Linux).*release (\d+(?:\.(\d+))?)/) {
 394             $r->{osdistro} = "redhat";
 395             $r->{osversion} = "$2";
 396         } else {
 397             $r->{osdistro} = "redhat";
 398         }
 399     } elsif ($g->is_file ("/etc/debian_version")) {
 400         $_ = $g->cat ("/etc/debian_version");
 401         if (/(\d+\.\d+)/) {
 402             $r->{osdistro} = "debian";
 403             $r->{osversion} = "$1";
 404         } else {
 405             $r->{osdistro} = "debian";
 406         }
 407     }
 408
 409     # Parse the contents of /etc/fstab.  This is pretty vital so
 410     # we can determine where filesystems are supposed to be mounted.
 411     eval "\$_ = \$g->cat ('/etc/fstab');";
 412     if (!$@ && $_) {
 413         my @lines = split /\n/;
 414         my @fstab;
 415         foreach (@lines) {
 416             my @fields = split /[ \t]+/;
 417             if (@fields >= 2) {
 418                 my $spec = $fields[0]; # first column (dev/label/uuid)
 419                 my $file = $fields[1]; # second column (mountpoint)
 420                 if ($spec =~ m{^/} ||
 421                     $spec =~ m{^LABEL=} ||
 422                     $spec =~ m{^UUID=} ||
 423                     $file eq "swap") {
 424                     push @fstab, [$spec, $file]
 425                 }
 426             }
 427         }
 428         $r->{fstab} = \@fstab if @fstab;
 429     }
 430 }
 431
 432 sub check_windows_root
 433 {
 434     local $_;
 435     my $r = shift;
 436
 437     # Windows version?
 438 }
 439
 440 sub check_grub
 441 {
 442     local $_;
 443     my $r = shift;
 444
 445     # Grub version, if we care.
 446 }
 447
 448 #print Dumper (\%fses);
 449
 450 #----------------------------------------------------------------------
 451 # Now find out how many operating systems we've got.  Usually just one.
 452
 453 my %oses = ();
 454
 455 foreach (sort keys %fses) {
 456     if ($fses{$_}->{is_root}) {
 457         my %r = (
 458             root => $fses{$_},
 459             root_device => $_
 460         );
 461         get_os_version (\%r);
 462         assign_mount_points (\%r);
 463         $oses{$_} = \%r;
 464     }
 465 }
 466
 467 sub get_os_version
 468 {
 469     local $_;
 470     my $r = shift;
 471
 472     $r->{os} = $r->{root}->{fsos} if exists $r->{root}->{fsos};
 473     $r->{distro} = $r->{root}->{osdistro} if exists $r->{root}->{osdistro};
 474     $r->{version} = $r->{root}->{osversion} if exists $r->{root}->{osversion};
 475 }
 476
 477 sub assign_mount_points
 478 {
 479     local $_;
 480     my $r = shift;
 481
 482     $r->{mounts} = { "/" => $r->{root_device} };
 483     $r->{filesystems} = { $r->{root_device} => $r->{root} };
 484
 485     # Use /etc/fstab if we have it to mount the rest.
 486     if (exists $r->{root}->{fstab}) {
 487         my @fstab = @{$r->{root}->{fstab}};
 488         foreach (@fstab) {
 489             my ($spec, $file) = @$_;
 490
 491             my ($dev, $fs) = find_filesystem ($spec);
 492             if ($dev) {
 493                 $r->{mounts}->{$file} = $dev;
 494                 $r->{filesystems}->{$dev} = $fs;
 495                 if (exists $fs->{used}) {
 496                     $fs->{used}++
 497                 } else {
 498                     $fs->{used} = 1
 499                 }
 500             }
 501         }
 502     }
 503 }
 504
 505 # Find filesystem by device name, LABEL=.. or UUID=..
 506 sub find_filesystem
 507 {
 508     local $_ = shift;
 509
 510     if (/^LABEL=(.*)/) {
 511         my $label = $1;
 512         foreach (sort keys %fses) {
 513             if (exists $fses{$_}->{label} &&
 514                 $fses{$_}->{label} eq $label) {
 515                 return ($_, $fses{$_});
 516             }
 517         }
 518         warn "unknown filesystem label $label\n";
 519         return ();
 520     } elsif (/^UUID=(.*)/) {
 521         my $uuid = $1;
 522         foreach (sort keys %fses) {
 523             if (exists $fses{$_}->{uuid} &&
 524                 $fses{$_}->{uuid} eq $uuid) {
 525                 return ($_, $fses{$_});
 526             }
 527         }
 528         warn "unknown filesystem UUID $uuid\n";
 529         return ();
 530     } else {
 531         return ($_, $fses{$_}) if exists $fses{$_};
 532
 533         if (m{^/dev/hd(.*)} && exists $fses{"/dev/sd$1"}) {
 534             return ("/dev/sd$1", $fses{"/dev/sd$1"});
 535         }
 536         if (m{^/dev/xvd(.*)} && exists $fses{"/dev/sd$1"}) {
 537             return ("/dev/sd$1", $fses{"/dev/sd$1"});
 538         }
 539
 540         return () if m{/dev/cdrom};
 541
 542         warn "unknown filesystem $_\n";
 543         return ();
 544     }
 545 }
 546
 547 #print Dumper(\%oses);
 548
 549 #----------------------------------------------------------------------
 550 # Mount up the disks so we can check for applications
 551 # and kernels.  Skip this if the output is "*fish" because
 552 # we don't need to know.
 553
 554 if ($output !~ /.*fish$/) {
 555     my $root_dev;
 556     foreach $root_dev (sort keys %oses) {
 557         my $mounts = $oses{$root_dev}->{mounts};
 558         # Have to mount / first.  Luckily '/' is early in the ASCII
 559         # character set, so this should be OK.
 560         foreach (sort keys %$mounts) {
 561             $g->mount_ro ($mounts->{$_}, $_)
 562                 if $_ ne "swap" && ($_ eq '/' || $g->is_dir ($_));
 563         }
 564
 565         check_for_applications ($root_dev);
 566         check_for_kernels ($root_dev);
 567
 568         $g->umount_all ();
 569     }
 570 }
 571
 572 sub check_for_applications
 573 {
 574     local $_;
 575     my $root_dev = shift;
 576
 577     my @apps;
 578
 579     my $os = $oses{$root_dev}->{os};
 580     if ($os eq "linux") {
 581         my $distro = $oses{$root_dev}->{distro};
 582         if ($distro eq "redhat") {
 583             my @lines = $g->command_lines
 584                 (["rpm", "-q", "-a", "--qf",
 585                   "%{name} %{epoch} %{version} %{release} %{arch}\n"]);
 586             foreach (@lines) {
 587                 if (m/^(.*) (.*) (.*) (.*) (.*)$/) {
 588                     my $epoch = $2;
 589                     $epoch = "" if $epoch eq "(none)";
 590                     my $app = {
 591                         name => $1,
 592                         epoch => $epoch,
 593                         version => $3,
 594                         release => $4,
 595                         arch => $5
 596                     };
 597                     push @apps, $app
 598                 }
 599             }
 600         }
 601     } elsif ($os eq "windows") {
 602         # XXX
 603         # I worked out a general plan for this, but haven't
 604         # implemented it yet.  We can iterate over /Program Files
 605         # looking for *.EXE files, which we download, then use
 606         # i686-pc-mingw32-windres on, to find the VERSIONINFO
 607         # section, which has a lot of useful information.
 608     }
 609
 610     $oses{$root_dev}->{apps} = \@apps;
 611 }
 612
 613 sub check_for_kernels
 614 {
 615     local $_;
 616     my $root_dev = shift;
 617
 618     my @kernels;
 619
 620     my $os = $oses{$root_dev}->{os};
 621     if ($os eq "linux") {
 622         # Installed kernels will have a corresponding /lib/modules/<version>
 623         # directory, which is the easiest way to find out what kernels
 624         # are installed, and what modules are available.
 625         foreach ($g->ls ("/lib/modules")) {
 626             if ($g->is_dir ("/lib/modules/$_")) {
 627                 my %kernel;
 628                 $kernel{version} = $_;
 629
 630
 631                 # XXX List modules.
 632
 633
 634
 635
 636
 637
 638                 push @kernels, \%kernel;
 639             }
 640         }
 641
 642     } elsif ($os eq "windows") {
 643         # XXX
 644     }
 645
 646     $oses{$root_dev}->{kernels} = \@kernels;
 647 }
 648
 649 #----------------------------------------------------------------------
 650 # Output.
 651
 652 if ($output eq "fish" || $output eq "ro-fish") {
 653     my @osdevs = keys %oses;
 654     # This only works if there is a single OS.
 655     die "--fish output is only possible with a single OS\n" if @osdevs != 1;
 656
 657     my $root_dev = $osdevs[0];
 658
 659     print "guestfish";
 660     if ($output eq "ro-fish") {
 661         print " --ro";
 662     }
 663
 664     print " -a $_" foreach @images;
 665
 666     my $mounts = $oses{$root_dev}->{mounts};
 667     # Have to mount / first.  Luckily '/' is early in the ASCII
 668     # character set, so this should be OK.
 669     foreach (sort keys %$mounts) {
 670         print " -m $mounts->{$_}:$_" if $_ ne "swap";
 671     }
 672     print "\n"
 673 }
 674
 675 # Perl output.
 676 elsif ($output eq "perl") {
 677     print Dumper(\%oses);
 678 }
 679
 680 # Plain text output (the default).
 681 elsif ($output eq "text") {
 682     output_text ();
 683 }
 684
 685 # XML output.
 686 elsif ($output eq "xml") {
 687     output_xml ();
 688 }
 689
 690 sub output_text
 691 {
 692     output_text_os ($oses{$_}) foreach sort keys %oses;
 693 }
 694
 695 sub output_text_os
 696 {
 697     my $os = shift;
 698
 699     print $os->{os}, " " if exists $os->{os};
 700     print $os->{distro}, " " if exists $os->{distro};
 701     print $os->{version}, " " if exists $os->{version};
 702     print "on ", $os->{root_device}, ":\n";
 703
 704     print "  Mountpoints:\n";
 705     my $mounts = $os->{mounts};
 706     foreach (sort keys %$mounts) {
 707         printf "    %-30s %s\n", $mounts->{$_}, $_
 708     }
 709
 710     print "  Filesystems:\n";
 711     my $filesystems = $os->{filesystems};
 712     foreach (sort keys %$filesystems) {
 713         print "    $_:\n";
 714         print "      label: $filesystems->{$_}{label}\n"
 715             if exists $filesystems->{$_}{label};
 716         print "      UUID: $filesystems->{$_}{uuid}\n"
 717             if exists $filesystems->{$_}{uuid};
 718         print "      type: $filesystems->{$_}{fstype}\n"
 719             if exists $filesystems->{$_}{fstype};
 720         print "      content: $filesystems->{$_}{content}\n"
 721             if exists $filesystems->{$_}{content};
 722     }
 723
 724     print "  Applications:\n";
 725     my @apps =  @{$os->{apps}};
 726     foreach (@apps) {
 727         print "    $_->{name} $_->{version}\n"
 728     }
 729
 730     print "  Kernels:\n";
 731     my @kernels = @{$os->{kernels}};
 732     foreach (@kernels) {
 733         print "    $_->{version}\n"
 734
 735
 736
 737     }
 738 }
 739
 740 sub output_xml
 741 {
 742     print "<operatingsystems>\n";
 743     output_xml_os ($oses{$_}) foreach sort keys %oses;
 744     print "</operatingsystems>\n";
 745 }
 746
 747 sub output_xml_os
 748 {
 749     my $os = shift;
 750
 751     print "<operatingsystem>\n";
 752
 753     print "<os>", $os->{os}, "</os>\n" if exists $os->{os};
 754     print "<distro>", $os->{distro}, "</distro>\n" if exists $os->{distro};
 755     print "<version>", $os->{version}, "</version>\n" if exists $os->{version};
 756     print "<root>", $os->{root_device}, "</root>\n";
 757
 758     print "<mountpoints>\n";
 759     my $mounts = $os->{mounts};
 760     foreach (sort keys %$mounts) {
 761         printf "<mountpoint dev='%s'>%s</mountpoint>\n",
 762           $mounts->{$_}, $_
 763     }
 764     print "</mountpoints>\n";
 765
 766     print "<filesystems>\n";
 767     my $filesystems = $os->{filesystems};
 768     foreach (sort keys %$filesystems) {
 769         print "<filesystem dev='$_'>\n";
 770         print "<label>$filesystems->{$_}{label}</label>\n"
 771             if exists $filesystems->{$_}{label};
 772         print "<uuid>$filesystems->{$_}{uuid}</uuid>\n"
 773             if exists $filesystems->{$_}{uuid};
 774         print "<type>$filesystems->{$_}{fstype}</type>\n"
 775             if exists $filesystems->{$_}{fstype};
 776         print "<content>$filesystems->{$_}{content}</content>\n"
 777             if exists $filesystems->{$_}{content};
 778         print "</filesystem>\n";
 779     }
 780     print "</filesystems>\n";
 781
 782     print "<applications>\n";
 783     my @apps =  @{$os->{apps}};
 784     foreach (@apps) {
 785         print "<application>\n";
 786         print "<name>$_->{name}</name><version>$_->{version}</version>\n";
 787         print "</application>\n";
 788     }
 789     print "</applications>\n";
 790
 791     print "<kernels>\n";
 792     my @kernels = @{$os->{kernels}};
 793     foreach (@kernels) {
 794         print "<kernel>\n";
 795         print "<version>$_->{version}</version>\n";
 796
 797
 798
 799
 800
 801
 802         print "</kernel>\n";
 803     }
 804     print "</kernels>\n";
 805
 806     print "</operatingsystem>\n";
 807 }
 808
 809 =head1 SEE ALSO
 810
 811 L<guestfs(3)>,
 812 L<guestfish(1)>,
 813 L<Sys::Guestfs(3)>,
 814 L<Sys::Virt(3)>
 815
 816 =head1 AUTHOR
 817
 818 Richard W.M. Jones L<http://et.redhat.com/~rjones/>
 819
 820 =head1 COPYRIGHT
 821
 822 Copyright (C) 2009 Red Hat Inc.
 823
 824 This program is free software; you can redistribute it and/or modify
 825 it under the terms of the GNU General Public License as published by
 826 the Free Software Foundation; either version 2 of the License, or
 827 (at your option) any later version.
 828
 829 This program is distributed in the hope that it will be useful,
 830 but WITHOUT ANY WARRANTY; without even the implied warranty of
 831 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 832 GNU General Public License for more details.
 833
 834 You should have received a copy of the GNU General Public License
 835 along with this program; if not, write to the Free Software
 836 Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.