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<--fish>
 117
 118 =item B<--ro-fish>
 119
 120 Select the output format.  The default is a readable text report.
 121
 122 If you select I<--xml> then you get XML output which can be fed
 123 to other programs.
 124
 125 If you select I<--fish> then we print a L<guestfish(1)> command
 126 line which will automatically mount up the filesystems on the
 127 correct mount points.  Try this for example:
 128
 129  eval `virt-inspector --fish guest.img`
 130
 131 I<--ro-fish> is the same, but the I<--ro> option is passed to
 132 guestfish so that the filesystems are mounted read-only.
 133
 134 =back
 135
 136 =cut
 137
 138 GetOptions ("help|?" => \$help,
 139             "connect|c=s" => \$uri,
 140             "force" => \$force,
 141             "xml" => sub { $output = "xml" },
 142             "fish" => sub { $output = "fish" },
 143             "guestfish" => sub { $output = "fish" },
 144             "ro-fish" => sub { $output = "ro-fish" },
 145             "ro-guestfish" => sub { $output = "ro-fish" })
 146     or pod2usage (2);
 147 pod2usage (1) if $help;
 148 pod2usage ("$0: no image or VM names given") if @ARGV == 0;
 149
 150 # Domain name or guest image(s)?
 151
 152 my @images;
 153 if (-e $ARGV[0]) {
 154     @images = @ARGV;
 155
 156     # Until we get an 'add_drive_ro' call, we must check that qemu
 157     # will only open this image in readonly mode.
 158     # XXX Remove this hack at some point ...  or at least push it
 159     # into libguestfs.
 160
 161     foreach (@images) {
 162         if (! -r $_) {
 163             die "guest image $_ does not exist or is not readable\n"
 164         } elsif (-w $_ && !$force) {
 165             die ("guest image $_ is writable! REFUSING TO PROCEED.\n".
 166                  "You can use --force to override this BUT that action\n".
 167                  "MAY CORRUPT THE DISK IMAGE.\n");
 168         }
 169     }
 170 } else {
 171     die "no libvirt support (install Sys::Virt)"
 172         unless exists $INC{"Sys/Virt.pm"};
 173
 174     pod2usage ("$0: too many domains listed on command line") if @ARGV > 1;
 175
 176     my $vmm;
 177     if (defined $uri) {
 178         $vmm = Sys::Virt->new (uri => $uri, readonly => 1);
 179     } else {
 180         $vmm = Sys::Virt->new (readonly => 1);
 181     }
 182     die "cannot connect to libvirt $uri\n" unless $vmm;
 183
 184     my @doms = $vmm->list_defined_domains ();
 185     my $dom;
 186     foreach (@doms) {
 187         if ($_->get_name () eq $ARGV[0]) {
 188             $dom = $_;
 189             last;
 190         }
 191     }
 192     die "$ARGV[0] is not the name of an inactive libvirt domain\n"
 193         unless $dom;
 194
 195     # Get the names of the image(s).
 196     my $xml = $dom->get_xml_description ();
 197
 198     my $p = new XML::XPath::XMLParser (xml => $xml);
 199     my $disks = $p->find ("//devices/disk");
 200     print "disks:\n";
 201     foreach ($disks->get_nodelist) {
 202         print XML::XPath::XMLParser::as_string($_);
 203     }
 204
 205     die "XXX"
 206 }
 207
 208 # We've now got the list of @images, so feed them to libguestfs.
 209 my $g = Sys::Guestfs->new ();
 210 $g->add_drive ($_) foreach @images;
 211 $g->launch ();
 212 $g->wait_ready ();
 213
 214 # We want to get the list of LVs and partitions (ie. anything that
 215 # could contain a filesystem).  Discard any partitions which are PVs.
 216 my @partitions = $g->list_partitions ();
 217 my @pvs = $g->pvs ();
 218 sub is_pv {
 219     my $t = shift;
 220     foreach (@pvs) {
 221         return 1 if $_ eq $t;
 222     }
 223     0;
 224 }
 225 @partitions = grep { ! is_pv ($_) } @partitions;
 226
 227 my @lvs = $g->lvs ();
 228
 229 =head1 OUTPUT FORMAT
 230
 231  Operating system(s)
 232  -------------------
 233  Linux (distro + version)
 234  Windows (version)
 235     |
 236     |
 237     +--- Filesystems ---------- Installed apps --- Kernel & drivers
 238          -----------            --------------     ----------------
 239          mount point => device  List of apps       Extra information
 240          mount point => device  and versions       about kernel(s)
 241               ...                                  and drivers
 242          swap => swap device
 243          (plus lots of extra information
 244          about each filesystem)
 245
 246 The output of virt-inspector is a complex two-level data structure.
 247
 248 At the top level is a list of the operating systems installed on the
 249 guest.  (For the vast majority of guests, only a single OS is
 250 installed.)  The data returned for the OS includes the name (Linux,
 251 Windows), the distribution and version.
 252
 253 The diagram above shows what we return for each OS.
 254
 255 With the I<--xml> option the output is mapped into an XML document.
 256 Unfortunately there is no clear schema for this document
 257 (contributions welcome) but you can get an idea of the format by
 258 looking at other documents and as a last resort the source for this
 259 program.
 260
 261 With the I<--fish> or I<--ro-fish> option the mount points are mapped to
 262 L<guestfish(1)> command line parameters, so that you can go in
 263 afterwards and inspect the guest with everything mounted in the
 264 right place.  For example:
 265
 266  eval `virt-inspector --ro-fish guest.img`
 267  ==> guestfish --ro -a guest.img -m /dev/VG/LV:/ -m /dev/sda1:/boot
 268
 269 =cut
 270
 271 # List of possible filesystems.
 272 my @devices = sort (@lvs, @partitions);
 273
 274 # Now query each one to build up a picture of what's in it.
 275 my %fses = map { $_ => check_fs ($_) } @devices;
 276
 277 # Now the complex checking code itself.
 278 # check_fs takes a device name (LV or partition name) and returns
 279 # a hashref containing everything we can find out about the device.
 280 sub check_fs {
 281     local $_;
 282     my $dev = shift;            # LV or partition name.
 283
 284     my %r;                      # Result hash.
 285
 286     # First try 'file(1)' on it.
 287     my $file = $g->file ($dev);
 288     if ($file =~ /ext2 filesystem data/) {
 289         $r{fstype} = "ext2";
 290         $r{fsos} = "linux";
 291     } elsif ($file =~ /ext3 filesystem data/) {
 292         $r{fstype} = "ext3";
 293         $r{fsos} = "linux";
 294     } elsif ($file =~ /ext4 filesystem data/) {
 295         $r{fstype} = "ext4";
 296         $r{fsos} = "linux";
 297     } elsif ($file =~ m{Linux/i386 swap file}) {
 298         $r{fstype} = "swap";
 299         $r{fsos} = "linux";
 300         $r{is_swap} = 1;
 301     }
 302
 303     # If it's ext2/3/4, then we want the UUID and label.
 304     if (exists $r{fstype} && $r{fstype} =~ /^ext/) {
 305         $r{uuid} = $g->get_e2uuid ($dev);
 306         $r{label} = $g->get_e2label ($dev);
 307     }
 308
 309     # Try mounting it, fnarrr.
 310     if (!$r{is_swap}) {
 311         $r{is_mountable} = 1;
 312         eval { $g->mount_ro ($dev, "/") };
 313         if ($@) {
 314             # It's not mountable, probably empty or some format
 315             # we don't understand.
 316             $r{is_mountable} = 0;
 317             goto OUT;
 318         }
 319
 320         # Grub /boot?
 321         if ($g->is_file ("/grub/menu.lst") ||
 322             $g->is_file ("/grub/grub.conf")) {
 323             $r{content} = "linux-grub";
 324             check_grub (\%r);
 325             goto OUT;
 326         }
 327
 328         # Linux root?
 329         if ($g->is_dir ("/etc") && $g->is_dir ("/bin") &&
 330             $g->is_file ("/etc/fstab")) {
 331             $r{content} = "linux-root";
 332             $r{is_root} = 1;
 333             check_linux_root (\%r);
 334             goto OUT;
 335         }
 336
 337         # Linux /usr/local.
 338         if ($g->is_dir ("/etc") && $g->is_dir ("/bin") &&
 339             $g->is_dir ("/share") && !$g->exists ("/local") &&
 340             !$g->is_file ("/etc/fstab")) {
 341             $r{content} = "linux-usrlocal";
 342             goto OUT;
 343         }
 344
 345         # Linux /usr.
 346         if ($g->is_dir ("/etc") && $g->is_dir ("/bin") &&
 347             $g->is_dir ("/share") && $g->exists ("/local") &&
 348             !$g->is_file ("/etc/fstab")) {
 349             $r{content} = "linux-usr";
 350             goto OUT;
 351         }
 352
 353         # Windows root?
 354         if ($g->is_file ("/AUTOEXEC.BAT") ||
 355             $g->is_file ("/autoexec.bat") ||
 356             $g->is_dir ("/Program Files") ||
 357             $g->is_dir ("/WINDOWS") ||
 358             $g->is_file ("/ntldr")) {
 359             $r{fstype} = "ntfs"; # XXX this is a guess
 360             $r{fsos} = "windows";
 361             $r{content} = "windows-root";
 362             $r{is_root} = 1;
 363             check_windows_root (\%r);
 364             goto OUT;
 365         }
 366     }
 367
 368   OUT:
 369     $g->umount_all ();
 370     return \%r;
 371 }
 372
 373 sub check_linux_root
 374 {
 375     local $_;
 376     my $r = shift;
 377
 378     # Look into /etc to see if we recognise the operating system.
 379     if ($g->is_file ("/etc/redhat-release")) {
 380         $_ = $g->cat ("/etc/redhat-release");
 381         if (/Fedora release (\d+\.\d+)/) {
 382             $r->{osdistro} = "fedora";
 383             $r->{osversion} = "$1"
 384         } elsif (/(Red Hat Enterprise Linux|CentOS|Scientific Linux).*release (\d+).*Update (\d+)/) {
 385             $r->{osdistro} = "redhat";
 386             $r->{osversion} = "$2.$3";
 387         } elsif (/(Red Hat Enterprise Linux|CentOS|Scientific Linux).*release (\d+(?:\.(\d+))?)/) {
 388             $r->{osdistro} = "redhat";
 389             $r->{osversion} = "$2";
 390         } else {
 391             $r->{osdistro} = "redhat";
 392         }
 393     } elsif ($g->is_file ("/etc/debian_version")) {
 394         $_ = $g->cat ("/etc/debian_version");
 395         if (/(\d+\.\d+)/) {
 396             $r->{osdistro} = "debian";
 397             $r->{osversion} = "$1";
 398         } else {
 399             $r->{osdistro} = "debian";
 400         }
 401     }
 402
 403     # Parse the contents of /etc/fstab.  This is pretty vital so
 404     # we can determine where filesystems are supposed to be mounted.
 405     eval "\$_ = \$g->cat ('/etc/fstab');";
 406     if (!$@ && $_) {
 407         my @lines = split /\n/;
 408         my @fstab;
 409         foreach (@lines) {
 410             my @fields = split /[ \t]+/;
 411             if (@fields >= 2) {
 412                 my $spec = $fields[0]; # first column (dev/label/uuid)
 413                 my $file = $fields[1]; # second column (mountpoint)
 414                 if ($spec =~ m{^/} ||
 415                     $spec =~ m{^LABEL=} ||
 416                     $spec =~ m{^UUID=} ||
 417                     $file eq "swap") {
 418                     push @fstab, [$spec, $file]
 419                 }
 420             }
 421         }
 422         $r->{fstab} = \@fstab if @fstab;
 423     }
 424 }
 425
 426 sub check_windows_root
 427 {
 428     local $_;
 429     my $r = shift;
 430
 431     # XXX Windows version.
 432     # List of applications.
 433 }
 434
 435 sub check_grub
 436 {
 437     local $_;
 438     my $r = shift;
 439
 440     # XXX Kernel versions, grub version.
 441 }
 442
 443 #print Dumper (\%fses);
 444
 445 #----------------------------------------------------------------------
 446 # Now find out how many operating systems we've got.  Usually just one.
 447
 448 my %oses = ();
 449
 450 foreach (sort keys %fses) {
 451     if ($fses{$_}->{is_root}) {
 452         my %r = (
 453             root => $fses{$_},
 454             root_device => $_
 455         );
 456         get_os_version (\%r);
 457         assign_mount_points (\%r);
 458         $oses{$_} = \%r;
 459     }
 460 }
 461
 462 sub get_os_version
 463 {
 464     local $_;
 465     my $r = shift;
 466
 467     $r->{os} = $r->{root}->{fsos} if exists $r->{root}->{fsos};
 468     $r->{distro} = $r->{root}->{osdistro} if exists $r->{root}->{osdistro};
 469     $r->{version} = $r->{root}->{osversion} if exists $r->{root}->{osversion};
 470 }
 471
 472 sub assign_mount_points
 473 {
 474     local $_;
 475     my $r = shift;
 476
 477     $r->{mounts} = { "/" => $r->{root_device} };
 478     $r->{filesystems} = { $r->{root_device} => $r->{root} };
 479
 480     # Use /etc/fstab if we have it to mount the rest.
 481     if (exists $r->{root}->{fstab}) {
 482         my @fstab = @{$r->{root}->{fstab}};
 483         foreach (@fstab) {
 484             my ($spec, $file) = @$_;
 485
 486             my ($dev, $fs) = find_filesystem ($spec);
 487             if ($dev) {
 488                 $r->{mounts}->{$file} = $dev;
 489                 $r->{filesystems}->{$dev} = $fs;
 490                 if (exists $fs->{used}) {
 491                     $fs->{used}++
 492                 } else {
 493                     $fs->{used} = 1
 494                 }
 495             }
 496         }
 497     }
 498 }
 499
 500 # Find filesystem by device name, LABEL=.. or UUID=..
 501 sub find_filesystem
 502 {
 503     local $_ = shift;
 504
 505     if (/^LABEL=(.*)/) {
 506         my $label = $1;
 507         foreach (sort keys %fses) {
 508             if (exists $fses{$_}->{label} &&
 509                 $fses{$_}->{label} eq $label) {
 510                 return ($_, $fses{$_});
 511             }
 512         }
 513         warn "unknown filesystem label $label\n";
 514         return ();
 515     } elsif (/^UUID=(.*)/) {
 516         my $uuid = $1;
 517         foreach (sort keys %fses) {
 518             if (exists $fses{$_}->{uuid} &&
 519                 $fses{$_}->{uuid} eq $uuid) {
 520                 return ($_, $fses{$_});
 521             }
 522         }
 523         warn "unknown filesystem UUID $uuid\n";
 524         return ();
 525     } else {
 526         return ($_, $fses{$_}) if exists $fses{$_};
 527
 528         if (m{^/dev/hd(.*)} && exists $fses{"/dev/sd$1"}) {
 529             return ("/dev/sd$1", $fses{"/dev/sd$1"});
 530         }
 531         if (m{^/dev/xvd(.*)} && exists $fses{"/dev/sd$1"}) {
 532             return ("/dev/sd$1", $fses{"/dev/sd$1"});
 533         }
 534
 535         return () if m{/dev/cdrom};
 536
 537         warn "unknown filesystem $_\n";
 538         return ();
 539     }
 540 }
 541
 542 #print Dumper(\%oses);
 543
 544 #----------------------------------------------------------------------
 545 # Mount up the disks so we can check for applications
 546 # and kernels.  Skip this if the output is "*fish" because
 547 # we don't need to know.
 548
 549 if ($output !~ /.*fish$/) {
 550     my $root_dev;
 551     foreach $root_dev (sort keys %oses) {
 552         my $mounts = $oses{$root_dev}->{mounts};
 553         # Have to mount / first.  Luckily '/' is early in the ASCII
 554         # character set, so this should be OK.
 555         foreach (sort keys %$mounts) {
 556             $g->mount_ro ($mounts->{$_}, $_)
 557                 if $_ ne "swap" && ($_ eq '/' || $g->is_dir ($_));
 558         }
 559
 560         check_for_applications ($root_dev);
 561         check_for_kernels ($root_dev);
 562
 563         umount_all ();
 564     }
 565 }
 566
 567 sub check_for_applications
 568 {
 569     local $_;
 570     my $root_dev = shift;
 571
 572     # XXX rpm -qa, look in Program Files, or whatever
 573 }
 574
 575 sub check_for_kernels
 576 {
 577     local $_;
 578     my $root_dev = shift;
 579
 580     # XXX
 581 }
 582
 583 #----------------------------------------------------------------------
 584 # Output.
 585
 586 if ($output eq "fish" || $output eq "ro-fish") {
 587     my @osdevs = keys %oses;
 588     # This only works if there is a single OS.
 589     die "--fish output is only possible with a single OS\n" if @osdevs != 1;
 590
 591     my $root_dev = $osdevs[0];
 592
 593     print "guestfish";
 594     if ($output eq "ro-fish") {
 595         print " --ro";
 596     }
 597
 598     print " -a $_" foreach @images;
 599
 600     my $mounts = $oses{$root_dev}->{mounts};
 601     # Have to mount / first.  Luckily '/' is early in the ASCII
 602     # character set, so this should be OK.
 603     foreach (sort keys %$mounts) {
 604         print " -m $mounts->{$_}:$_" if $_ ne "swap";
 605     }
 606     print "\n"
 607 }
 608
 609
 610
 611 =head1 SEE ALSO
 612
 613 L<guestfs(3)>,
 614 L<guestfish(1)>,
 615 L<Sys::Guestfs(3)>,
 616 L<Sys::Virt(3)>
 617
 618 =head1 AUTHOR
 619
 620 Richard W.M. Jones L<http://et.redhat.com/~rjones/>
 621
 622 =head1 COPYRIGHT
 623
 624 Copyright (C) 2009 Red Hat Inc.
 625
 626 This program is free software; you can redistribute it and/or modify
 627 it under the terms of the GNU General Public License as published by
 628 the Free Software Foundation; either version 2 of the License, or
 629 (at your option) any later version.
 630
 631 This program is distributed in the hope that it will be useful,
 632 but WITHOUT ANY WARRANTY; without even the implied warranty of
 633 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 634 GNU General Public License for more details.
 635
 636 You should have received a copy of the GNU General Public License
 637 along with this program; if not, write to the Free Software
 638 Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.