Fix umount_all command so it unmounts filesystems in the correct order.
[libguestfs.git] / 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     # XXX rpm -qa, look in Program Files, or whatever
579 }
580
581 sub check_for_kernels
582 {
583     local $_;
584     my $root_dev = shift;
585
586     # XXX
587 }
588
589 #----------------------------------------------------------------------
590 # Output.
591
592 if ($output eq "fish" || $output eq "ro-fish") {
593     my @osdevs = keys %oses;
594     # This only works if there is a single OS.
595     die "--fish output is only possible with a single OS\n" if @osdevs != 1;
596
597     my $root_dev = $osdevs[0];
598
599     print "guestfish";
600     if ($output eq "ro-fish") {
601         print " --ro";
602     }
603
604     print " -a $_" foreach @images;
605
606     my $mounts = $oses{$root_dev}->{mounts};
607     # Have to mount / first.  Luckily '/' is early in the ASCII
608     # character set, so this should be OK.
609     foreach (sort keys %$mounts) {
610         print " -m $mounts->{$_}:$_" if $_ ne "swap";
611     }
612     print "\n"
613 }
614
615 # Perl output.
616 elsif ($output eq "perl") {
617     print Dumper(\%oses);
618 }
619
620 # Plain text output (the default).
621 elsif ($output eq "text") {
622     output_text ();
623 }
624
625 # XML output.
626 elsif ($output eq "xml") {
627     output_xml ();
628 }
629
630 sub output_text
631 {
632     output_text_os ($oses{$_}) foreach sort keys %oses;
633 }
634
635 sub output_text_os
636 {
637     my $os = shift;
638
639     print $os->{os}, " " if exists $os->{os};
640     print $os->{distro}, " " if exists $os->{distro};
641     print $os->{version}, " " if exists $os->{version};
642     print "on ", $os->{root_device}, ":\n";
643
644     print "  Mountpoints:\n";
645     my $mounts = $os->{mounts};
646     foreach (sort keys %$mounts) {
647         printf "    %-30s %s\n", $mounts->{$_}, $_
648     }
649
650     print "  Filesystems:\n";
651     my $filesystems = $os->{filesystems};
652     foreach (sort keys %$filesystems) {
653         print "    $_:\n";
654         print "      label: $filesystems->{$_}{label}\n"
655             if exists $filesystems->{$_}{label};
656         print "      UUID: $filesystems->{$_}{uuid}\n"
657             if exists $filesystems->{$_}{uuid};
658         print "      type: $filesystems->{$_}{fstype}\n"
659             if exists $filesystems->{$_}{fstype};
660         print "      content: $filesystems->{$_}{content}\n"
661             if exists $filesystems->{$_}{content};
662     }
663
664     # XXX Applications.
665     # XXX Kernel.
666 }
667
668 sub output_xml
669 {
670     print "<operatingsystems>\n";
671     output_xml_os ($oses{$_}) foreach sort keys %oses;
672     print "</operatingsystems>\n";
673 }
674
675 sub output_xml_os
676 {
677     my $os = shift;
678
679     print "<operatingsystem>\n";
680
681     print "<os>", $os->{os}, "</os>\n" if exists $os->{os};
682     print "<distro>", $os->{distro}, "</distro>\n" if exists $os->{distro};
683     print "<version>", $os->{version}, "</version>\n" if exists $os->{version};
684     print "<root>", $os->{root_device}, "</root>\n";
685
686     print "<mountpoints>\n";
687     my $mounts = $os->{mounts};
688     foreach (sort keys %$mounts) {
689         printf "<mountpoint dev='%s'>%s</mountpoint>\n",
690           $mounts->{$_}, $_
691     }
692     print "</mountpoints>\n";
693
694     print "<filesystems>\n";
695     my $filesystems = $os->{filesystems};
696     foreach (sort keys %$filesystems) {
697         print "<filesystem dev='$_'>\n";
698         print "<label>$filesystems->{$_}{label}</label>\n"
699             if exists $filesystems->{$_}{label};
700         print "<uuid>$filesystems->{$_}{uuid}</uuid>\n"
701             if exists $filesystems->{$_}{uuid};
702         print "<type>$filesystems->{$_}{fstype}</type>\n"
703             if exists $filesystems->{$_}{fstype};
704         print "<content>$filesystems->{$_}{content}</content>\n"
705             if exists $filesystems->{$_}{content};
706         print "</filesystem>\n";
707     }
708     print "</filesystems>\n";
709
710     # XXX Applications.
711     # XXX Kernel.
712     print "</operatingsystem>\n";
713 }
714
715 =head1 SEE ALSO
716
717 L<guestfs(3)>,
718 L<guestfish(1)>,
719 L<Sys::Guestfs(3)>,
720 L<Sys::Virt(3)>
721
722 =head1 AUTHOR
723
724 Richard W.M. Jones L<http://et.redhat.com/~rjones/>
725
726 =head1 COPYRIGHT
727
728 Copyright (C) 2009 Red Hat Inc.
729
730 This program is free software; you can redistribute it and/or modify
731 it under the terms of the GNU General Public License as published by
732 the Free Software Foundation; either version 2 of the License, or
733 (at your option) any later version.
734
735 This program is distributed in the hope that it will be useful,
736 but WITHOUT ANY WARRANTY; without even the implied warranty of
737 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
738 GNU General Public License for more details.
739
740 You should have received a copy of the GNU General Public License
741 along with this program; if not, write to the Free Software
742 Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.