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