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 use File::Temp qw/tempdir/;
  27 use XML::Writer;
  28
  29 # Optional:
  30 eval "use Sys::Virt;";
  31 eval "use XML::XPath;";
  32 eval "use XML::XPath::XMLParser;";
  33 eval "use YAML::Any;";
  34
  35 =encoding utf8
  36
  37 =head1 NAME
  38
  39 virt-inspector - Display OS version, kernel, drivers, mount points, applications, etc. in a virtual machine
  40
  41 =head1 SYNOPSIS
  42
  43  virt-inspector [--connect URI] domname
  44
  45  virt-inspector guest.img [guest.img ...]
  46
  47 =head1 DESCRIPTION
  48
  49 B<virt-inspector> examines a virtual machine and tries to determine
  50 the version of the OS, the kernel version, what drivers are installed,
  51 whether the virtual machine is fully virtualized (FV) or
  52 para-virtualized (PV), what applications are installed and more.
  53
  54 Virt-inspector can produce output in several formats, including a
  55 readable text report, and XML for feeding into other programs.
  56
  57 Virt-inspector should only be run on I<inactive> virtual machines.
  58 The program tries to determine that the machine is inactive and will
  59 refuse to run if it thinks you are trying to inspect a running domain.
  60
  61 In the normal usage, use C<virt-inspector domname> where C<domname> is
  62 the libvirt domain (see: C<virsh list --all>).
  63
  64 You can also run virt-inspector directly on disk images from a single
  65 virtual machine.  Use C<virt-inspector guest.img>.  In rare cases a
  66 domain has several block devices, in which case you should list them
  67 one after another, with the first corresponding to the guest's
  68 C</dev/sda>, the second to the guest's C</dev/sdb> and so on.
  69
  70 Virt-inspector can only inspect and report upon I<one domain at a
  71 time>.  To inspect several virtual machines, you have to run
  72 virt-inspector several times (for example, from a shell script
  73 for-loop).
  74
  75 Because virt-inspector needs direct access to guest images, it won't
  76 normally work over remote libvirt connections.
  77
  78 =head1 OPTIONS
  79
  80 =over 4
  81
  82 =cut
  83
  84 my $help;
  85
  86 =item B<--help>
  87
  88 Display brief help.
  89
  90 =cut
  91
  92 my $uri;
  93
  94 =item B<--connect URI> | B<-c URI>
  95
  96 If using libvirt, connect to the given I<URI>.  If omitted,
  97 then we connect to the default libvirt hypervisor.
  98
  99 Libvirt is only used if you specify a C<domname> on the
 100 command line.  If you specify guest block devices directly,
 101 then libvirt is not used at all.
 102
 103 =cut
 104
 105 my $force;
 106
 107 =item B<--force>
 108
 109 Force reading a particular guest even if it appears to be active.  In
 110 earlier versions of virt-inspector, this could be dangerous (for
 111 example, corrupting the guest's disk image).  However in more recent
 112 versions, it should not cause corruption, but might cause
 113 virt-inspector to crash or produce incorrect results.
 114
 115 =cut
 116
 117 my $output = "text";
 118
 119 =back
 120
 121 The following options select the output format.  Use only one of them.
 122 The default is a readable text report.
 123
 124 =over 4
 125
 126 =item B<--text> (default)
 127
 128 Plain text report.
 129
 130 =item B<--none>
 131
 132 Produce no output at all.
 133
 134 =item B<--xml>
 135
 136 If you select I<--xml> then you get XML output which can be fed
 137 to other programs.
 138
 139 =item B<--yaml>
 140
 141 If you select I<--yaml> then you get YAML output which can be fed
 142 to other programs.
 143
 144 =item B<--perl>
 145
 146 If you select I<--perl> then you get Perl structures output which
 147 can be used directly in another Perl program.
 148
 149 =item B<--fish>
 150
 151 =item B<--ro-fish>
 152
 153 If you select I<--fish> then we print a L<guestfish(1)> command
 154 line which will automatically mount up the filesystems on the
 155 correct mount points.  Try this for example:
 156
 157  guestfish $(virt-inspector --fish guest.img)
 158
 159 I<--ro-fish> is the same, but the I<--ro> option is passed to
 160 guestfish so that the filesystems are mounted read-only.
 161
 162 =item B<--query>
 163
 164 In "query mode" we answer common questions about the guest, such
 165 as whether it is fullvirt or needs a Xen hypervisor to run.
 166
 167 See section I<QUERY MODE> below.
 168
 169 =cut
 170
 171 my $windows_registry;
 172
 173 =item B<--windows-registry>
 174
 175 If this item is passed, I<and> the guest is Windows, I<and> the
 176 external program C<reged> is available (see SEE ALSO section), then we
 177 attempt to parse the Windows registry.  This allows much more
 178 information to be gathered for Windows guests.
 179
 180 This is quite an expensive and slow operation, so we don't do it by
 181 default.
 182
 183 =back
 184
 185 =cut
 186
 187 GetOptions ("help|?" => \$help,
 188             "connect|c=s" => \$uri,
 189             "force" => \$force,
 190             "text" => sub { $output = "text" },
 191             "none" => sub { $output = "none" },
 192             "xml" => sub { $output = "xml" },
 193             "yaml" => sub { $output = "yaml" },
 194             "perl" => sub { $output = "perl" },
 195             "fish" => sub { $output = "fish" },
 196             "guestfish" => sub { $output = "fish" },
 197             "ro-fish" => sub { $output = "ro-fish" },
 198             "ro-guestfish" => sub { $output = "ro-fish" },
 199             "query" => sub { $output = "query" },
 200             "windows-registry" => \$windows_registry,
 201     ) or pod2usage (2);
 202 pod2usage (1) if $help;
 203 pod2usage ("$0: no image or VM names given") if @ARGV == 0;
 204
 205 # Domain name or guest image(s)?
 206
 207 my @images;
 208 if (-e $ARGV[0]) {
 209     @images = @ARGV;
 210
 211     foreach (@images) {
 212         if (! -r $_) {
 213             die "guest image $_ does not exist or is not readable\n"
 214         }
 215     }
 216 } else {
 217     die "virt-inspector: no libvirt support (install Sys::Virt, XML::XPath and XML::XPath::XMLParser)\n"
 218         unless exists $INC{"Sys/Virt.pm"} &&
 219         exists $INC{"XML/XPath.pm"} &&
 220         exists $INC{"XML/XPath/XMLParser.pm"};
 221
 222     pod2usage ("$0: too many domains listed on command line") if @ARGV > 1;
 223
 224     my $vmm;
 225     if (defined $uri) {
 226         $vmm = Sys::Virt->new (uri => $uri, readonly => 1);
 227     } else {
 228         $vmm = Sys::Virt->new (readonly => 1);
 229     }
 230     die "cannot connect to libvirt $uri\n" unless $vmm;
 231
 232     my @doms = $vmm->list_defined_domains ();
 233     my $isitinactive = "an inactive libvirt domain";
 234     if ($output ne "fish") {
 235         # In the special case where we want read-only access to
 236         # a domain, allow the user to specify an active domain too.
 237         push @doms, $vmm->list_domains ();
 238         $isitinactive = "a libvirt domain";
 239     }
 240     my $dom;
 241     foreach (@doms) {
 242         if ($_->get_name () eq $ARGV[0]) {
 243             $dom = $_;
 244             last;
 245         }
 246     }
 247     die "$ARGV[0] is not the name of $isitinactive\n" unless $dom;
 248
 249     # Get the names of the image(s).
 250     my $xml = $dom->get_xml_description ();
 251
 252     my $p = XML::XPath->new (xml => $xml);
 253     my @disks = $p->findnodes ('//devices/disk/source/@dev');
 254     @images = map { $_->getData } @disks;
 255 }
 256
 257 # We've now got the list of @images, so feed them to libguestfs.
 258 my $g = Sys::Guestfs->new ();
 259 $g->add_drive_ro ($_) foreach @images;
 260 $g->launch ();
 261 $g->wait_ready ();
 262
 263 # We want to get the list of LVs and partitions (ie. anything that
 264 # could contain a filesystem).  Discard any partitions which are PVs.
 265 my @partitions = $g->list_partitions ();
 266 my @pvs = $g->pvs ();
 267 sub is_pv {
 268     my $t = shift;
 269     foreach (@pvs) {
 270         return 1 if $_ eq $t;
 271     }
 272     0;
 273 }
 274 @partitions = grep { ! is_pv ($_) } @partitions;
 275
 276 my @lvs = $g->lvs ();
 277
 278 =head1 OUTPUT FORMAT
 279
 280  Operating system(s)
 281  -------------------
 282  Linux (distro + version)
 283  Windows (version)
 284     |
 285     |
 286     +--- Filesystems ---------- Installed apps --- Kernel & drivers
 287          -----------            --------------     ----------------
 288          mount point => device  List of apps       Extra information
 289          mount point => device  and versions       about kernel(s)
 290               ...                                  and drivers
 291          swap => swap device
 292          (plus lots of extra information
 293          about each filesystem)
 294
 295 The output of virt-inspector is a complex two-level data structure.
 296
 297 At the top level is a list of the operating systems installed on the
 298 guest.  (For the vast majority of guests, only a single OS is
 299 installed.)  The data returned for the OS includes the name (Linux,
 300 Windows), the distribution and version.
 301
 302 The diagram above shows what we return for each OS.
 303
 304 With the I<--xml> option the output is mapped into an XML document.
 305 Unfortunately there is no clear schema for this document
 306 (contributions welcome) but you can get an idea of the format by
 307 looking at other documents and as a last resort the source for this
 308 program.
 309
 310 With the I<--fish> or I<--ro-fish> option the mount points are mapped to
 311 L<guestfish(1)> command line parameters, so that you can go in
 312 afterwards and inspect the guest with everything mounted in the
 313 right place.  For example:
 314
 315  guestfish $(virt-inspector --ro-fish guest.img)
 316  ==> guestfish --ro -a guest.img -m /dev/VG/LV:/ -m /dev/sda1:/boot
 317
 318 =cut
 319
 320 # List of possible filesystems.
 321 my @devices = sort (@lvs, @partitions);
 322
 323 # Now query each one to build up a picture of what's in it.
 324 my %fses = map { $_ => check_fs ($_) } @devices;
 325
 326 # Now the complex checking code itself.
 327 # check_fs takes a device name (LV or partition name) and returns
 328 # a hashref containing everything we can find out about the device.
 329 sub check_fs {
 330     local $_;
 331     my $dev = shift;            # LV or partition name.
 332
 333     my %r;                      # Result hash.
 334
 335     # First try 'file(1)' on it.
 336     my $file = $g->file ($dev);
 337     if ($file =~ /ext2 filesystem data/) {
 338         $r{fstype} = "ext2";
 339         $r{fsos} = "linux";
 340     } elsif ($file =~ /ext3 filesystem data/) {
 341         $r{fstype} = "ext3";
 342         $r{fsos} = "linux";
 343     } elsif ($file =~ /ext4 filesystem data/) {
 344         $r{fstype} = "ext4";
 345         $r{fsos} = "linux";
 346     } elsif ($file =~ m{Linux/i386 swap file}) {
 347         $r{fstype} = "swap";
 348         $r{fsos} = "linux";
 349         $r{is_swap} = 1;
 350     }
 351
 352     # If it's ext2/3/4, then we want the UUID and label.
 353     if (exists $r{fstype} && $r{fstype} =~ /^ext/) {
 354         $r{uuid} = $g->get_e2uuid ($dev);
 355         $r{label} = $g->get_e2label ($dev);
 356     }
 357
 358     # Try mounting it, fnarrr.
 359     if (!$r{is_swap}) {
 360         $r{is_mountable} = 1;
 361         eval { $g->mount_ro ($dev, "/") };
 362         if ($@) {
 363             # It's not mountable, probably empty or some format
 364             # we don't understand.
 365             $r{is_mountable} = 0;
 366             goto OUT;
 367         }
 368
 369         # Grub /boot?
 370         if ($g->is_file ("/grub/menu.lst") ||
 371             $g->is_file ("/grub/grub.conf")) {
 372             $r{content} = "linux-grub";
 373             check_grub (\%r);
 374             goto OUT;
 375         }
 376
 377         # Linux root?
 378         if ($g->is_dir ("/etc") && $g->is_dir ("/bin") &&
 379             $g->is_file ("/etc/fstab")) {
 380             $r{content} = "linux-root";
 381             $r{is_root} = 1;
 382             check_linux_root (\%r);
 383             goto OUT;
 384         }
 385
 386         # Linux /usr/local.
 387         if ($g->is_dir ("/etc") && $g->is_dir ("/bin") &&
 388             $g->is_dir ("/share") && !$g->exists ("/local") &&
 389             !$g->is_file ("/etc/fstab")) {
 390             $r{content} = "linux-usrlocal";
 391             goto OUT;
 392         }
 393
 394         # Linux /usr.
 395         if ($g->is_dir ("/etc") && $g->is_dir ("/bin") &&
 396             $g->is_dir ("/share") && $g->exists ("/local") &&
 397             !$g->is_file ("/etc/fstab")) {
 398             $r{content} = "linux-usr";
 399             goto OUT;
 400         }
 401
 402         # Windows root?
 403         if ($g->is_file ("/AUTOEXEC.BAT") ||
 404             $g->is_file ("/autoexec.bat") ||
 405             $g->is_dir ("/Program Files") ||
 406             $g->is_dir ("/WINDOWS") ||
 407             $g->is_file ("/boot.ini") ||
 408             $g->is_file ("/ntldr")) {
 409             $r{fstype} = "ntfs"; # XXX this is a guess
 410             $r{fsos} = "windows";
 411             $r{content} = "windows-root";
 412             $r{is_root} = 1;
 413             check_windows_root (\%r);
 414             goto OUT;
 415         }
 416     }
 417
 418   OUT:
 419     $g->umount_all ();
 420     return \%r;
 421 }
 422
 423 sub check_linux_root
 424 {
 425     local $_;
 426     my $r = shift;
 427
 428     # Look into /etc to see if we recognise the operating system.
 429     if ($g->is_file ("/etc/redhat-release")) {
 430         $_ = $g->cat ("/etc/redhat-release");
 431         if (/Fedora release (\d+\.\d+)/) {
 432             $r->{osdistro} = "fedora";
 433             $r->{osversion} = "$1"
 434         } elsif (/(Red Hat Enterprise Linux|CentOS|Scientific Linux).*release (\d+).*Update (\d+)/) {
 435             $r->{osdistro} = "redhat";
 436             $r->{osversion} = "$2.$3";
 437         } elsif (/(Red Hat Enterprise Linux|CentOS|Scientific Linux).*release (\d+(?:\.(\d+))?)/) {
 438             $r->{osdistro} = "redhat";
 439             $r->{osversion} = "$2";
 440         } else {
 441             $r->{osdistro} = "redhat";
 442         }
 443     } elsif ($g->is_file ("/etc/debian_version")) {
 444         $_ = $g->cat ("/etc/debian_version");
 445         if (/(\d+\.\d+)/) {
 446             $r->{osdistro} = "debian";
 447             $r->{osversion} = "$1";
 448         } else {
 449             $r->{osdistro} = "debian";
 450         }
 451     }
 452
 453     # Parse the contents of /etc/fstab.  This is pretty vital so
 454     # we can determine where filesystems are supposed to be mounted.
 455     eval "\$_ = \$g->cat ('/etc/fstab');";
 456     if (!$@ && $_) {
 457         my @lines = split /\n/;
 458         my @fstab;
 459         foreach (@lines) {
 460             my @fields = split /[ \t]+/;
 461             if (@fields >= 2) {
 462                 my $spec = $fields[0]; # first column (dev/label/uuid)
 463                 my $file = $fields[1]; # second column (mountpoint)
 464                 if ($spec =~ m{^/} ||
 465                     $spec =~ m{^LABEL=} ||
 466                     $spec =~ m{^UUID=} ||
 467                     $file eq "swap") {
 468                     push @fstab, [$spec, $file]
 469                 }
 470             }
 471         }
 472         $r->{fstab} = \@fstab if @fstab;
 473     }
 474 }
 475
 476 # We only support NT.  The control file /boot.ini contains a list of
 477 # Windows installations and their %systemroot%s in a simple text
 478 # format.
 479 #
 480 # XXX We could parse this better.  This won't work if /boot.ini is on
 481 # a different drive from the %systemroot%, and in other unusual cases.
 482
 483 sub check_windows_root
 484 {
 485     local $_;
 486     my $r = shift;
 487
 488     my $boot_ini = resolve_windows_path ("/", "boot.ini");
 489     $r->{boot_ini} = $boot_ini;
 490
 491     if (defined $r->{boot_ini}) {
 492         $_ = $g->cat ($boot_ini);
 493         my @lines = split /\n/;
 494         my $section;
 495         my $systemroot;
 496         foreach (@lines) {
 497             if (m/\[.*\]/) {
 498                 $section = $1;
 499             } elsif (m/^default=.*?\\(\w+)$/i) {
 500                 $systemroot = $1;
 501                 last;
 502             } elsif (m/\\(\w+)=/) {
 503                 $systemroot = $1;
 504                 last;
 505             }
 506         }
 507
 508         if (defined $systemroot) {
 509             $r->{systemroot} = resolve_windows_path ("/", $systemroot);
 510             if (defined $r->{systemroot} && $windows_registry) {
 511                 check_windows_registry ($r, $r->{systemroot});
 512             }
 513         }
 514     }
 515 }
 516
 517 sub check_windows_registry
 518 {
 519     local $_;
 520     my $r = shift;
 521     my $systemroot = shift;
 522
 523     # Download the system registry files.  Only download the
 524     # interesting ones, and we don't bother with user profiles at all.
 525     my $system32 = resolve_windows_path ($systemroot, "system32");
 526     if (defined $system32) {
 527         my $config = resolve_windows_path ($system32, "config");
 528         if (defined $config) {
 529             my $software = resolve_windows_path ($config, "software");
 530             if (defined $software) {
 531                 load_windows_registry ($r, $software,
 532                                        "HKEY_LOCAL_MACHINE\\SOFTWARE");
 533             }
 534             my $system = resolve_windows_path ($config, "system");
 535             if (defined $system) {
 536                 load_windows_registry ($r, $system,
 537                                        "HKEY_LOCAL_MACHINE\\System");
 538             }
 539         }
 540     }
 541 }
 542
 543 sub load_windows_registry
 544 {
 545     local $_;
 546     my $r = shift;
 547     my $regfile = shift;
 548     my $prefix = shift;
 549
 550     my $dir = tempdir (CLEANUP => 1);
 551
 552     $g->download ($regfile, "$dir/reg");
 553
 554     # 'reged' command is particularly noisy.  Redirect stdout and
 555     # stderr to /dev/null temporarily.
 556     open SAVEOUT, ">&STDOUT";
 557     open SAVEERR, ">&STDERR";
 558     open STDOUT, ">/dev/null";
 559     open STDERR, ">/dev/null";
 560
 561     my @cmd = ("reged", "-x", "$dir/reg", "$prefix", "\\", "$dir/out");
 562     my $res = system (@cmd);
 563
 564     close STDOUT;
 565     close STDERR;
 566     open STDOUT, ">&SAVEOUT";
 567     open STDERR, ">&SAVEERR";
 568     close SAVEOUT;
 569     close SAVEERR;
 570
 571     unless ($res == 0) {
 572         warn "reged command failed: $?";
 573         return;
 574     }
 575
 576     # Some versions of reged segfault on inputs.  If that happens we
 577     # may get no / partial output file.  Anyway, if it exists, load
 578     # it.
 579     my $content;
 580     unless (open F, "$dir/out") {
 581         warn "no output from reged command: $!";
 582         return;
 583     }
 584     { local $/ = undef; $content = <F>; }
 585     close F;
 586
 587     my @registry = ();
 588     @registry = @{$r->{registry}} if exists $r->{registry};
 589     push @registry, $content;
 590     $r->{registry} = \@registry;
 591 }
 592
 593 # Because of case sensitivity, the actual path might have a different
 594 # name, and ntfs-3g is always case sensitive.  Find out what the real
 595 # path is.  Returns the correct full path, or undef.
 596 sub resolve_windows_path
 597 {
 598     local $_;
 599     my $parent = shift;         # Must exist, with correct case.
 600     my $dir = shift;
 601
 602     foreach ($g->ls ($parent)) {
 603         if (lc ($_) eq lc ($dir)) {
 604             if ($parent eq "/") {
 605                 return "/$_"
 606             } else {
 607                 return "$parent/$_"
 608             }
 609         }
 610     }
 611
 612     undef;
 613 }
 614
 615 sub check_grub
 616 {
 617     local $_;
 618     my $r = shift;
 619
 620     # Grub version, if we care.
 621 }
 622
 623 #print Dumper (\%fses);
 624
 625 #----------------------------------------------------------------------
 626 # Now find out how many operating systems we've got.  Usually just one.
 627
 628 my %oses = ();
 629
 630 foreach (sort keys %fses) {
 631     if ($fses{$_}->{is_root}) {
 632         my %r = (
 633             root => $fses{$_},
 634             root_device => $_
 635         );
 636         get_os_version (\%r);
 637         assign_mount_points (\%r);
 638         $oses{$_} = \%r;
 639     }
 640 }
 641
 642 sub get_os_version
 643 {
 644     local $_;
 645     my $r = shift;
 646
 647     $r->{os} = $r->{root}->{fsos} if exists $r->{root}->{fsos};
 648     $r->{distro} = $r->{root}->{osdistro} if exists $r->{root}->{osdistro};
 649     $r->{version} = $r->{root}->{osversion} if exists $r->{root}->{osversion};
 650 }
 651
 652 sub assign_mount_points
 653 {
 654     local $_;
 655     my $r = shift;
 656
 657     $r->{mounts} = { "/" => $r->{root_device} };
 658     $r->{filesystems} = { $r->{root_device} => $r->{root} };
 659
 660     # Use /etc/fstab if we have it to mount the rest.
 661     if (exists $r->{root}->{fstab}) {
 662         my @fstab = @{$r->{root}->{fstab}};
 663         foreach (@fstab) {
 664             my ($spec, $file) = @$_;
 665
 666             my ($dev, $fs) = find_filesystem ($spec);
 667             if ($dev) {
 668                 $r->{mounts}->{$file} = $dev;
 669                 $r->{filesystems}->{$dev} = $fs;
 670                 if (exists $fs->{used}) {
 671                     $fs->{used}++
 672                 } else {
 673                     $fs->{used} = 1
 674                 }
 675                 $fs->{spec} = $spec;
 676             }
 677         }
 678     }
 679 }
 680
 681 # Find filesystem by device name, LABEL=.. or UUID=..
 682 sub find_filesystem
 683 {
 684     local $_ = shift;
 685
 686     if (/^LABEL=(.*)/) {
 687         my $label = $1;
 688         foreach (sort keys %fses) {
 689             if (exists $fses{$_}->{label} &&
 690                 $fses{$_}->{label} eq $label) {
 691                 return ($_, $fses{$_});
 692             }
 693         }
 694         warn "unknown filesystem label $label\n";
 695         return ();
 696     } elsif (/^UUID=(.*)/) {
 697         my $uuid = $1;
 698         foreach (sort keys %fses) {
 699             if (exists $fses{$_}->{uuid} &&
 700                 $fses{$_}->{uuid} eq $uuid) {
 701                 return ($_, $fses{$_});
 702             }
 703         }
 704         warn "unknown filesystem UUID $uuid\n";
 705         return ();
 706     } else {
 707         return ($_, $fses{$_}) if exists $fses{$_};
 708
 709         # The following is to handle the case where an fstab entry specifies a
 710         # specific device rather than its label or uuid, and the libguestfs
 711         # appliance has named the device differently due to the use of a
 712         # different driver.
 713         # This will work as long as the underlying drivers recognise devices in
 714         # the same order.
 715         if (m{^/dev/hd(.*)} && exists $fses{"/dev/sd$1"}) {
 716             return ("/dev/sd$1", $fses{"/dev/sd$1"});
 717         }
 718         if (m{^/dev/xvd(.*)} && exists $fses{"/dev/sd$1"}) {
 719             return ("/dev/sd$1", $fses{"/dev/sd$1"});
 720         }
 721
 722         return () if m{/dev/cdrom};
 723
 724         warn "unknown filesystem $_\n";
 725         return ();
 726     }
 727 }
 728
 729 #print Dumper(\%oses);
 730
 731 #----------------------------------------------------------------------
 732 # Mount up the disks so we can check for applications
 733 # and kernels.  Skip this if the output is "*fish" because
 734 # we don't need to know.
 735
 736 if ($output !~ /.*fish$/) {
 737     # Temporary directory for use by check_for_initrd.
 738     my $dir = tempdir (CLEANUP => 1);
 739
 740     my $root_dev;
 741     foreach $root_dev (sort keys %oses) {
 742         my $mounts = $oses{$root_dev}->{mounts};
 743         # Have to mount / first.  Luckily '/' is early in the ASCII
 744         # character set, so this should be OK.
 745         foreach (sort keys %$mounts) {
 746             $g->mount_ro ($mounts->{$_}, $_)
 747                 if $_ ne "swap" && ($_ eq '/' || $g->is_dir ($_));
 748         }
 749
 750         check_for_applications ($root_dev);
 751         check_for_kernels ($root_dev);
 752         if ($oses{$root_dev}->{os} eq "linux") {
 753             check_for_modprobe_aliases ($root_dev);
 754             check_for_initrd ($root_dev, $dir);
 755         }
 756
 757         $g->umount_all ();
 758     }
 759 }
 760
 761 sub check_for_applications
 762 {
 763     local $_;
 764     my $root_dev = shift;
 765
 766     my @apps;
 767
 768     my $os = $oses{$root_dev}->{os};
 769     if ($os eq "linux") {
 770         my $distro = $oses{$root_dev}->{distro};
 771         if (defined $distro && ($distro eq "redhat" || $distro eq "fedora")) {
 772             my @lines = $g->command_lines
 773                 (["rpm",
 774                   "-q", "-a",
 775                   "--qf", "%{name} %{epoch} %{version} %{release} %{arch}\n"]);
 776             foreach (@lines) {
 777                 if (m/^(.*) (.*) (.*) (.*) (.*)$/) {
 778                     my $epoch = $2;
 779                     $epoch = "" if $epoch eq "(none)";
 780                     my $app = {
 781                         name => $1,
 782                         epoch => $epoch,
 783                         version => $3,
 784                         release => $4,
 785                         arch => $5
 786                     };
 787                     push @apps, $app
 788                 }
 789             }
 790         }
 791     } elsif ($os eq "windows") {
 792         # XXX
 793         # I worked out a general plan for this, but haven't
 794         # implemented it yet.  We can iterate over /Program Files
 795         # looking for *.EXE files, which we download, then use
 796         # i686-pc-mingw32-windres on, to find the VERSIONINFO
 797         # section, which has a lot of useful information.
 798     }
 799
 800     $oses{$root_dev}->{apps} = \@apps;
 801 }
 802
 803 sub check_for_kernels
 804 {
 805     local $_;
 806     my $root_dev = shift;
 807
 808     my @kernels;
 809
 810     my $os = $oses{$root_dev}->{os};
 811     if ($os eq "linux") {
 812         # Installed kernels will have a corresponding /lib/modules/<version>
 813         # directory, which is the easiest way to find out what kernels
 814         # are installed, and what modules are available.
 815         foreach ($g->ls ("/lib/modules")) {
 816             if ($g->is_dir ("/lib/modules/$_")) {
 817                 my %kernel;
 818                 $kernel{version} = $_;
 819
 820                 # List modules.
 821                 my @modules;
 822                 foreach ($g->find ("/lib/modules/$_")) {
 823                     if (m,/([^/]+)\.ko$, || m,([^/]+)\.o$,) {
 824                         push @modules, $1;
 825                     }
 826                 }
 827
 828                 $kernel{modules} = \@modules;
 829
 830                 push @kernels, \%kernel;
 831             }
 832         }
 833
 834     } elsif ($os eq "windows") {
 835         # XXX
 836     }
 837
 838     $oses{$root_dev}->{kernels} = \@kernels;
 839 }
 840
 841 # Check /etc/modprobe.conf to see if there are any specified
 842 # drivers associated with network (ethX) or hard drives.  Normally
 843 # one might find something like:
 844 #
 845 #  alias eth0 xennet
 846 #  alias scsi_hostadapter xenblk
 847 #
 848 # XXX This doesn't look beyond /etc/modprobe.conf, eg. in /etc/modprobe.d/
 849
 850 sub check_for_modprobe_aliases
 851 {
 852     local $_;
 853     my $root_dev = shift;
 854
 855     # Initialise augeas
 856     my $success = 0;
 857     $success = $g->aug_init("/", 16);
 858
 859     # Register /etc/modules.conf and /etc/conf.modules to the Modprobe lens
 860     my @results;
 861     @results = $g->aug_match("/augeas/load/Modprobe/incl");
 862
 863     # Calculate the next index of /augeas/load/Modprobe/incl
 864     my $i = 1;
 865     foreach ( @results ) {
 866         next unless m{/augeas/load/Modprobe/incl\[(\d*)]};
 867         $i = $1 + 1 if ($1 == $i);
 868     }
 869
 870     $success = $g->aug_set("/augeas/load/Modprobe/incl[$i]",
 871                            "/etc/modules.conf");
 872     $i++;
 873     $success = $g->aug_set("/augeas/load/Modprobe/incl[$i]",
 874                                   "/etc/conf.modules");
 875
 876     # Make augeas reload
 877     $success = $g->aug_load();
 878
 879     my %modprobe_aliases;
 880
 881     for my $pattern qw(/files/etc/conf.modules/alias
 882                        /files/etc/modules.conf/alias
 883                        /files/etc/modprobe.conf/alias
 884                        /files/etc/modprobe.d/*/alias) {
 885         @results = $g->aug_match($pattern);
 886
 887         for my $path ( @results ) {
 888             $path =~ m{^/files(.*)/alias(?:\[\d*\])?$}
 889                 or die("$path doesn't match augeas pattern");
 890             my $file = $1;
 891
 892             my $alias;
 893             $alias = $g->aug_get($path);
 894
 895             my $modulename;
 896             $modulename = $g->aug_get($path.'/modulename');
 897
 898             my %aliasinfo;
 899             $aliasinfo{modulename} = $modulename;
 900             $aliasinfo{augeas} = $path;
 901             $aliasinfo{file} = $file;
 902
 903             $modprobe_aliases{$alias} = \%aliasinfo;
 904         }
 905     }
 906
 907     $oses{$root_dev}->{modprobe_aliases} = \%modprobe_aliases;
 908 }
 909
 910 # Get a listing of device drivers in any initrd corresponding to a
 911 # kernel.  This is an indication of what can possibly be booted.
 912
 913 sub check_for_initrd
 914 {
 915     local $_;
 916     my $root_dev = shift;
 917     my $dir = shift;
 918
 919     my %initrd_modules;
 920
 921     foreach my $initrd ($g->ls ("/boot")) {
 922         if ($initrd =~ m/^initrd-(.*)\.img$/ && $g->is_file ("/boot/$initrd")) {
 923             my $version = $1;
 924             my @modules = ();
 925             # We have to download these to a temporary file.
 926             $g->download ("/boot/$initrd", "$dir/initrd");
 927
 928             my $cmd = "zcat $dir/initrd | file -";
 929             open P, "$cmd |" or die "$cmd: $!";
 930             my $lines;
 931             { local $/ = undef; $lines = <P>; }
 932             close P;
 933             if ($lines =~ /ext\d filesystem data/) {
 934                 # Before initramfs came along, these were compressed
 935                 # ext2 filesystems.  We could run another libguestfs
 936                 # instance to unpack these, but punt on them for now. (XXX)
 937                 warn "initrd image is unsupported ext2/3/4 filesystem\n";
 938             }
 939             elsif ($lines =~ /cpio/) {
 940                 my $cmd = "zcat $dir/initrd | cpio --quiet -it";
 941                 open P, "$cmd |" or die "$cmd: $!";
 942                 while (<P>) {
 943                     push @modules, $1
 944                         if m,([^/]+)\.ko$, || m,([^/]+)\.o$,;
 945                 }
 946                 close P;
 947                 unlink "$dir/initrd";
 948                 $initrd_modules{$version} = \@modules;
 949             }
 950             else {
 951                 # What?
 952                 warn "unrecognized initrd image: $lines\n";
 953             }
 954         }
 955     }
 956
 957     $oses{$root_dev}->{initrd_modules} = \%initrd_modules;
 958 }
 959
 960 #----------------------------------------------------------------------
 961 # Output.
 962
 963 if ($output eq "fish" || $output eq "ro-fish") {
 964     my @osdevs = keys %oses;
 965     # This only works if there is a single OS.
 966     die "--fish output is only possible with a single OS\n" if @osdevs != 1;
 967
 968     my $root_dev = $osdevs[0];
 969
 970     if ($output eq "ro-fish") {
 971         print "--ro ";
 972     }
 973
 974     print "-a $_ " foreach @images;
 975
 976     my $mounts = $oses{$root_dev}->{mounts};
 977     # Have to mount / first.  Luckily '/' is early in the ASCII
 978     # character set, so this should be OK.
 979     foreach (sort keys %$mounts) {
 980         print "-m $mounts->{$_}:$_ " if $_ ne "swap";
 981     }
 982     print "\n"
 983 }
 984
 985 # Perl output.
 986 elsif ($output eq "perl") {
 987     print Dumper(\%oses);
 988 }
 989
 990 # YAML output
 991 elsif ($output eq "yaml") {
 992     die "virt-inspector: no YAML support\n"
 993         unless exists $INC{"YAML/Any.pm"};
 994
 995     print Dump(\%oses);
 996 }
 997
 998 # Plain text output (the default).
 999 elsif ($output eq "text") {
1000     output_text ();
1001 }
1002
1003 # XML output.
1004 elsif ($output eq "xml") {
1005     output_xml ();
1006 }
1007
1008 # Query mode.
1009 elsif ($output eq "query") {
1010     output_query ();
1011 }
1012
1013 sub output_text
1014 {
1015     output_text_os ($oses{$_}) foreach sort keys %oses;
1016 }
1017
1018 sub output_text_os
1019 {
1020     my $os = shift;
1021
1022     print $os->{os}, " " if exists $os->{os};
1023     print $os->{distro}, " " if exists $os->{distro};
1024     print $os->{version}, " " if exists $os->{version};
1025     print "on ", $os->{root_device}, ":\n";
1026
1027     print "  Mountpoints:\n";
1028     my $mounts = $os->{mounts};
1029     foreach (sort keys %$mounts) {
1030         printf "    %-30s %s\n", $mounts->{$_}, $_
1031     }
1032
1033     print "  Filesystems:\n";
1034     my $filesystems = $os->{filesystems};
1035     foreach (sort keys %$filesystems) {
1036         print "    $_:\n";
1037         print "      label: $filesystems->{$_}{label}\n"
1038             if exists $filesystems->{$_}{label};
1039         print "      UUID: $filesystems->{$_}{uuid}\n"
1040             if exists $filesystems->{$_}{uuid};
1041         print "      type: $filesystems->{$_}{fstype}\n"
1042             if exists $filesystems->{$_}{fstype};
1043         print "      content: $filesystems->{$_}{content}\n"
1044             if exists $filesystems->{$_}{content};
1045     }
1046
1047     if (exists $os->{modprobe_aliases}) {
1048         my %aliases = %{$os->{modprobe_aliases}};
1049         my @keys = sort keys %aliases;
1050         if (@keys) {
1051             print "  Modprobe aliases:\n";
1052             foreach (@keys) {
1053                 printf "    %-30s %s\n", $_, $aliases{$_}->{modulename}
1054             }
1055         }
1056     }
1057
1058     if (exists $os->{initrd_modules}) {
1059         my %modvers = %{$os->{initrd_modules}};
1060         my @keys = sort keys %modvers;
1061         if (@keys) {
1062             print "  Initrd modules:\n";
1063             foreach (@keys) {
1064                 my @modules = @{$modvers{$_}};
1065                 print "    $_:\n";
1066                 print "      $_\n" foreach @modules;
1067             }
1068         }
1069     }
1070
1071     print "  Applications:\n";
1072     my @apps =  @{$os->{apps}};
1073     foreach (@apps) {
1074         print "    $_->{name} $_->{version}\n"
1075     }
1076
1077     print "  Kernels:\n";
1078     my @kernels = @{$os->{kernels}};
1079     foreach (@kernels) {
1080         print "    $_->{version}\n";
1081         my @modules = @{$_->{modules}};
1082         foreach (@modules) {
1083             print "      $_\n";
1084         }
1085     }
1086
1087     if (exists $os->{root}->{registry}) {
1088         print "  Windows Registry entries:\n";
1089         # These are just lumps of text - dump them out.
1090         foreach (@{$os->{root}->{registry}}) {
1091             print "$_\n";
1092         }
1093     }
1094 }
1095
1096 sub output_xml
1097 {
1098     my $xml = new XML::Writer(DATA_MODE => 1, DATA_INDENT => 2);
1099
1100     $xml->startTag("operatingsystems");
1101     output_xml_os ($oses{$_}, $xml) foreach sort keys %oses;
1102     $xml->endTag("operatingsystems");
1103
1104     $xml->end();
1105 }
1106
1107 sub output_xml_os
1108 {
1109     my ($os, $xml) = @_;
1110
1111     $xml->startTag("operatingsystem");
1112
1113     foreach ( [ "name" => "os" ],
1114               [ "distro" => "distro" ],
1115               [ "version" => "version" ],
1116               [ "root" => "root_device" ] ) {
1117         $xml->dataElement($_->[0], $os->{$_->[1]}) if exists $os->{$_->[1]};
1118     }
1119
1120     $xml->startTag("mountpoints");
1121     my $mounts = $os->{mounts};
1122     foreach (sort keys %$mounts) {
1123         $xml->dataElement("mountpoint", $_, "dev" => $mounts->{$_});
1124     }
1125     $xml->endTag("mountpoints");
1126
1127     $xml->startTag("filesystems");
1128     my $filesystems = $os->{filesystems};
1129     foreach (sort keys %$filesystems) {
1130         $xml->startTag("filesystem", "dev" => $_);
1131
1132         foreach my $field ( [ "label" => "label" ],
1133                             [ "uuid" => "uuid" ],
1134                             [ "type" => "fstype" ],
1135                             [ "content" => "content" ],
1136                             [ "spec" => "spec" ] ) {
1137             $xml->dataElement($field->[0], $filesystems->{$_}{$field->[1]})
1138                 if exists $filesystems->{$_}{$field->[1]};
1139         }
1140
1141         $xml->endTag("filesystem");
1142     }
1143     $xml->endTag("filesystems");
1144
1145     if (exists $os->{modprobe_aliases}) {
1146         my %aliases = %{$os->{modprobe_aliases}};
1147         my @keys = sort keys %aliases;
1148         if (@keys) {
1149             $xml->startTag("modprobealiases");
1150             foreach (@keys) {
1151                 $xml->startTag("alias", "device" => $_);
1152
1153                 foreach my $field ( [ "modulename" => "modulename" ],
1154                                     [ "augeas" => "augeas" ],
1155                                     [ "file" => "file" ] ) {
1156                     $xml->dataElement($field->[0], $aliases{$_}->{$field->[1]});
1157                 }
1158
1159                 $xml->endTag("alias");
1160             }
1161             $xml->endTag("modprobealiases");
1162         }
1163     }
1164
1165     if (exists $os->{initrd_modules}) {
1166         my %modvers = %{$os->{initrd_modules}};
1167         my @keys = sort keys %modvers;
1168         if (@keys) {
1169             $xml->startTag("initrds");
1170             foreach (@keys) {
1171                 my @modules = @{$modvers{$_}};
1172                 $xml->startTag("initrd", "version" => $_);
1173                 $xml->dataElement("module", $_) foreach @modules;
1174                 $xml->endTag("initrd");
1175             }
1176             $xml->endTag("initrds");
1177         }
1178     }
1179
1180     $xml->startTag("applications");
1181     my @apps =  @{$os->{apps}};
1182     foreach (@apps) {
1183         $xml->startTag("application");
1184         $xml->dataElement("name", $_->{name});
1185         $xml->dataElement("version", $_->{version});
1186         $xml->endTag("application");
1187     }
1188     $xml->endTag("applications");
1189
1190     $xml->startTag("kernels");
1191     my @kernels = @{$os->{kernels}};
1192     foreach (@kernels) {
1193         $xml->startTag("kernel", "version" => $_->{version});
1194         $xml->startTag("modules");
1195         my @modules = @{$_->{modules}};
1196         foreach (@modules) {
1197             $xml->dataElement("module", $_);
1198         }
1199         $xml->endTag("modules");
1200         $xml->endTag("kernel");
1201     }
1202     $xml->endTag("kernels");
1203
1204     if (exists $os->{root}->{registry}) {
1205         $xml->startTag("windowsregistryentries");
1206         # These are just lumps of text - dump them out.
1207         foreach (@{$os->{root}->{registry}}) {
1208             $xml->dataElement("windowsregistryentry", $_);
1209         }
1210         $xml->endTag("windowsregistryentries");
1211     }
1212
1213     $xml->endTag("operatingsystem");
1214 }
1215
1216 =head1 QUERY MODE
1217
1218 When you use C<virt-inspector --query>, the output is a series of
1219 lines of the form:
1220
1221  windows=no
1222  linux=yes
1223  fullvirt=yes
1224  xen_pv_drivers=no
1225
1226 (each answer is usually C<yes> or C<no>, or the line is completely
1227 missing if we could not determine the answer at all).
1228
1229 If the guest is multiboot, you can get apparently conflicting answers
1230 (eg. C<windows=yes> and C<linux=yes>, or a guest which is both
1231 fullvirt and has a Xen PV kernel).  This is normal, and just means
1232 that the guest can do both things, although it might require operator
1233 intervention such as selecting a boot option when the guest is
1234 booting.
1235
1236 This section describes the full range of answers possible.
1237
1238 =over 4
1239
1240 =cut
1241
1242 sub output_query
1243 {
1244     output_query_windows ();
1245     output_query_linux ();
1246     output_query_rhel ();
1247     output_query_fedora ();
1248     output_query_debian ();
1249     output_query_fullvirt ();
1250     output_query_xen_domU_kernel ();
1251     output_query_xen_pv_drivers ();
1252     output_query_virtio_drivers ();
1253 }
1254
1255 =item windows=(yes|no)
1256
1257 Answer C<yes> if Microsoft Windows is installed in the guest.
1258
1259 =cut
1260
1261 sub output_query_windows
1262 {
1263     my $windows = "no";
1264     foreach my $os (keys %oses) {
1265         $windows="yes" if $oses{$os}->{os} eq "windows";
1266     }
1267     print "windows=$windows\n";
1268 }
1269
1270 =item linux=(yes|no)
1271
1272 Answer C<yes> if a Linux kernel is installed in the guest.
1273
1274 =cut
1275
1276 sub output_query_linux
1277 {
1278     my $linux = "no";
1279     foreach my $os (keys %oses) {
1280         $linux="yes" if $oses{$os}->{os} eq "linux";
1281     }
1282     print "linux=$linux\n";
1283 }
1284
1285 =item rhel=(yes|no)
1286
1287 Answer C<yes> if the guest contains Red Hat Enterprise Linux.
1288
1289 =cut
1290
1291 sub output_query_rhel
1292 {
1293     my $rhel = "no";
1294     foreach my $os (keys %oses) {
1295         $rhel="yes" if $oses{$os}->{os} eq "linux" && $oses{$os}->{distro} eq "redhat";
1296     }
1297     print "rhel=$rhel\n";
1298 }
1299
1300 =item fedora=(yes|no)
1301
1302 Answer C<yes> if the guest contains the Fedora Linux distribution.
1303
1304 =cut
1305
1306 sub output_query_fedora
1307 {
1308     my $fedora = "no";
1309     foreach my $os (keys %oses) {
1310         $fedora="yes" if $oses{$os}->{os} eq "linux" && $oses{$os}->{distro} eq "fedora";
1311     }
1312     print "fedora=$fedora\n";
1313 }
1314
1315 =item debian=(yes|no)
1316
1317 Answer C<yes> if the guest contains the Debian Linux distribution.
1318
1319 =cut
1320
1321 sub output_query_debian
1322 {
1323     my $debian = "no";
1324     foreach my $os (keys %oses) {
1325         $debian="yes" if $oses{$os}->{os} eq "linux" && $oses{$os}->{distro} eq "debian";
1326     }
1327     print "debian=$debian\n";
1328 }
1329
1330 =item fullvirt=(yes|no)
1331
1332 Answer C<yes> if there is at least one operating system kernel
1333 installed in the guest which runs fully virtualized.  Such a guest
1334 would require a hypervisor which supports full system virtualization.
1335
1336 =cut
1337
1338 sub output_query_fullvirt
1339 {
1340     # The assumption is full-virt, unless all installed kernels
1341     # are identified as paravirt.
1342     # XXX Fails on Windows guests.
1343     foreach my $os (keys %oses) {
1344         foreach my $kernel (@{$oses{$os}->{kernels}}) {
1345             my $is_pv = $kernel->{version} =~ m/xen/;
1346             unless ($is_pv) {
1347                 print "fullvirt=yes\n";
1348                 return;
1349             }
1350         }
1351     }
1352     print "fullvirt=no\n";
1353 }
1354
1355 =item xen_domU_kernel=(yes|no)
1356
1357 Answer C<yes> if there is at least one Linux kernel installed in
1358 the guest which is compiled as a Xen DomU (a Xen paravirtualized
1359 guest).
1360
1361 =cut
1362
1363 sub output_query_xen_domU_kernel
1364 {
1365     foreach my $os (keys %oses) {
1366         foreach my $kernel (@{$oses{$os}->{kernels}}) {
1367             my $is_xen = $kernel->{version} =~ m/xen/;
1368             if ($is_xen) {
1369                 print "xen_domU_kernel=yes\n";
1370                 return;
1371             }
1372         }
1373     }
1374     print "xen_domU_kernel=no\n";
1375 }
1376
1377 =item xen_pv_drivers=(yes|no)
1378
1379 Answer C<yes> if the guest has Xen paravirtualized drivers installed
1380 (usually the kernel itself will be fully virtualized, but the PV
1381 drivers have been installed by the administrator for performance
1382 reasons).
1383
1384 =cut
1385
1386 sub output_query_xen_pv_drivers
1387 {
1388     foreach my $os (keys %oses) {
1389         foreach my $kernel (@{$oses{$os}->{kernels}}) {
1390             foreach my $module (@{$kernel->{modules}}) {
1391                 if ($module =~ m/xen-/) {
1392                     print "xen_pv_drivers=yes\n";
1393                     return;
1394                 }
1395             }
1396         }
1397     }
1398     print "xen_pv_drivers=no\n";
1399 }
1400
1401 =item virtio_drivers=(yes|no)
1402
1403 Answer C<yes> if the guest has virtio paravirtualized drivers
1404 installed.  Virtio drivers are commonly used to improve the
1405 performance of KVM.
1406
1407 =cut
1408
1409 sub output_query_virtio_drivers
1410 {
1411     foreach my $os (keys %oses) {
1412         foreach my $kernel (@{$oses{$os}->{kernels}}) {
1413             foreach my $module (@{$kernel->{modules}}) {
1414                 if ($module =~ m/virtio_/) {
1415                     print "virtio_drivers=yes\n";
1416                     return;
1417                 }
1418             }
1419         }
1420     }
1421     print "virtio_drivers=no\n";
1422 }
1423
1424 =back
1425
1426 =head1 SEE ALSO
1427
1428 L<guestfs(3)>,
1429 L<guestfish(1)>,
1430 L<Sys::Guestfs(3)>,
1431 L<Sys::Virt(3)>,
1432 L<http://libguestfs.org/>.
1433
1434 For Windows registry parsing we require the C<reged> program
1435 from L<http://home.eunet.no/~pnordahl/ntpasswd/>.
1436
1437 =head1 AUTHOR
1438
1439 Richard W.M. Jones L<http://et.redhat.com/~rjones/>
1440
1441 =head1 COPYRIGHT
1442
1443 Copyright (C) 2009 Red Hat Inc.
1444
1445 This program is free software; you can redistribute it and/or modify
1446 it under the terms of the GNU General Public License as published by
1447 the Free Software Foundation; either version 2 of the License, or
1448 (at your option) any later version.
1449
1450 This program is distributed in the hope that it will be useful,
1451 but WITHOUT ANY WARRANTY; without even the implied warranty of
1452 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
1453 GNU General Public License for more details.
1454
1455 You should have received a copy of the GNU General Public License
1456 along with this program; if not, write to the Free Software
1457 Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.