Lib.pm: Use 'file' as replacement for 'zfile'.
[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 Sys::Guestfs::Lib qw(open_guest get_partitions resolve_windows_path
24   inspect_all_partitions inspect_partition
25   inspect_operating_systems mount_operating_system inspect_in_detail);
26 use Pod::Usage;
27 use Getopt::Long;
28 use Data::Dumper;
29 use XML::Writer;
30 use Locale::TextDomain 'libguestfs';
31
32 # Optional:
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 $version;
93
94 =item B<--version>
95
96 Display version number and exit.
97
98 =cut
99
100 my $uri;
101
102 =item B<--connect URI> | B<-c URI>
103
104 If using libvirt, connect to the given I<URI>.  If omitted,
105 then we connect to the default libvirt hypervisor.
106
107 Libvirt is only used if you specify a C<domname> on the
108 command line.  If you specify guest block devices directly,
109 then libvirt is not used at all.
110
111 =cut
112
113 my $output = "text";
114
115 =back
116
117 The following options select the output format.  Use only one of them.
118 The default is a readable text report.
119
120 =over 4
121
122 =item B<--text> (default)
123
124 Plain text report.
125
126 =item B<--none>
127
128 Produce no output at all.
129
130 =item B<--xml>
131
132 If you select I<--xml> then you get XML output which can be fed
133 to other programs.
134
135 =item B<--yaml>
136
137 If you select I<--yaml> then you get YAML output which can be fed
138 to other programs.
139
140 =item B<--perl>
141
142 If you select I<--perl> then you get Perl structures output which
143 can be used directly in another Perl program.
144
145 =item B<--fish>
146
147 =item B<--ro-fish>
148
149 If you select I<--fish> then we print a L<guestfish(1)> command
150 line which will automatically mount up the filesystems on the
151 correct mount points.  Try this for example:
152
153  guestfish $(virt-inspector --fish guest.img)
154
155 I<--ro-fish> is the same, but the I<--ro> option is passed to
156 guestfish so that the filesystems are mounted read-only.
157
158 =item B<--query>
159
160 In "query mode" we answer common questions about the guest, such
161 as whether it is fullvirt or needs a Xen hypervisor to run.
162
163 See section I<QUERY MODE> below.
164
165 =cut
166
167 my $windows_registry;
168
169 =item B<--windows-registry>
170
171 If this item is passed, I<and> the guest is Windows, I<and> the
172 external program C<reged> is available (see SEE ALSO section), then we
173 attempt to parse the Windows registry.  This allows much more
174 information to be gathered for Windows guests.
175
176 This is quite an expensive and slow operation, so we don't do it by
177 default.
178
179 =back
180
181 =cut
182
183 GetOptions ("help|?" => \$help,
184             "version" => \$version,
185             "connect|c=s" => \$uri,
186             "text" => sub { $output = "text" },
187             "none" => sub { $output = "none" },
188             "xml" => sub { $output = "xml" },
189             "yaml" => sub { $output = "yaml" },
190             "perl" => sub { $output = "perl" },
191             "fish" => sub { $output = "fish" },
192             "guestfish" => sub { $output = "fish" },
193             "ro-fish" => sub { $output = "ro-fish" },
194             "ro-guestfish" => sub { $output = "ro-fish" },
195             "query" => sub { $output = "query" },
196             "windows-registry" => \$windows_registry,
197     ) or pod2usage (2);
198 pod2usage (1) if $help;
199 if ($version) {
200     my $g = Sys::Guestfs->new ();
201     my %h = $g->version ();
202     print "$h{major}.$h{minor}.$h{release}$h{extra}\n";
203     exit
204 }
205 pod2usage (__"virt-inspector: no image or VM names given") if @ARGV == 0;
206
207 my $rw = 0;
208 $rw = 1 if $output eq "fish";
209 my $g;
210 my @images;
211 if ($uri) {
212     my ($conn, $dom);
213     ($g, $conn, $dom, @images) =
214         open_guest (\@ARGV, rw => $rw, address => $uri);
215 } else {
216     my ($conn, $dom);
217     ($g, $conn, $dom, @images) =
218         open_guest (\@ARGV, rw => $rw);
219 }
220
221 $g->launch ();
222 $g->wait_ready ();
223
224 =head1 OUTPUT FORMAT
225
226  Operating system(s)
227  -------------------
228  Linux (distro + version)
229  Windows (version)
230     |
231     |
232     +--- Filesystems ---------- Installed apps --- Kernel & drivers
233          -----------            --------------     ----------------
234          mount point => device  List of apps       Extra information
235          mount point => device  and versions       about kernel(s)
236               ...                                  and drivers
237          swap => swap device
238          (plus lots of extra information
239          about each filesystem)
240
241 The output of virt-inspector is a complex two-level data structure.
242
243 At the top level is a list of the operating systems installed on the
244 guest.  (For the vast majority of guests, only a single OS is
245 installed.)  The data returned for the OS includes the name (Linux,
246 Windows), the distribution and version.
247
248 The diagram above shows what we return for each OS.
249
250 With the I<--xml> option the output is mapped into an XML document.
251 Unfortunately there is no clear schema for this document
252 (contributions welcome) but you can get an idea of the format by
253 looking at other documents and as a last resort the source for this
254 program.
255
256 With the I<--fish> or I<--ro-fish> option the mount points are mapped to
257 L<guestfish(1)> command line parameters, so that you can go in
258 afterwards and inspect the guest with everything mounted in the
259 right place.  For example:
260
261  guestfish $(virt-inspector --ro-fish guest.img)
262  ==> guestfish --ro -a guest.img -m /dev/VG/LV:/ -m /dev/sda1:/boot
263
264 =cut
265
266 # List of possible filesystems.
267 my @partitions = get_partitions ($g);
268
269 # Now query each one to build up a picture of what's in it.
270 my %fses =
271     inspect_all_partitions ($g, \@partitions,
272       use_windows_registry => $windows_registry);
273
274 #print "fses -----------\n";
275 #print Dumper(\%fses);
276
277 my $oses = inspect_operating_systems ($g, \%fses);
278
279 #print "oses -----------\n";
280 #print Dumper($oses);
281
282 # Mount up the disks so we can check for applications
283 # and kernels.  Skip this if the output is "*fish" because
284 # we don't need to know.
285
286 if ($output !~ /.*fish$/) {
287     my $root_dev;
288     foreach $root_dev (sort keys %$oses) {
289         my $os = $oses->{$root_dev};
290         mount_operating_system ($g, $os);
291         inspect_in_detail ($g, $os);
292         $g->umount_all ();
293     }
294 }
295
296 #----------------------------------------------------------------------
297 # Output.
298
299 if ($output eq "fish" || $output eq "ro-fish") {
300     my @osdevs = keys %$oses;
301     # This only works if there is a single OS.
302     die __"--fish output is only possible with a single OS\n" if @osdevs != 1;
303
304     my $root_dev = $osdevs[0];
305
306     if ($output eq "ro-fish") {
307         print "--ro ";
308     }
309
310     print "-a $_ " foreach @images;
311
312     my $mounts = $oses->{$root_dev}->{mounts};
313     # Have to mount / first.  Luckily '/' is early in the ASCII
314     # character set, so this should be OK.
315     foreach (sort keys %$mounts) {
316         print "-m $mounts->{$_}:$_ " if $_ ne "swap" && $_ ne "none";
317     }
318     print "\n"
319 }
320
321 # Perl output.
322 elsif ($output eq "perl") {
323     print Dumper(%$oses);
324 }
325
326 # YAML output
327 elsif ($output eq "yaml") {
328     die __"virt-inspector: no YAML support\n"
329         unless exists $INC{"YAML/Any.pm"};
330
331     print Dump(%$oses);
332 }
333
334 # Plain text output (the default).
335 elsif ($output eq "text") {
336     output_text ();
337 }
338
339 # XML output.
340 elsif ($output eq "xml") {
341     output_xml ();
342 }
343
344 # Query mode.
345 elsif ($output eq "query") {
346     output_query ();
347 }
348
349 sub output_text
350 {
351     output_text_os ($oses->{$_}) foreach sort keys %$oses;
352 }
353
354 sub output_text_os
355 {
356     my $os = shift;
357
358     print $os->{os}, " " if exists $os->{os};
359     print $os->{distro}, " " if exists $os->{distro};
360     print $os->{major_version} if exists $os->{major_version};
361     print ".", $os->{minor_version} if exists $os->{minor_version};
362     print " ";
363     print "on ", $os->{root_device}, ":\n";
364
365     print __"  Mountpoints:\n";
366     my $mounts = $os->{mounts};
367     foreach (sort keys %$mounts) {
368         printf "    %-30s %s\n", $mounts->{$_}, $_
369     }
370
371     print __"  Filesystems:\n";
372     my $filesystems = $os->{filesystems};
373     foreach (sort keys %$filesystems) {
374         print "    $_:\n";
375         print "      label: $filesystems->{$_}{label}\n"
376             if exists $filesystems->{$_}{label};
377         print "      UUID: $filesystems->{$_}{uuid}\n"
378             if exists $filesystems->{$_}{uuid};
379         print "      type: $filesystems->{$_}{fstype}\n"
380             if exists $filesystems->{$_}{fstype};
381         print "      content: $filesystems->{$_}{content}\n"
382             if exists $filesystems->{$_}{content};
383     }
384
385     if (exists $os->{modprobe_aliases}) {
386         my %aliases = %{$os->{modprobe_aliases}};
387         my @keys = sort keys %aliases;
388         if (@keys) {
389             print __"  Modprobe aliases:\n";
390             foreach (@keys) {
391                 printf "    %-30s %s\n", $_, $aliases{$_}->{modulename}
392             }
393         }
394     }
395
396     if (exists $os->{initrd_modules}) {
397         my %modvers = %{$os->{initrd_modules}};
398         my @keys = sort keys %modvers;
399         if (@keys) {
400             print __"  Initrd modules:\n";
401             foreach (@keys) {
402                 my @modules = @{$modvers{$_}};
403                 print "    $_:\n";
404                 print "      $_\n" foreach @modules;
405             }
406         }
407     }
408
409     print __"  Applications:\n";
410     my @apps =  @{$os->{apps}};
411     foreach (@apps) {
412         print "    $_->{name} $_->{version}\n"
413     }
414
415     print __"  Kernels:\n";
416     my @kernels = @{$os->{kernels}};
417     foreach (@kernels) {
418         print "    $_->{version}\n";
419         my @modules = @{$_->{modules}};
420         foreach (@modules) {
421             print "      $_\n";
422         }
423     }
424
425     if (exists $os->{root}->{registry}) {
426         print __"  Windows Registry entries:\n";
427         # These are just lumps of text - dump them out.
428         foreach (@{$os->{root}->{registry}}) {
429             print "$_\n";
430         }
431     }
432 }
433
434 sub output_xml
435 {
436     my $xml = new XML::Writer(DATA_MODE => 1, DATA_INDENT => 2);
437
438     $xml->startTag("operatingsystems");
439     output_xml_os ($oses->{$_}, $xml) foreach sort keys %$oses;
440     $xml->endTag("operatingsystems");
441
442     $xml->end();
443 }
444
445 sub output_xml_os
446 {
447     my ($os, $xml) = @_;
448
449     $xml->startTag("operatingsystem");
450
451     foreach ( [ "name" => "os" ],
452               [ "distro" => "distro" ],
453               [ "major_version" => "major_version" ],
454               [ "minor_version" => "minor_version" ],
455               [ "package_format" => "package_format" ],
456               [ "package_management" => "package_management" ],
457               [ "root" => "root_device" ] ) {
458         $xml->dataElement($_->[0], $os->{$_->[1]}) if exists $os->{$_->[1]};
459     }
460
461     $xml->startTag("mountpoints");
462     my $mounts = $os->{mounts};
463     foreach (sort keys %$mounts) {
464         $xml->dataElement("mountpoint", $_, "dev" => $mounts->{$_});
465     }
466     $xml->endTag("mountpoints");
467
468     $xml->startTag("filesystems");
469     my $filesystems = $os->{filesystems};
470     foreach (sort keys %$filesystems) {
471         $xml->startTag("filesystem", "dev" => $_);
472
473         foreach my $field ( [ "label" => "label" ],
474                             [ "uuid" => "uuid" ],
475                             [ "type" => "fstype" ],
476                             [ "content" => "content" ],
477                             [ "spec" => "spec" ] ) {
478             $xml->dataElement($field->[0], $filesystems->{$_}{$field->[1]})
479                 if exists $filesystems->{$_}{$field->[1]};
480         }
481
482         $xml->endTag("filesystem");
483     }
484     $xml->endTag("filesystems");
485
486     if (exists $os->{modprobe_aliases}) {
487         my %aliases = %{$os->{modprobe_aliases}};
488         my @keys = sort keys %aliases;
489         if (@keys) {
490             $xml->startTag("modprobealiases");
491             foreach (@keys) {
492                 $xml->startTag("alias", "device" => $_);
493
494                 foreach my $field ( [ "modulename" => "modulename" ],
495                                     [ "augeas" => "augeas" ],
496                                     [ "file" => "file" ] ) {
497                     $xml->dataElement($field->[0], $aliases{$_}->{$field->[1]});
498                 }
499
500                 $xml->endTag("alias");
501             }
502             $xml->endTag("modprobealiases");
503         }
504     }
505
506     if (exists $os->{initrd_modules}) {
507         my %modvers = %{$os->{initrd_modules}};
508         my @keys = sort keys %modvers;
509         if (@keys) {
510             $xml->startTag("initrds");
511             foreach (@keys) {
512                 my @modules = @{$modvers{$_}};
513                 $xml->startTag("initrd", "version" => $_);
514                 $xml->dataElement("module", $_) foreach @modules;
515                 $xml->endTag("initrd");
516             }
517             $xml->endTag("initrds");
518         }
519     }
520
521     $xml->startTag("applications");
522     my @apps =  @{$os->{apps}};
523     foreach (@apps) {
524         $xml->startTag("application");
525         $xml->dataElement("name", $_->{name});
526         $xml->dataElement("version", $_->{version});
527         $xml->endTag("application");
528     }
529     $xml->endTag("applications");
530
531     $xml->startTag("kernels");
532     my @kernels = @{$os->{kernels}};
533     foreach (@kernels) {
534         $xml->startTag("kernel", "version" => $_->{version});
535         $xml->startTag("modules");
536         my @modules = @{$_->{modules}};
537         foreach (@modules) {
538             $xml->dataElement("module", $_);
539         }
540         $xml->endTag("modules");
541         $xml->endTag("kernel");
542     }
543     $xml->endTag("kernels");
544
545     if (exists $os->{root}->{registry}) {
546         $xml->startTag("windowsregistryentries");
547         # These are just lumps of text - dump them out.
548         foreach (@{$os->{root}->{registry}}) {
549             $xml->dataElement("windowsregistryentry", $_);
550         }
551         $xml->endTag("windowsregistryentries");
552     }
553
554     $xml->endTag("operatingsystem");
555 }
556
557 =head1 QUERY MODE
558
559 When you use C<virt-inspector --query>, the output is a series of
560 lines of the form:
561
562  windows=no
563  linux=yes
564  fullvirt=yes
565  xen_pv_drivers=no
566
567 (each answer is usually C<yes> or C<no>, or the line is completely
568 missing if we could not determine the answer at all).
569
570 If the guest is multiboot, you can get apparently conflicting answers
571 (eg. C<windows=yes> and C<linux=yes>, or a guest which is both
572 fullvirt and has a Xen PV kernel).  This is normal, and just means
573 that the guest can do both things, although it might require operator
574 intervention such as selecting a boot option when the guest is
575 booting.
576
577 This section describes the full range of answers possible.
578
579 =over 4
580
581 =cut
582
583 sub output_query
584 {
585     output_query_windows ();
586     output_query_linux ();
587     output_query_rhel ();
588     output_query_fedora ();
589     output_query_debian ();
590     output_query_fullvirt ();
591     output_query_xen_domU_kernel ();
592     output_query_xen_pv_drivers ();
593     output_query_virtio_drivers ();
594 }
595
596 =item windows=(yes|no)
597
598 Answer C<yes> if Microsoft Windows is installed in the guest.
599
600 =cut
601
602 sub output_query_windows
603 {
604     my $windows = "no";
605     foreach my $os (keys %$oses) {
606         $windows="yes" if $oses->{$os}->{os} eq "windows";
607     }
608     print "windows=$windows\n";
609 }
610
611 =item linux=(yes|no)
612
613 Answer C<yes> if a Linux kernel is installed in the guest.
614
615 =cut
616
617 sub output_query_linux
618 {
619     my $linux = "no";
620     foreach my $os (keys %$oses) {
621         $linux="yes" if $oses->{$os}->{os} eq "linux";
622     }
623     print "linux=$linux\n";
624 }
625
626 =item rhel=(yes|no)
627
628 Answer C<yes> if the guest contains Red Hat Enterprise Linux.
629
630 =cut
631
632 sub output_query_rhel
633 {
634     my $rhel = "no";
635     foreach my $os (keys %$oses) {
636         $rhel="yes" if ($oses->{$os}->{os} eq "linux" &&
637                         $oses->{$os}->{distro} eq "rhel");
638     }
639     print "rhel=$rhel\n";
640 }
641
642 =item fedora=(yes|no)
643
644 Answer C<yes> if the guest contains the Fedora Linux distribution.
645
646 =cut
647
648 sub output_query_fedora
649 {
650     my $fedora = "no";
651     foreach my $os (keys %$oses) {
652         $fedora="yes" if $oses->{$os}->{os} eq "linux" && $oses->{$os}->{distro} eq "fedora";
653     }
654     print "fedora=$fedora\n";
655 }
656
657 =item debian=(yes|no)
658
659 Answer C<yes> if the guest contains the Debian Linux distribution.
660
661 =cut
662
663 sub output_query_debian
664 {
665     my $debian = "no";
666     foreach my $os (keys %$oses) {
667         $debian="yes" if $oses->{$os}->{os} eq "linux" && $oses->{$os}->{distro} eq "debian";
668     }
669     print "debian=$debian\n";
670 }
671
672 =item fullvirt=(yes|no)
673
674 Answer C<yes> if there is at least one operating system kernel
675 installed in the guest which runs fully virtualized.  Such a guest
676 would require a hypervisor which supports full system virtualization.
677
678 =cut
679
680 sub output_query_fullvirt
681 {
682     # The assumption is full-virt, unless all installed kernels
683     # are identified as paravirt.
684     # XXX Fails on Windows guests.
685     foreach my $os (keys %$oses) {
686         foreach my $kernel (@{$oses->{$os}->{kernels}}) {
687             my $is_pv = $kernel->{version} =~ m/xen/;
688             unless ($is_pv) {
689                 print "fullvirt=yes\n";
690                 return;
691             }
692         }
693     }
694     print "fullvirt=no\n";
695 }
696
697 =item xen_domU_kernel=(yes|no)
698
699 Answer C<yes> if there is at least one Linux kernel installed in
700 the guest which is compiled as a Xen DomU (a Xen paravirtualized
701 guest).
702
703 =cut
704
705 sub output_query_xen_domU_kernel
706 {
707     foreach my $os (keys %$oses) {
708         foreach my $kernel (@{$oses->{$os}->{kernels}}) {
709             my $is_xen = $kernel->{version} =~ m/xen/;
710             if ($is_xen) {
711                 print "xen_domU_kernel=yes\n";
712                 return;
713             }
714         }
715     }
716     print "xen_domU_kernel=no\n";
717 }
718
719 =item xen_pv_drivers=(yes|no)
720
721 Answer C<yes> if the guest has Xen paravirtualized drivers installed
722 (usually the kernel itself will be fully virtualized, but the PV
723 drivers have been installed by the administrator for performance
724 reasons).
725
726 =cut
727
728 sub output_query_xen_pv_drivers
729 {
730     foreach my $os (keys %$oses) {
731         foreach my $kernel (@{$oses->{$os}->{kernels}}) {
732             foreach my $module (@{$kernel->{modules}}) {
733                 if ($module =~ m/xen-/) {
734                     print "xen_pv_drivers=yes\n";
735                     return;
736                 }
737             }
738         }
739     }
740     print "xen_pv_drivers=no\n";
741 }
742
743 =item virtio_drivers=(yes|no)
744
745 Answer C<yes> if the guest has virtio paravirtualized drivers
746 installed.  Virtio drivers are commonly used to improve the
747 performance of KVM.
748
749 =cut
750
751 sub output_query_virtio_drivers
752 {
753     foreach my $os (keys %$oses) {
754         foreach my $kernel (@{$oses->{$os}->{kernels}}) {
755             foreach my $module (@{$kernel->{modules}}) {
756                 if ($module =~ m/virtio_/) {
757                     print "virtio_drivers=yes\n";
758                     return;
759                 }
760             }
761         }
762     }
763     print "virtio_drivers=no\n";
764 }
765
766 =back
767
768 =head1 SEE ALSO
769
770 L<guestfs(3)>,
771 L<guestfish(1)>,
772 L<Sys::Guestfs(3)>,
773 L<Sys::Guestfs::Lib(3)>,
774 L<Sys::Virt(3)>,
775 L<http://libguestfs.org/>.
776
777 For Windows registry parsing we require the C<reged> program
778 from L<http://home.eunet.no/~pnordahl/ntpasswd/>.
779
780 =head1 AUTHOR
781
782 Richard W.M. Jones L<http://et.redhat.com/~rjones/>
783
784 Matthew Booth L<mbooth@redhat.com>
785
786 =head1 COPYRIGHT
787
788 Copyright (C) 2009 Red Hat Inc.
789
790 This program is free software; you can redistribute it and/or modify
791 it under the terms of the GNU General Public License as published by
792 the Free Software Foundation; either version 2 of the License, or
793 (at your option) any later version.
794
795 This program is distributed in the hope that it will be useful,
796 but WITHOUT ANY WARRANTY; without even the implied warranty of
797 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
798 GNU General Public License for more details.
799
800 You should have received a copy of the GNU General Public License
801 along with this program; if not, write to the Free Software
802 Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.