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     # XXX Windows version.
 438     # List of applications.
 439 }
 440
 441 sub check_grub
 442 {
 443     local $_;
 444     my $r = shift;
 445
 446     # XXX Kernel versions, grub version.
 447 }
 448
 449 #print Dumper (\%fses);
 450
 451 #----------------------------------------------------------------------
 452 # Now find out how many operating systems we've got.  Usually just one.
 453
 454 my %oses = ();
 455
 456 foreach (sort keys %fses) {
 457     if ($fses{$_}->{is_root}) {
 458         my %r = (
 459             root => $fses{$_},
 460             root_device => $_
 461         );
 462         get_os_version (\%r);
 463         assign_mount_points (\%r);
 464         $oses{$_} = \%r;
 465     }
 466 }
 467
 468 sub get_os_version
 469 {
 470     local $_;
 471     my $r = shift;
 472
 473     $r->{os} = $r->{root}->{fsos} if exists $r->{root}->{fsos};
 474     $r->{distro} = $r->{root}->{osdistro} if exists $r->{root}->{osdistro};
 475     $r->{version} = $r->{root}->{osversion} if exists $r->{root}->{osversion};
 476 }
 477
 478 sub assign_mount_points
 479 {
 480     local $_;
 481     my $r = shift;
 482
 483     $r->{mounts} = { "/" => $r->{root_device} };
 484     $r->{filesystems} = { $r->{root_device} => $r->{root} };
 485
 486     # Use /etc/fstab if we have it to mount the rest.
 487     if (exists $r->{root}->{fstab}) {
 488         my @fstab = @{$r->{root}->{fstab}};
 489         foreach (@fstab) {
 490             my ($spec, $file) = @$_;
 491
 492             my ($dev, $fs) = find_filesystem ($spec);
 493             if ($dev) {
 494                 $r->{mounts}->{$file} = $dev;
 495                 $r->{filesystems}->{$dev} = $fs;
 496                 if (exists $fs->{used}) {
 497                     $fs->{used}++
 498                 } else {
 499                     $fs->{used} = 1
 500                 }
 501             }
 502         }
 503     }
 504 }
 505
 506 # Find filesystem by device name, LABEL=.. or UUID=..
 507 sub find_filesystem
 508 {
 509     local $_ = shift;
 510
 511     if (/^LABEL=(.*)/) {
 512         my $label = $1;
 513         foreach (sort keys %fses) {
 514             if (exists $fses{$_}->{label} &&
 515                 $fses{$_}->{label} eq $label) {
 516                 return ($_, $fses{$_});
 517             }
 518         }
 519         warn "unknown filesystem label $label\n";
 520         return ();
 521     } elsif (/^UUID=(.*)/) {
 522         my $uuid = $1;
 523         foreach (sort keys %fses) {
 524             if (exists $fses{$_}->{uuid} &&
 525                 $fses{$_}->{uuid} eq $uuid) {
 526                 return ($_, $fses{$_});
 527             }
 528         }
 529         warn "unknown filesystem UUID $uuid\n";
 530         return ();
 531     } else {
 532         return ($_, $fses{$_}) if exists $fses{$_};
 533
 534         if (m{^/dev/hd(.*)} && exists $fses{"/dev/sd$1"}) {
 535             return ("/dev/sd$1", $fses{"/dev/sd$1"});
 536         }
 537         if (m{^/dev/xvd(.*)} && exists $fses{"/dev/sd$1"}) {
 538             return ("/dev/sd$1", $fses{"/dev/sd$1"});
 539         }
 540
 541         return () if m{/dev/cdrom};
 542
 543         warn "unknown filesystem $_\n";
 544         return ();
 545     }
 546 }
 547
 548 #print Dumper(\%oses);
 549
 550 #----------------------------------------------------------------------
 551 # Mount up the disks so we can check for applications
 552 # and kernels.  Skip this if the output is "*fish" because
 553 # we don't need to know.
 554
 555 if ($output !~ /.*fish$/) {
 556     my $root_dev;
 557     foreach $root_dev (sort keys %oses) {
 558         my $mounts = $oses{$root_dev}->{mounts};
 559         # Have to mount / first.  Luckily '/' is early in the ASCII
 560         # character set, so this should be OK.
 561         foreach (sort keys %$mounts) {
 562             $g->mount_ro ($mounts->{$_}, $_)
 563                 if $_ ne "swap" && ($_ eq '/' || $g->is_dir ($_));
 564         }
 565
 566         check_for_applications ($root_dev);
 567         check_for_kernels ($root_dev);
 568
 569         $g->umount_all ();
 570     }
 571 }
 572
 573 sub check_for_applications
 574 {
 575     local $_;
 576     my $root_dev = shift;
 577
 578     my @apps;
 579
 580     my $os = $oses{$root_dev}->{os};
 581     if ($os eq "linux") {
 582         my $distro = $oses{$root_dev}->{distro};
 583         if ($distro eq "redhat") {
 584             my @lines = $g->command_lines
 585                 (["rpm", "-q", "-a", "--qf",
 586                   "%{name} %{epoch} %{version} %{release} %{arch}\n"]);
 587             foreach (@lines) {
 588                 if (m/^(.*) (.*) (.*) (.*) (.*)$/) {
 589                     $epoch = $2;
 590                     $epoch = "" if $epoch eq "(none)";
 591                     my $app = {
 592                         name => $1,
 593                         epoch => $epoch,
 594                         version => $3,
 595                         release => $4,
 596                         arch => $5
 597                     };
 598                     push @apps, $app
 599                 }
 600             }
 601         }
 602     } elsif ($os eq "windows") {
 603         # This sucks ... XXX
 604         XXX
 605     }
 606 }
 607
 608 sub check_for_kernels
 609 {
 610     local $_;
 611     my $root_dev = shift;
 612
 613     # XXX
 614 }
 615
 616 #----------------------------------------------------------------------
 617 # Output.
 618
 619 if ($output eq "fish" || $output eq "ro-fish") {
 620     my @osdevs = keys %oses;
 621     # This only works if there is a single OS.
 622     die "--fish output is only possible with a single OS\n" if @osdevs != 1;
 623
 624     my $root_dev = $osdevs[0];
 625
 626     print "guestfish";
 627     if ($output eq "ro-fish") {
 628         print " --ro";
 629     }
 630
 631     print " -a $_" foreach @images;
 632
 633     my $mounts = $oses{$root_dev}->{mounts};
 634     # Have to mount / first.  Luckily '/' is early in the ASCII
 635     # character set, so this should be OK.
 636     foreach (sort keys %$mounts) {
 637         print " -m $mounts->{$_}:$_" if $_ ne "swap";
 638     }
 639     print "\n"
 640 }
 641
 642 # Perl output.
 643 elsif ($output eq "perl") {
 644     print Dumper(\%oses);
 645 }
 646
 647 # Plain text output (the default).
 648 elsif ($output eq "text") {
 649     output_text ();
 650 }
 651
 652 # XML output.
 653 elsif ($output eq "xml") {
 654     output_xml ();
 655 }
 656
 657 sub output_text
 658 {
 659     output_text_os ($oses{$_}) foreach sort keys %oses;
 660 }
 661
 662 sub output_text_os
 663 {
 664     my $os = shift;
 665
 666     print $os->{os}, " " if exists $os->{os};
 667     print $os->{distro}, " " if exists $os->{distro};
 668     print $os->{version}, " " if exists $os->{version};
 669     print "on ", $os->{root_device}, ":\n";
 670
 671     print "  Mountpoints:\n";
 672     my $mounts = $os->{mounts};
 673     foreach (sort keys %$mounts) {
 674         printf "    %-30s %s\n", $mounts->{$_}, $_
 675     }
 676
 677     print "  Filesystems:\n";
 678     my $filesystems = $os->{filesystems};
 679     foreach (sort keys %$filesystems) {
 680         print "    $_:\n";
 681         print "      label: $filesystems->{$_}{label}\n"
 682             if exists $filesystems->{$_}{label};
 683         print "      UUID: $filesystems->{$_}{uuid}\n"
 684             if exists $filesystems->{$_}{uuid};
 685         print "      type: $filesystems->{$_}{fstype}\n"
 686             if exists $filesystems->{$_}{fstype};
 687         print "      content: $filesystems->{$_}{content}\n"
 688             if exists $filesystems->{$_}{content};
 689     }
 690
 691     # XXX Applications.
 692     # XXX Kernel.
 693 }
 694
 695 sub output_xml
 696 {
 697     print "<operatingsystems>\n";
 698     output_xml_os ($oses{$_}) foreach sort keys %oses;
 699     print "</operatingsystems>\n";
 700 }
 701
 702 sub output_xml_os
 703 {
 704     my $os = shift;
 705
 706     print "<operatingsystem>\n";
 707
 708     print "<os>", $os->{os}, "</os>\n" if exists $os->{os};
 709     print "<distro>", $os->{distro}, "</distro>\n" if exists $os->{distro};
 710     print "<version>", $os->{version}, "</version>\n" if exists $os->{version};
 711     print "<root>", $os->{root_device}, "</root>\n";
 712
 713     print "<mountpoints>\n";
 714     my $mounts = $os->{mounts};
 715     foreach (sort keys %$mounts) {
 716         printf "<mountpoint dev='%s'>%s</mountpoint>\n",
 717           $mounts->{$_}, $_
 718     }
 719     print "</mountpoints>\n";
 720
 721     print "<filesystems>\n";
 722     my $filesystems = $os->{filesystems};
 723     foreach (sort keys %$filesystems) {
 724         print "<filesystem dev='$_'>\n";
 725         print "<label>$filesystems->{$_}{label}</label>\n"
 726             if exists $filesystems->{$_}{label};
 727         print "<uuid>$filesystems->{$_}{uuid}</uuid>\n"
 728             if exists $filesystems->{$_}{uuid};
 729         print "<type>$filesystems->{$_}{fstype}</type>\n"
 730             if exists $filesystems->{$_}{fstype};
 731         print "<content>$filesystems->{$_}{content}</content>\n"
 732             if exists $filesystems->{$_}{content};
 733         print "</filesystem>\n";
 734     }
 735     print "</filesystems>\n";
 736
 737     # XXX Applications.
 738     # XXX Kernel.
 739     print "</operatingsystem>\n";
 740 }
 741
 742 =head1 SEE ALSO
 743
 744 L<guestfs(3)>,
 745 L<guestfish(1)>,
 746 L<Sys::Guestfs(3)>,
 747 L<Sys::Virt(3)>
 748
 749 =head1 AUTHOR
 750
 751 Richard W.M. Jones L<http://et.redhat.com/~rjones/>
 752
 753 =head1 COPYRIGHT
 754
 755 Copyright (C) 2009 Red Hat Inc.
 756
 757 This program is free software; you can redistribute it and/or modify
 758 it under the terms of the GNU General Public License as published by
 759 the Free Software Foundation; either version 2 of the License, or
 760 (at your option) any later version.
 761
 762 This program is distributed in the hope that it will be useful,
 763 but WITHOUT ANY WARRANTY; without even the implied warranty of
 764 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 765 GNU General Public License for more details.
 766
 767 You should have received a copy of the GNU General Public License
 768 along with this program; if not, write to the Free Software
 769 Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.