2 # Copyright (C) 2009 Red Hat Inc.
4 # This library is free software; you can redistribute it and/or
5 # modify it under the terms of the GNU Lesser General Public
6 # License as published by the Free Software Foundation; either
7 # version 2 of the License, or (at your option) any later version.
9 # This library is distributed in the hope that it will be useful,
10 # but WITHOUT ANY WARRANTY; without even the implied warranty of
11 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
12 # Lesser General Public License for more details.
14 # You should have received a copy of the GNU Lesser General Public
15 # License along with this library; if not, write to the Free Software
16 # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
18 package Sys::Guestfs::Lib;
26 use File::Temp qw/tempdir/;
27 use Locale::TextDomain 'libguestfs';
30 eval "use Sys::Virt;";
31 eval "use XML::XPath;";
32 eval "use XML::XPath::XMLParser;";
33 eval "use Win::Hivex;";
39 Sys::Guestfs::Lib - Useful functions for using libguestfs from Perl
43 use Sys::Guestfs::Lib qw(open_guest inspect_all_partitions ...);
45 $g = open_guest ($name);
47 %fses = inspect_all_partitions ($g, \@partitions);
49 (and many more calls - see the rest of this manpage)
53 C<Sys::Guestfs::Lib> is an extra library of useful functions for using
54 the libguestfs API from Perl. It also provides tighter integration
57 The basic libguestfs API is not covered by this manpage. Please refer
58 instead to L<Sys::Guestfs(3)> and L<guestfs(3)>. The libvirt API is
59 also not covered. For that, see L<Sys::Virt(3)>.
61 =head1 BASIC FUNCTIONS
67 use vars qw(@EXPORT_OK @ISA);
70 @EXPORT_OK = qw(open_guest feature_available
71 get_partitions resolve_windows_path
72 inspect_all_partitions inspect_partition
73 inspect_operating_systems mount_operating_system inspect_in_detail
74 inspect_linux_kernel);
78 $g = open_guest ($name);
80 $g = open_guest ($name, rw => 1, ...);
82 $g = open_guest ($name, address => $uri, ...);
84 $g = open_guest ([$img1, $img2, ...], address => $uri, ...);
86 ($g, $conn, $dom, @images) = open_guest ($name);
88 This function opens a libguestfs handle for either the libvirt domain
89 called C<$name>, or the disk image called C<$name>. Any disk images
90 found through libvirt or specified explicitly are attached to the
93 The C<Sys::Guestfs> handle C<$g> is returned, or if there was an error
94 it throws an exception. To catch errors, wrap the call in an eval
97 The first parameter is either a string referring to a libvirt domain
98 or a disk image, or (if a guest has several disk images) an arrayref
99 C<[$img1, $img2, ...]>.
101 The handle is I<read-only> by default. Use the optional parameter
102 C<rw =E<gt> 1> to open a read-write handle. However if you open a
103 read-write handle, this function will refuse to use active libvirt
106 The handle is still in the config state when it is returned, so you
107 have to call C<$g-E<gt>launch ()>.
109 The optional C<address> parameter can be added to specify the libvirt
112 The implicit libvirt handle is closed after this function, I<unless>
113 you call the function in C<wantarray> context, in which case the
114 function returns a tuple of: the open libguestfs handle, the open
115 libvirt handle, and the open libvirt domain handle, and a list of
116 images. (This is useful if you want to do other things like pulling
117 the XML description of the guest). Note that if this is a straight
118 disk image, then C<$conn> and C<$dom> will be C<undef>.
120 If the C<Sys::Virt> module is not available, then libvirt is bypassed,
121 and this function can only open disk images.
123 The optional C<interface> parameter can be used to open devices with
124 C<add_drive{,_ro}_with_if>. See
125 L<Sys::Guestfs/guestfs_add_drive_with_if> for more details.
135 my $rw = $params{rw};
136 my $address = $params{address};
137 my $interface = $params{interface};
140 if (ref ($first) eq "ARRAY") {
142 } elsif (ref ($first) eq "SCALAR") {
145 croak __"open_guest: first parameter must be a string or an arrayref"
152 croak __x("guest image {imagename} does not exist or is not readable",
157 die __"open_guest: no libvirt support (install Sys::Virt, XML::XPath and XML::XPath::XMLParser)"
158 unless exists $INC{"Sys/Virt.pm"} &&
159 exists $INC{"XML/XPath.pm"} &&
160 exists $INC{"XML/XPath/XMLParser.pm"};
162 die __"open_guest: too many domains listed on command line"
165 my @libvirt_args = ();
166 push @libvirt_args, address => $address if defined $address;
168 $conn = Sys::Virt->new (readonly => 1, @libvirt_args);
169 die __"open_guest: cannot connect to libvirt" unless $conn;
171 my @doms = $conn->list_defined_domains ();
172 my $isitinactive = 1;
174 # In the case where we want read-only access to a domain,
175 # allow the user to specify an active domain too.
176 push @doms, $conn->list_domains ();
180 if ($_->get_name () eq $images[0]) {
188 die __x("{imagename} is not the name of an inactive libvirt domain\n",
189 imagename => $images[0]);
191 die __x("{imagename} is not the name of a libvirt domain\n",
192 imagename => $images[0]);
196 # Get the names of the image(s).
197 my $xml = $dom->get_xml_description ();
199 my $p = XML::XPath->new (xml => $xml);
200 my @disks = $p->findnodes ('//devices/disk/source/@dev');
201 push (@disks, $p->findnodes ('//devices/disk/source/@file'));
203 die __x("{imagename} seems to have no disk devices\n",
204 imagename => $images[0])
207 @images = map { $_->getData } @disks;
210 # We've now got the list of @images, so feed them to libguestfs.
211 my $g = Sys::Guestfs->new ();
215 $g->add_drive_with_if ($_, $interface);
221 $g->add_drive_ro_with_if ($_, $interface);
223 $g->add_drive_ro ($_);
228 return wantarray ? ($g, $conn, $dom, @images) : $g
231 =head2 feature_available
233 $bool = feature_available ($g, $feature [, $feature ...]);
235 This function is a useful wrapper around the basic
236 C<$g-E<gt>available> call.
238 C<$g-E<gt>available> tests for availability of a list of features and
239 dies with an error if any is not available.
241 This call tests for the list of features and returns true if all are
242 available, or false otherwise.
244 For a list of features you can test for, see L<guestfs(3)/AVAILABILITY>.
248 sub feature_available {
251 eval { $g->available (\@_); };
255 =head2 get_partitions
257 @partitions = get_partitions ($g);
259 This function takes an open libguestfs handle C<$g> and returns all
260 partitions and logical volumes found on it.
262 What is returned is everything that could contain a filesystem (or
263 swap). Physical volumes are not normally included from the list
264 except if they contain a filesystem directly. Nor are devices which
265 are partitioned (eg. C</dev/sda> would not be returned if C</dev/sda1>
275 # Look to see if any devices directly contain filesystems (RHBZ#590167).
276 my @devices = $g->list_devices ();
277 my @fses_on_device = ();
279 eval { $g->mount_ro ($_, "/"); };
280 push @fses_on_device, $_ unless $@;
284 my @partitions = $g->list_partitions ();
285 my @pvs = $g->pvs ();
286 @partitions = grep { ! _is_pv ($_, @pvs) } @partitions;
289 @lvs = $g->lvs () if feature_available ($g, "lvm2");
291 return sort (@fses_on_device, @lvs, @partitions);
299 return 1 if $_ eq $t;
304 =head2 resolve_windows_path
306 $path = resolve_windows_path ($g, $path);
308 $path = resolve_windows_path ($g, "/windows/system");
309 ==> "/WINDOWS/System"
310 or undef if no path exists
312 This function, which is specific to FAT/NTFS filesystems (ie. Windows
313 guests), lets you look up a case insensitive C<$path> in the
314 filesystem and returns the true, case sensitive path as required by
315 the underlying kernel or NTFS-3g driver.
317 If C<$path> does not exist then this function returns C<undef>.
319 The C<$path> parameter must begin with C</> character and be separated
320 by C</> characters. Do not use C<\>, drive names, etc.
324 sub resolve_windows_path
330 eval { $r = $g->case_sensitive_path ($path); };
334 =head2 file_architecture
336 $arch = file_architecture ($g, $path)
338 The C<file_architecture> function lets you get the architecture for a
339 particular binary or library in the guest. By "architecture" we mean
340 what processor it is compiled for (eg. C<i586> or C<x86_64>).
342 The function works on at least the following types of files:
348 many types of Un*x binary
352 many types of Un*x shared library
356 Windows Win32 and Win64 binaries
360 Windows Win32 and Win64 DLLs
362 Win32 binaries and DLLs return C<i386>.
364 Win64 binaries and DLLs return C<x86_64>.
372 Linux new-style initrd images
376 some non-x86 Linux vmlinuz kernels
380 What it can't do currently:
386 static libraries (libfoo.a)
390 Linux old-style initrd as compressed ext2 filesystem (RHEL 3)
394 x86 Linux vmlinuz kernels
396 x86 vmlinuz images (bzImage format) consist of a mix of 16-, 32- and
397 compressed code, and are horribly hard to unpack. If you want to find
398 the architecture of a kernel, use the architecture of the associated
399 initrd or kernel module(s) instead.
405 sub _elf_arch_to_canonical
409 if ($_ eq "Intel 80386") {
411 } elsif ($_ eq "Intel 80486") {
412 return "i486"; # probably not in the wild
413 } elsif ($_ eq "x86-64") {
415 } elsif ($_ eq "AMD x86-64") {
417 } elsif (/SPARC32/) {
419 } elsif (/SPARC V9/) {
421 } elsif ($_ eq "IA-64") {
423 } elsif (/64.*PowerPC/) {
425 } elsif (/PowerPC/) {
428 warn __x("returning non-canonical architecture type '{arch}'",
434 my @_initrd_binaries = ("nash", "modprobe", "sh", "bash");
436 sub file_architecture
442 # Our basic tool is 'file' ...
443 my $file = $g->file ($path);
445 if ($file =~ /ELF.*(?:executable|shared object|relocatable), (.+?),/) {
446 # ELF executable or shared object. We need to convert
447 # what file(1) prints into the canonical form.
448 return _elf_arch_to_canonical ($1);
449 } elsif ($file =~ /PE32 executable/) {
450 return "i386"; # Win32 executable or DLL
451 } elsif ($file =~ /PE32\+ executable/) {
452 return "x86_64"; # Win64 executable or DLL
455 elsif ($file =~ /cpio archive/) {
456 # Probably an initrd.
458 if ($file =~ /gzip/) {
460 } elsif ($file =~ /bzip2/) {
464 # Download and unpack it to find a binary file.
465 my $dir = tempdir (CLEANUP => 1);
466 $g->download ($path, "$dir/initrd");
468 my $bins = join " ", map { "bin/$_" } @_initrd_binaries;
469 my $cmd = "cd $dir && $zcat initrd | cpio --quiet -id $bins";
470 my $r = system ($cmd);
471 die __x("cpio command failed: {error}", error => $?)
474 foreach my $bin (@_initrd_binaries) {
475 if (-f "$dir/bin/$bin") {
476 $_ = `file $dir/bin/$bin`;
477 if (/ELF.*executable, (.+?),/) {
478 return _elf_arch_to_canonical ($1);
483 die __x("file_architecture: no known binaries found in initrd image: {path}",
487 die __x("file_architecture: unknown architecture: {path}",
491 =head1 OPERATING SYSTEM INSPECTION FUNCTIONS
493 The functions in this section can be used to inspect the operating
494 system(s) available inside a virtual machine image. For example, you
495 can find out if the VM is Linux or Windows, how the partitions are
496 meant to be mounted, and what applications are installed.
498 If you just want a simple command-line interface to this
499 functionality, use the L<virt-inspector(1)> tool. The documentation
500 below covers the case where you want to access this functionality from
503 Once you have the list of partitions (from C<get_partitions>) there
504 are several steps involved:
510 Look at each partition separately and find out what is on it.
512 The information you get back includes whether the partition contains a
513 filesystem or swapspace, what sort of filesystem (eg. ext3, ntfs), and
514 a first pass guess at the content of the filesystem (eg. Linux boot,
517 The result of this step is a C<%fs> hash of information, one hash for
520 See: C<inspect_partition>, C<inspect_all_partitions>
524 Work out the relationship between partitions.
526 In this step we work out how partitions are related to each other. In
527 the case of a single-boot VM, we work out how the partitions are
528 mounted in respect of each other (eg. C</dev/sda1> is mounted as
529 C</boot>). In the case of a multi-boot VM where there are several
530 roots, we may identify several operating system roots, and mountpoints
533 The result of this step is a single hash called C<%oses> which is
534 described in more detail below, but at the top level looks like:
537 '/dev/VG/Root1' => \%os1,
538 '/dev/VG/Root2' => \%os2,
544 '/' => '/dev/VG/Root1',
545 '/boot' => '/dev/sda1',
550 (example shows a multi-boot VM containing two root partitions).
552 See: C<inspect_operating_systems>
558 Previous to this point we've essentially been looking at each
559 partition in isolation. Now we construct a true guest filesystem by
560 mounting up all of the disks. Only once everything is mounted up can
561 we run commands in the OS context to do more detailed inspection.
563 See: C<mount_operating_system>
567 Check for kernels and applications.
569 This step now does more detailed inspection, where we can look for
570 kernels, applications and more installed in the guest.
572 The result of this is an enhanced C<%os> hash.
574 See: C<inspect_in_detail>
580 This library does not contain functions for generating output based on
581 the analysis steps above. Use a command line tool such as
582 L<virt-inspector(1)> to get useful output.
586 =head2 inspect_all_partitions
588 %fses = inspect_all_partitions ($g, \@partitions);
590 This calls C<inspect_partition> for each partition in the list
593 The result is a hash which maps partition name to C<\%fs> hashref.
595 The contents of the C<%fs> hash is explained below.
599 # Turn /dev/vd* and /dev/hd* into canonical device names
600 # (see BLOCK DEVICE NAMING in guestfs(3)).
602 sub _canonical_dev ($)
605 return "/dev/sd$1" if $dev =~ m{^/dev/[vh]d(\w+)};
609 sub inspect_all_partitions
615 return map { _canonical_dev ($_) => inspect_partition ($g, $_) } @parts;
618 =head2 inspect_partition
620 \%fs = inspect_partition ($g, $partition);
622 This function inspects the device named C<$partition> in isolation and
623 tries to determine what it is. It returns information such as whether
624 the partition is formatted, and with what, whether it is mountable,
625 and what it appears to contain (eg. a Windows root, or a Linux /usr).
627 If the Perl module L<Win::Hivex(3)> is installed, then additional
628 information is made available for Windows guests, if we can locate and
629 read their registries.
631 The returned value is a hashref C<\%fs> which may contain the
632 following top-level keys (any key can be missing):
638 Filesystem type, eg. "ext2" or "ntfs"
642 Apparent filesystem OS, eg. "linux" or "windows"
646 If set, the partition is a swap partition.
658 If set, the partition could be mounted by libguestfs.
662 Filesystem content, if we could determine it. One of: "linux-grub",
663 "linux-root", "linux-usrlocal", "linux-usr", "windows-root".
667 (For Linux root partitions only).
668 Operating system distribution. One of: "fedora", "rhel", "centos",
669 "scientific", "debian".
673 (For Linux root partitions only)
674 The package format used by the guest distribution. One of: "rpm", "deb".
676 =item package_management
678 (For Linux root partitions only)
679 The package management tool used by the guest distribution. One of: "rhn",
682 =item os_major_version
684 (For root partitions only).
685 Operating system major version number.
687 =item os_minor_version
689 (For root partitions only).
690 Operating system minor version number.
694 (For Linux root partitions only).
695 The contents of the C</etc/fstab> file.
699 (For Windows root partitions only).
700 The contents of the C</boot.ini> (NTLDR) file.
704 The value is an arrayref, which is a list of Windows registry
705 file contents, in Windows C<.REG> format.
711 sub inspect_partition
715 my $dev = shift; # LV or partition name.
717 my %r; # Result hash.
719 # First try 'file(1)' on it.
720 my $file = $g->file ($dev);
721 if ($file =~ /ext2 filesystem data/) {
724 } elsif ($file =~ /ext3 filesystem data/) {
727 } elsif ($file =~ /ext4 filesystem data/) {
730 } elsif ($file =~ m{Linux/i386 swap file}) {
736 # If it's ext2/3/4, then we want the UUID and label.
737 if (exists $r{fstype} && $r{fstype} =~ /^ext/) {
738 $r{uuid} = $g->get_e2uuid ($dev);
739 $r{label} = $g->get_e2label ($dev);
742 # Try mounting it, fnarrr.
744 $r{is_mountable} = 1;
745 eval { $g->mount_ro ($dev, "/") };
747 # It's not mountable, probably empty or some format
748 # we don't understand.
749 $r{is_mountable} = 0;
754 if ($g->is_file ("/grub/menu.lst") ||
755 $g->is_file ("/grub/grub.conf")) {
756 $r{content} = "linux-grub";
757 _check_grub ($g, \%r);
762 if ($g->is_dir ("/etc") && $g->is_dir ("/bin") &&
763 $g->is_file ("/etc/fstab")) {
764 $r{content} = "linux-root";
766 _check_linux_root ($g, \%r);
771 if ($g->is_dir ("/etc") && $g->is_dir ("/bin") &&
772 $g->is_dir ("/share") && !$g->exists ("/local") &&
773 !$g->is_file ("/etc/fstab")) {
774 $r{content} = "linux-usrlocal";
779 if ($g->is_dir ("/etc") && $g->is_dir ("/bin") &&
780 $g->is_dir ("/share") && $g->exists ("/local") &&
781 !$g->is_file ("/etc/fstab")) {
782 $r{content} = "linux-usr";
787 if ($g->is_file ("/AUTOEXEC.BAT") ||
788 $g->is_file ("/autoexec.bat") ||
789 $g->is_dir ("/Program Files") ||
790 $g->is_dir ("/WINDOWS") ||
791 $g->is_file ("/boot.ini") ||
792 $g->is_file ("/ntldr")) {
793 $r{fstype} = "ntfs"; # XXX this is a guess
794 $r{fsos} = "windows";
795 $r{content} = "windows-root";
797 _check_windows_root ($g, \%r);
807 sub _check_linux_root
813 # Look into /etc to see if we recognise the operating system.
814 # N.B. don't use $g->is_file here, because it might be a symlink
815 if ($g->exists ("/etc/redhat-release")) {
816 $r->{package_format} = "rpm";
818 $_ = $g->cat ("/etc/redhat-release");
819 if (/Fedora release (\d+)(?:\.(\d+))?/) {
820 chomp; $r->{product_name} = $_;
821 $r->{osdistro} = "fedora";
822 $r->{os_major_version} = "$1";
823 $r->{os_minor_version} = "$2" if(defined($2));
824 $r->{package_management} = "yum";
827 elsif (/(Red Hat Enterprise Linux|CentOS|Scientific Linux)/) {
828 chomp; $r->{product_name} = $_;
832 if($distro eq "Red Hat Enterprise Linux") {
833 $r->{osdistro} = "rhel";
836 elsif($distro eq "CentOS") {
837 $r->{osdistro} = "centos";
838 $r->{package_management} = "yum";
841 elsif($distro eq "Scientific Linux") {
842 $r->{osdistro} = "scientific";
843 $r->{package_management} = "yum";
846 # Shouldn't be possible
849 if (/$distro.*release (\d+).*Update (\d+)/) {
850 $r->{os_major_version} = "$1";
851 $r->{os_minor_version} = "$2";
854 elsif (/$distro.*release (\d+)(?:\.(\d+))?/) {
855 $r->{os_major_version} = "$1";
858 $r->{os_minor_version} = "$2";
860 $r->{os_minor_version} = "0";
864 # Package management in RHEL changed in version 5
865 if ($r->{osdistro} eq "rhel") {
866 if ($r->{os_major_version} >= 5) {
867 $r->{package_management} = "yum";
869 $r->{package_management} = "rhn";
875 $r->{osdistro} = "redhat-based";
877 } elsif ($g->is_file ("/etc/debian_version")) {
878 $r->{package_format} = "deb";
879 $r->{package_management} = "apt";
881 $_ = $g->cat ("/etc/debian_version");
882 if (/(\d+)\.(\d+)/) {
883 chomp; $r->{product_name} = $_;
884 $r->{osdistro} = "debian";
885 $r->{os_major_version} = "$1";
886 $r->{os_minor_version} = "$2";
888 $r->{osdistro} = "debian";
892 # Parse the contents of /etc/fstab. This is pretty vital so
893 # we can determine where filesystems are supposed to be mounted.
894 eval "\$_ = \$g->cat ('/etc/fstab');";
896 my @lines = split /\n/;
899 my @fields = split /[ \t]+/;
901 my $spec = $fields[0]; # first column (dev/label/uuid)
902 my $file = $fields[1]; # second column (mountpoint)
903 if ($spec =~ m{^/} ||
904 $spec =~ m{^LABEL=} ||
905 $spec =~ m{^UUID=} ||
907 push @fstab, [$spec, $file]
911 $r->{fstab} = \@fstab if @fstab;
914 # Determine the architecture of this root.
916 foreach ("/bin/bash", "/bin/ls", "/bin/echo", "/bin/rm", "/bin/sh") {
917 if ($g->is_file ($_)) {
918 $arch = file_architecture ($g, $_);
923 $r->{arch} = $arch if defined $arch;
926 # We only support NT. The control file /boot.ini contains a list of
927 # Windows installations and their %systemroot%s in a simple text
930 # XXX We don't handle the case where /boot.ini is on a different
931 # partition very well (Windows Vista and later).
933 sub _check_windows_root
939 my $boot_ini = resolve_windows_path ($g, "/boot.ini");
940 $r->{boot_ini} = $boot_ini;
943 if (defined $r->{boot_ini}) {
944 $_ = $g->cat ($boot_ini);
945 my @lines = split /\n/;
950 } elsif (m/^default=.*?\\(\w+)$/i) {
953 } elsif (m/\\(\w+)=/) {
960 if (!defined $systemroot) {
961 # Last ditch ... try to guess %systemroot% location.
962 foreach ("windows", "winnt") {
963 my $dir = resolve_windows_path ($g, "/$_/system32");
971 if (defined $systemroot) {
972 $r->{systemroot} = resolve_windows_path ($g, "/$systemroot");
973 if (defined $r->{systemroot}) {
974 _check_windows_arch ($g, $r, $r->{systemroot});
975 _check_windows_registry ($g, $r, $r->{systemroot});
980 # Find Windows userspace arch.
982 sub _check_windows_arch
987 my $systemroot = shift;
990 resolve_windows_path ($g, $r->{systemroot} . "/system32/cmd.exe");
991 $r->{arch} = file_architecture ($g, $cmd_exe) if $cmd_exe;
994 sub _check_windows_registry
999 my $systemroot = shift;
1001 # Download the system registry files. Only download the
1002 # interesting ones (SOFTWARE and SYSTEM). We don't bother with
1005 return unless exists $INC{"Win/Hivex.pm"};
1007 my $configdir = resolve_windows_path ($g, "$systemroot/system32/config");
1008 return unless defined $configdir;
1010 my $tmpdir = tempdir (CLEANUP => 1);
1012 my $software = resolve_windows_path ($g, "$configdir/software");
1014 if (defined $software) {
1016 $g->download ($software, "$tmpdir/software");
1017 $software_hive = Win::Hivex->open ("$tmpdir/software");
1020 $r->{windows_software_hive} = $software;
1023 my $system = resolve_windows_path ($g, "$configdir/system");
1025 if (defined $system) {
1027 $g->download ($system, "$tmpdir/system");
1028 $system_hive = Win::Hivex->open ("$tmpdir/system");
1031 $r->{windows_system_hive} = $system;
1034 # Get the ProductName, major and minor version, etc.
1035 if (defined $software_hive) {
1038 $cv_node = $software_hive->root;
1039 $cv_node = $software_hive->node_get_child ($cv_node, $_)
1040 foreach ("Microsoft", "Windows NT", "CurrentVersion");
1045 my @values = $software_hive->node_values ($cv_node);
1048 my $k = $software_hive->value_key ($_);
1049 if ($k eq "ProductName") {
1050 $_ = $software_hive->value_string ($_);
1051 $r->{product_name} = $_ if defined $_;
1052 } elsif ($k eq "CurrentVersion") {
1053 $_ = $software_hive->value_string ($_);
1054 if (defined $_ && m/^(\d+)\.(\d+)/) {
1055 $r->{os_major_version} = $1;
1056 $r->{os_minor_version} = $2;
1058 } elsif ($k eq "CurrentBuild") {
1059 $_ = $software_hive->value_string ($_);
1060 $r->{windows_current_build} = $_ if defined $_;
1061 } elsif ($k eq "SoftwareType") {
1062 $_ = $software_hive->value_string ($_);
1063 $r->{windows_software_type} = $_ if defined $_;
1064 } elsif ($k eq "CurrentType") {
1065 $_ = $software_hive->value_string ($_);
1066 $r->{windows_current_type} = $_ if defined $_;
1067 } elsif ($k eq "RegisteredOwner") {
1068 $_ = $software_hive->value_string ($_);
1069 $r->{windows_registered_owner} = $_ if defined $_;
1070 } elsif ($k eq "RegisteredOrganization") {
1071 $_ = $software_hive->value_string ($_);
1072 $r->{windows_registered_organization} = $_ if defined $_;
1073 } elsif ($k eq "InstallationType") {
1074 $_ = $software_hive->value_string ($_);
1075 $r->{windows_installation_type} = $_ if defined $_;
1076 } elsif ($k eq "EditionID") {
1077 $_ = $software_hive->value_string ($_);
1078 $r->{windows_edition_id} = $_ if defined $_;
1079 } elsif ($k eq "ProductID") {
1080 $_ = $software_hive->value_string ($_);
1081 $r->{windows_product_id} = $_ if defined $_;
1094 # Grub version, if we care.
1097 =head2 inspect_operating_systems
1099 \%oses = inspect_operating_systems ($g, \%fses);
1101 This function works out how partitions are related to each other. In
1102 the case of a single-boot VM, we work out how the partitions are
1103 mounted in respect of each other (eg. C</dev/sda1> is mounted as
1104 C</boot>). In the case of a multi-boot VM where there are several
1105 roots, we may identify several operating system roots, and mountpoints
1108 This function returns a hashref C<\%oses> which at the top level looks
1112 '/dev/VG/Root' => \%os,
1115 (There can be multiple roots for a multi-boot VM).
1117 The C<\%os> hash contains the following keys (any can be omitted):
1123 Operating system type, eg. "linux", "windows".
1127 Operating system userspace architecture, eg. "i386", "x86_64".
1131 Operating system distribution, eg. "debian".
1135 Free text product name.
1139 Operating system major version, eg. "4".
1143 Operating system minor version, eg "3".
1147 The value is a reference to the root partition C<%fs> hash.
1151 The value is the name of the root partition (as a string).
1156 The value is a hashref like this:
1159 '/' => '/dev/VG/Root',
1160 '/boot' => '/dev/sda1',
1165 Filesystems (including swap devices and unmounted partitions).
1166 The value is a hashref like this:
1169 '/dev/sda1' => \%fs,
1170 '/dev/VG/Root' => \%fs,
1171 '/dev/VG/Swap' => \%fs,
1178 sub inspect_operating_systems
1186 foreach (sort keys %$fses) {
1187 if ($fses->{$_}->{is_root}) {
1189 root => $fses->{$_},
1192 _get_os_version ($g, \%r);
1193 _assign_mount_points ($g, $fses, \%r);
1207 $r->{os} = $r->{root}->{fsos} if exists $r->{root}->{fsos};
1208 $r->{product_name} = $r->{root}->{product_name}
1209 if exists $r->{root}->{product_name};
1210 $r->{distro} = $r->{root}->{osdistro} if exists $r->{root}->{osdistro};
1211 $r->{major_version} = $r->{root}->{os_major_version}
1212 if exists $r->{root}->{os_major_version};
1213 $r->{minor_version} = $r->{root}->{os_minor_version}
1214 if exists $r->{root}->{os_minor_version};
1215 $r->{package_format} = $r->{root}->{package_format}
1216 if exists $r->{root}->{package_format};
1217 $r->{package_management} = $r->{root}->{package_management}
1218 if exists $r->{root}->{package_management};
1219 $r->{arch} = $r->{root}->{arch} if exists $r->{root}->{arch};
1222 sub _assign_mount_points
1229 $r->{mounts} = { "/" => $r->{root_device} };
1230 $r->{filesystems} = { $r->{root_device} => $r->{root} };
1232 # Use /etc/fstab if we have it to mount the rest.
1233 if (exists $r->{root}->{fstab}) {
1234 my @fstab = @{$r->{root}->{fstab}};
1236 my ($spec, $file) = @$_;
1238 my ($dev, $fs) = _find_filesystem ($g, $fses, $spec);
1240 $r->{mounts}->{$file} = $dev;
1241 $r->{filesystems}->{$dev} = $fs;
1242 if (exists $fs->{used}) {
1247 $fs->{spec} = $spec;
1253 # Find filesystem by device name, LABEL=.. or UUID=..
1254 sub _find_filesystem
1260 if (/^LABEL=(.*)/) {
1262 foreach (sort keys %$fses) {
1263 if (exists $fses->{$_}->{label} &&
1264 $fses->{$_}->{label} eq $label) {
1265 return ($_, $fses->{$_});
1268 warn __x("unknown filesystem label {label}\n", label => $label);
1270 } elsif (/^UUID=(.*)/) {
1272 foreach (sort keys %$fses) {
1273 if (exists $fses->{$_}->{uuid} &&
1274 $fses->{$_}->{uuid} eq $uuid) {
1275 return ($_, $fses->{$_});
1278 warn __x("unknown filesystem UUID {uuid}\n", uuid => $uuid);
1281 return ($_, $fses->{$_}) if exists $fses->{$_};
1283 # The following is to handle the case where an fstab entry specifies a
1284 # specific device rather than its label or uuid, and the libguestfs
1285 # appliance has named the device differently due to the use of a
1287 # This will work as long as the underlying drivers recognise devices in
1289 if (m{^/dev/hd(.*)} && exists $fses->{"/dev/sd$1"}) {
1290 return ("/dev/sd$1", $fses->{"/dev/sd$1"});
1292 if (m{^/dev/xvd(.*)} && exists $fses->{"/dev/sd$1"}) {
1293 return ("/dev/sd$1", $fses->{"/dev/sd$1"});
1295 if (m{^/dev/mapper/(.*)-(.*)$} && exists $fses->{"/dev/$1/$2"}) {
1296 return ("/dev/$1/$2", $fses->{"/dev/$1/$2"});
1299 return () if m{/dev/cdrom};
1301 warn __x("unknown filesystem {fs}\n", fs => $_);
1306 =head2 mount_operating_system
1308 mount_operating_system ($g, \%os, [$ro]);
1310 This function mounts the operating system described in the
1311 C<%os> hash according to the C<mounts> table in that hash (see
1312 C<inspect_operating_systems>).
1314 The partitions are mounted read-only unless the third parameter
1315 is specified as zero explicitly.
1317 To reverse the effect of this call, use the standard
1318 libguestfs API call C<$g-E<gt>umount_all ()>.
1322 sub mount_operating_system
1327 my $ro = shift; # Read-only?
1329 $ro = 1 unless defined $ro; # ro defaults to 1 if unspecified
1331 my $mounts = $os->{mounts};
1333 # Have to mount / first. Luckily '/' is early in the ASCII
1334 # character set, so this should be OK.
1335 foreach (sort keys %$mounts) {
1336 if($_ ne "swap" && $_ ne "none" && ($_ eq '/' || $g->is_dir ($_))) {
1338 $g->mount_ro ($mounts->{$_}, $_)
1340 $g->mount_options ("", $mounts->{$_}, $_)
1346 =head2 inspect_in_detail
1348 mount_operating_system ($g, \%os);
1349 inspect_in_detail ($g, \%os);
1352 The C<inspect_in_detail> function inspects the mounted operating
1353 system for installed applications, installed kernels, kernel modules,
1354 system architecture, and more.
1356 It adds extra keys to the existing C<%os> hash reflecting what it
1357 finds. These extra keys are:
1363 List of applications.
1367 Boot configurations. A hash containing:
1373 An array of boot configurations. Each array entry is a hash containing:
1379 A reference to the expanded initrd structure (see below) for the initrd used by
1380 this boot configuration.
1384 A reference to the expanded kernel structure (see below) for the kernel used by
1385 this boot configuration.
1389 The human readable name of the configuration.
1393 The kernel command line.
1399 The index of the default configuration in the configs array.
1403 The path of the filesystem containing the grub partition.
1411 This is a hash of kernel version =E<gt> a hash with the following keys:
1421 Kernel architecture (eg. C<x86-64>).
1429 The path to the kernel's vmlinuz file.
1433 If the kernel was installed in a package, the name of that package.
1437 =item modprobe_aliases
1440 The contents of the modprobe configuration.
1442 =item initrd_modules
1445 The kernel modules installed in the initrd. The value is
1446 a hashref of kernel version to list of modules.
1452 sub inspect_in_detail
1458 _check_for_applications ($g, $os);
1459 _check_for_kernels ($g, $os);
1460 if ($os->{os} eq "linux") {
1461 _find_modprobe_aliases ($g, $os);
1465 sub _check_for_applications
1473 my $osn = $os->{os};
1474 if ($osn eq "linux") {
1475 my $package_format = $os->{package_format};
1476 if (defined $package_format && $package_format eq "rpm") {
1479 @lines = $g->command_lines
1482 "%{name} %{epoch} %{version} %{release} %{arch}\n"]);
1485 warn(__x("Error running rpm -qa: {error}", error => $@)) if ($@);
1487 @lines = sort @lines;
1489 if (m/^(.*) (.*) (.*) (.*) (.*)$/) {
1491 undef $epoch if $epoch eq "(none)";
1502 } elsif (defined $package_format && $package_format eq "deb") {
1505 @lines = $g->command_lines
1507 "-f", '${Package} ${Version} ${Architecture} ${Status}\n',
1511 warn(__x("Error running dpkg-query: {error}", error => $@)) if ($@);
1513 @lines = sort @lines;
1515 if (m/^(.*) (.*) (.*) (.*) (.*) (.*)$/) {
1516 if ( $6 eq "installed" ) {
1527 } elsif ($osn eq "windows") {
1529 # I worked out a general plan for this, but haven't
1530 # implemented it yet. We can iterate over /Program Files
1531 # looking for *.EXE files, which we download, then use
1532 # i686-pc-mingw32-windres on, to find the VERSIONINFO
1533 # section, which has a lot of useful information.
1536 $os->{apps} = \@apps;
1539 # Find the path which needs to be prepended to paths in grub.conf to make them
1541 sub _find_grub_prefix
1545 my $fses = $os->{filesystems};
1546 die("filesystems undefined") unless(defined($fses));
1548 # Look for the filesystem which contains grub
1550 foreach my $dev (keys(%$fses)) {
1551 my $fsinfo = $fses->{$dev};
1552 if(exists($fsinfo->{content}) && $fsinfo->{content} eq "linux-grub") {
1558 my $mounts = $os->{mounts};
1559 die("mounts undefined") unless(defined($mounts));
1561 # Find where the filesystem is mounted
1562 if(defined($grubdev)) {
1563 foreach my $mount (keys(%$mounts)) {
1564 if($mounts->{$mount} eq $grubdev) {
1565 return "" if($mount eq '/');
1570 die("$grubdev defined in filesystems, but not in mounts");
1573 # If we didn't find it, look for /boot/grub/menu.lst, then try to work out
1574 # what filesystem it's on. We use menu.lst rather than grub.conf because
1575 # debian only uses menu.lst, and anaconda creates a symlink for it.
1576 die(__"Can't find grub on guest") unless($g->exists('/boot/grub/menu.lst'));
1578 # Look for the most specific mount point in mounts
1579 foreach my $path qw(/boot/grub /boot /) {
1580 if(exists($mounts->{$path})) {
1581 return "" if($path eq '/');
1586 die("Couldn't determine which filesystem holds /boot/grub/menu.lst");
1589 sub _check_for_kernels
1593 if ($os->{os} eq "linux" && feature_available ($g, "augeas")) {
1594 # Iterate over entries in grub.conf, populating $os->{boot}
1595 # For every kernel we find, inspect it and add to $os->{kernels}
1597 my $grub = _find_grub_prefix($g, $os);
1598 my $grub_conf = "/etc/grub.conf";
1600 # Debian and other's have no /etc/grub.conf:
1601 if ( ! -f "$grub_conf" ) {
1602 $grub_conf = "$grub/grub/menu.lst";
1611 # ->{title} = "Fedora (2.6.29.6-213.fc11.i686.PAE)"
1612 # ->{kernel} = \kernel
1613 # ->{cmdline} = "ro root=/dev/mapper/vg_mbooth-lv_root rhgb"
1614 # ->{initrd} = \initrd
1615 # ->{default} = \config
1616 # ->{grub_fs} = "/boot"
1618 $g->aug_init("/", 16);
1621 # Get all configurations from grub
1622 foreach my $bootable
1623 ($g->aug_match("/files/$grub_conf/title"))
1626 $config{title} = $g->aug_get($bootable);
1629 eval { $grub_kernel = $g->aug_get("$bootable/kernel"); };
1631 warn __x("Grub entry {title} has no kernel",
1632 title => $config{title});
1635 # Check we've got a kernel entry
1636 if(defined($grub_kernel)) {
1637 my $path = "$grub$grub_kernel";
1639 # Reconstruct the kernel command line
1641 foreach my $arg ($g->aug_match("$bootable/kernel/*")) {
1642 $arg =~ m{/kernel/([^/]*)$}
1643 or die("Unexpected return from aug_match: $arg");
1647 eval { $value = $g->aug_get($arg); };
1649 if(defined($value)) {
1650 push(@args, "$name=$value");
1655 $config{cmdline} = join(' ', @args) if(scalar(@args) > 0);
1658 if ($g->exists($path)) {
1660 inspect_linux_kernel($g, $path, $os->{package_format});
1662 warn __x("grub refers to {path}, which doesn't exist\n",
1666 # Check the kernel was recognised
1667 if(defined($kernel)) {
1668 # Put this kernel on the top level kernel list
1669 $os->{kernels} ||= [];
1670 push(@{$os->{kernels}}, $kernel);
1672 $config{kernel} = $kernel;
1674 # Look for an initrd entry
1677 $initrd = $g->aug_get("$bootable/initrd");
1682 _inspect_initrd($g, $os, "$grub$initrd",
1683 $kernel->{version});
1685 warn __x("Grub entry {title} does not specify an ".
1686 "initrd", title => $config{title});
1691 push(@configs, \%config);
1695 # Create the top level boot entry
1697 $boot{configs} = \@configs;
1698 $boot{grub_fs} = $grub;
1700 # Add the default configuration
1702 $boot{default} = $g->aug_get("/files/$grub_conf/default");
1705 $os->{boot} = \%boot;
1708 elsif ($os->{os} eq "windows") {
1713 =head2 inspect_linux_kernel
1715 my $kernel_hash = inspect_linux_kernel($g, $vmlinuz_path, $package_format);
1717 inspect_linux_kernel returns a hash describing the target linux kernel. For the
1718 contents of the hash, see the I<kernels> structure described under
1719 L</inspect_in_detail>.
1723 sub inspect_linux_kernel
1725 my ($g, $path, $package_format) = @_;
1729 $kernel{path} = $path;
1731 # If this is a packaged kernel, try to work out the name of the package
1732 # which installed it. This lets us know what to install to replace it with,
1733 # e.g. kernel, kernel-smp, kernel-hugemem, kernel-PAE
1734 if($package_format eq "rpm") {
1736 eval { $package = $g->command(['rpm', '-qf', '--qf',
1737 '%{NAME}', $path]); };
1738 $kernel{package} = $package if defined($package);;
1741 # Try to get the kernel version by running file against it
1743 my $filedesc = $g->file($path);
1744 if($filedesc =~ /^$path: Linux kernel .*\bversion\s+(\S+)\b/) {
1748 # Sometimes file can't work out the kernel version, for example because it's
1749 # a Xen PV kernel. In this case try to guess the version from the filename
1751 if($path =~ m{/boot/vmlinuz-(.*)}) {
1754 # Check /lib/modules/$version exists
1755 if(!$g->is_dir("/lib/modules/$version")) {
1756 warn __x("Didn't find modules directory {modules} for kernel ".
1757 "{path}", modules => "/lib/modules/$version",
1764 warn __x("Couldn't guess kernel version number from path for ".
1765 "kernel {path}", path => $path);
1772 $kernel{version} = $version;
1777 my $prefix = "/lib/modules/$version";
1778 foreach my $module ($g->find ($prefix)) {
1779 if ($module =~ m{/([^/]+)\.(?:ko|o)$}) {
1780 $any_module = "$prefix$module" unless defined $any_module;
1785 $kernel{modules} = \@modules;
1787 # Determine kernel architecture by looking at the arch
1788 # of any kernel module.
1789 $kernel{arch} = file_architecture ($g, $any_module);
1794 # Find all modprobe aliases. Specifically, this looks in the following
1796 # * /etc/conf.modules
1797 # * /etc/modules.conf
1798 # * /etc/modprobe.conf
1799 # * /etc/modprobe.d/*
1801 sub _find_modprobe_aliases
1808 $g->aug_init("/", 16);
1810 # Register additional paths to the Modprobe lens
1811 $g->aug_set("/augeas/load/Modprobe/incl[last()+1]", "/etc/modules.conf");
1812 $g->aug_set("/augeas/load/Modprobe/incl[last()+1]", "/etc/conf.modules");
1814 # Make augeas reload
1817 my %modprobe_aliases;
1819 for my $pattern qw(/files/etc/conf.modules/alias
1820 /files/etc/modules.conf/alias
1821 /files/etc/modprobe.conf/alias
1822 /files/etc/modprobe.d/*/alias) {
1823 for my $path ( $g->aug_match($pattern) ) {
1824 $path =~ m{^/files(.*)/alias(?:\[\d*\])?$}
1825 or die __x("{path} doesn't match augeas pattern",
1830 $alias = $g->aug_get($path);
1833 $modulename = $g->aug_get($path.'/modulename');
1836 $aliasinfo{modulename} = $modulename;
1837 $aliasinfo{augeas} = $path;
1838 $aliasinfo{file} = $file;
1840 $modprobe_aliases{$alias} = \%aliasinfo;
1844 $os->{modprobe_aliases} = \%modprobe_aliases;
1847 # Get a listing of device drivers from an initrd
1850 my ($g, $os, $path, $version) = @_;
1854 # Disregard old-style compressed ext2 files and only work with real
1855 # compressed cpio files, since cpio takes ages to (fail to) process anything
1857 if ($g->exists($path) && $g->file($path) =~ /cpio/) {
1859 @modules = $g->initrd_list ($path);
1862 @modules = grep { m{([^/]+)\.(?:ko|o)$} } @modules;
1864 warn __x("{filename}: could not read initrd format",
1865 filename => "$path");
1869 # Add to the top level initrd_modules entry
1870 $os->{initrd_modules} ||= {};
1871 $os->{initrd_modules}->{$version} = \@modules;
1880 Copyright (C) 2009 Red Hat Inc.
1884 Please see the file COPYING.LIB for the full license.
1888 L<virt-inspector(1)>,
1891 L<http://libguestfs.org/>,
1893 L<http://libvirt.org/>,