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;
24 use File::Temp qw/tempdir/;
25 use Locale::TextDomain 'libguestfs';
28 eval "use Sys::Virt;";
29 eval "use XML::XPath;";
30 eval "use XML::XPath::XMLParser;";
36 Sys::Guestfs::Lib - Useful functions for using libguestfs from Perl
40 use Sys::Guestfs::Lib qw(open_guest inspect_all_partitions ...);
42 $g = open_guest ($name);
44 %fses = inspect_all_partitions ($g, \@partitions);
46 (and many more calls - see the rest of this manpage)
50 C<Sys::Guestfs::Lib> is an extra library of useful functions for using
51 the libguestfs API from Perl. It also provides tighter integration
54 The basic libguestfs API is not covered by this manpage. Please refer
55 instead to L<Sys::Guestfs(3)> and L<guestfs(3)>. The libvirt API is
56 also not covered. For that, see L<Sys::Virt(3)>.
58 =head1 BASIC FUNCTIONS
64 use vars qw(@EXPORT_OK @ISA);
67 @EXPORT_OK = qw(open_guest get_partitions resolve_windows_path
68 inspect_all_partitions inspect_partition
69 inspect_operating_systems mount_operating_system inspect_in_detail);
73 $g = open_guest ($name);
75 $g = open_guest ($name, rw => 1, ...);
77 $g = open_guest ($name, address => $uri, ...);
79 $g = open_guest ([$img1, $img2, ...], address => $uri, ...);
81 ($g, $conn, $dom, @images) = open_guest ($name);
83 This function opens a libguestfs handle for either the libvirt domain
84 called C<$name>, or the disk image called C<$name>. Any disk images
85 found through libvirt or specified explicitly are attached to the
88 The C<Sys::Guestfs> handle C<$g> is returned, or if there was an error
89 it throws an exception. To catch errors, wrap the call in an eval
92 The first parameter is either a string referring to a libvirt domain
93 or a disk image, or (if a guest has several disk images) an arrayref
94 C<[$img1, $img2, ...]>.
96 The handle is I<read-only> by default. Use the optional parameter
97 C<rw =E<gt> 1> to open a read-write handle. However if you open a
98 read-write handle, this function will refuse to use active libvirt
101 The handle is still in the config state when it is returned, so you
102 have to call C<$g-E<gt>launch ()> and C<$g-E<gt>wait_ready>.
104 The optional C<address> parameter can be added to specify the libvirt
105 URI. In addition, L<Sys::Virt(3)> lists other parameters which are
106 passed through to C<Sys::Virt-E<gt>new> unchanged.
108 The implicit libvirt handle is closed after this function, I<unless>
109 you call the function in C<wantarray> context, in which case the
110 function returns a tuple of: the open libguestfs handle, the open
111 libvirt handle, and the open libvirt domain handle, and a list of
112 images. (This is useful if you want to do other things like pulling
113 the XML description of the guest). Note that if this is a straight
114 disk image, then C<$conn> and C<$dom> will be C<undef>.
116 If the C<Sys::Virt> module is not available, then libvirt is bypassed,
117 and this function can only open disk images.
127 my $readwrite = $params{rw};
130 if (ref ($first) eq "ARRAY") {
132 } elsif (ref ($first) eq "SCALAR") {
135 die __"open_guest: first parameter must be a string or an arrayref"
142 die __x("guest image {imagename} does not exist or is not readable",
147 die __"open_guest: no libvirt support (install Sys::Virt, XML::XPath and XML::XPath::XMLParser)"
148 unless exists $INC{"Sys/Virt.pm"} &&
149 exists $INC{"XML/XPath.pm"} &&
150 exists $INC{"XML/XPath/XMLParser.pm"};
152 die __"open_guest: too many domains listed on command line"
155 $conn = Sys::Virt->new (readonly => 1, @_);
156 die __"open_guest: cannot connect to libvirt" unless $conn;
158 my @doms = $conn->list_defined_domains ();
159 my $isitinactive = 1;
160 unless ($readwrite) {
161 # In the case where we want read-only access to a domain,
162 # allow the user to specify an active domain too.
163 push @doms, $conn->list_domains ();
167 if ($_->get_name () eq $images[0]) {
175 die __x("{imagename} is not the name of an inactive libvirt domain\n",
176 imagename => $images[0]);
178 die __x("{imagename} is not the name of a libvirt domain\n",
179 imagename => $images[0]);
183 # Get the names of the image(s).
184 my $xml = $dom->get_xml_description ();
186 my $p = XML::XPath->new (xml => $xml);
187 my @disks = $p->findnodes ('//devices/disk/source/@dev');
188 push (@disks, $p->findnodes ('//devices/disk/source/@file'));
190 die __x("{imagename} seems to have no disk devices\n",
191 imagename => $images[0])
194 @images = map { $_->getData } @disks;
197 # We've now got the list of @images, so feed them to libguestfs.
198 my $g = Sys::Guestfs->new ();
203 $g->add_drive_ro ($_);
207 return wantarray ? ($g, $conn, $dom, @images) : $g
210 =head2 get_partitions
212 @partitions = get_partitions ($g);
214 This function takes an open libguestfs handle C<$g> and returns all
215 partitions and logical volumes found on it.
217 What is returned is everything that could contain a filesystem (or
218 swap). Physical volumes are excluded from the list, and so are any
219 devices which are partitioned (eg. C</dev/sda> would not be returned
220 if C</dev/sda1> exists).
228 my @partitions = $g->list_partitions ();
229 my @pvs = $g->pvs ();
230 @partitions = grep { ! _is_pv ($_, @pvs) } @partitions;
232 my @lvs = $g->lvs ();
234 return sort (@lvs, @partitions);
242 return 1 if $_ eq $t;
247 =head2 resolve_windows_path
249 $path = resolve_windows_path ($g, $path);
251 $path = resolve_windows_path ($g, "/windows/system");
252 ==> "/WINDOWS/System"
253 or undef if no path exists
255 This function, which is specific to FAT/NTFS filesystems (ie. Windows
256 guests), lets you look up a case insensitive C<$path> in the
257 filesystem and returns the true, case sensitive path as required by
258 the underlying kernel or NTFS-3g driver.
260 If C<$path> does not exist then this function returns C<undef>.
262 The C<$path> parameter must begin with C</> character and be separated
263 by C</> characters. Do not use C<\>, drive names, etc.
267 sub resolve_windows_path
273 if (substr ($path, 0, 1) ne "/") {
274 warn __"resolve_windows_path: path must start with a / character";
278 my @elems = split (/\//, $path);
281 # Start reconstructing the path at the top.
284 foreach my $dir (@elems) {
286 foreach ($g->ls ($path)) {
287 if (lc ($_) eq lc ($dir)) {
297 return undef unless $found;
303 =head1 OPERATING SYSTEM INSPECTION FUNCTIONS
305 The functions in this section can be used to inspect the operating
306 system(s) available inside a virtual machine image. For example, you
307 can find out if the VM is Linux or Windows, how the partitions are
308 meant to be mounted, and what applications are installed.
310 If you just want a simple command-line interface to this
311 functionality, use the L<virt-inspector(1)> tool. The documentation
312 below covers the case where you want to access this functionality from
315 Once you have the list of partitions (from C<get_partitions>) there
316 are several steps involved:
322 Look at each partition separately and find out what is on it.
324 The information you get back includes whether the partition contains a
325 filesystem or swapspace, what sort of filesystem (eg. ext3, ntfs), and
326 a first pass guess at the content of the filesystem (eg. Linux boot,
329 The result of this step is a C<%fs> hash of information, one hash for
332 See: C<inspect_partition>, C<inspect_all_partitions>
336 Work out the relationship between partitions.
338 In this step we work out how partitions are related to each other. In
339 the case of a single-boot VM, we work out how the partitions are
340 mounted in respect of each other (eg. C</dev/sda1> is mounted as
341 C</boot>). In the case of a multi-boot VM where there are several
342 roots, we may identify several operating system roots, and mountpoints
345 The result of this step is a single hash called C<%oses> which is
346 described in more detail below, but at the top level looks like:
349 '/dev/VG/Root1' => \%os1,
350 '/dev/VG/Root2' => \%os2,
356 '/' => '/dev/VG/Root1',
357 '/boot' => '/dev/sda1',
362 (example shows a multi-boot VM containing two root partitions).
364 See: C<inspect_operating_systems>
370 Previous to this point we've essentially been looking at each
371 partition in isolation. Now we construct a true guest filesystem by
372 mounting up all of the disks. Only once everything is mounted up can
373 we run commands in the OS context to do more detailed inspection.
375 See: C<mount_operating_system>
379 Check for kernels and applications.
381 This step now does more detailed inspection, where we can look for
382 kernels, applications and more installed in the guest.
384 The result of this is an enhanced C<%os> hash.
386 See: C<inspect_in_detail>
392 This library does not contain functions for generating output based on
393 the analysis steps above. Use a command line tool such as
394 L<virt-inspector(1)> to get useful output.
398 =head2 inspect_all_partitions
400 %fses = inspect_all_partitions ($g, \@partitions);
402 %fses = inspect_all_partitions ($g, \@partitions, use_windows_registry => 1);
404 This calls C<inspect_partition> for each partition in the list
407 The result is a hash which maps partition name to C<\%fs> hashref.
409 The contents of the C<%fs> hash and the meaning of the
410 C<use_windows_registry> flag are explained below.
414 sub inspect_all_partitions
420 return map { $_ => inspect_partition ($g, $_, @_) } @parts;
423 =head2 inspect_partition
425 \%fs = inspect_partition ($g, $partition);
427 \%fs = inspect_partition ($g, $partition, use_windows_registry => 1);
429 This function inspects the device named C<$partition> in isolation and
430 tries to determine what it is. It returns information such as whether
431 the partition is formatted, and with what, whether it is mountable,
432 and what it appears to contain (eg. a Windows root, or a Linux /usr).
434 If C<use_windows_registry> is set to 1, then we will try to download
435 and parse the content of the Windows registry (for Windows root
436 devices). However since this is an expensive and error-prone
437 operation, we don't do this by default. It also requires the external
438 program C<reged>, patched to remove numerous crashing bugs in the
441 The returned value is a hashref C<\%fs> which may contain the
442 following top-level keys (any key can be missing):
448 Filesystem type, eg. "ext2" or "ntfs"
452 Apparent filesystem OS, eg. "linux" or "windows"
456 If set, the partition is a swap partition.
468 If set, the partition could be mounted by libguestfs.
472 Filesystem content, if we could determine it. One of: "linux-grub",
473 "linux-root", "linux-usrlocal", "linux-usr", "windows-root".
477 (For Linux root partitions only).
478 Operating system distribution. One of: "fedora", "rhel", "centos",
479 "scientific", "debian".
483 (For Linux root partitions only)
484 The package format used by the guest distribution. One of: "rpm", "dpkg".
486 =item package_management
488 (For Linux root partitions only)
489 The package management tool used by the guest distribution. One of: "rhn",
492 =item os_major_version
494 (For root partitions only).
495 Operating system major version number.
497 =item os_minor_version
499 (For root partitions only).
500 Operating system minor version number.
504 (For Linux root partitions only).
505 The contents of the C</etc/fstab> file.
509 (For Windows root partitions only).
510 The contents of the C</boot.ini> (NTLDR) file.
514 The value is an arrayref, which is a list of Windows registry
515 file contents, in Windows C<.REG> format.
521 sub inspect_partition
525 my $dev = shift; # LV or partition name.
528 my $use_windows_registry = $params{use_windows_registry};
530 my %r; # Result hash.
532 # First try 'file(1)' on it.
533 my $file = $g->file ($dev);
534 if ($file =~ /ext2 filesystem data/) {
537 } elsif ($file =~ /ext3 filesystem data/) {
540 } elsif ($file =~ /ext4 filesystem data/) {
543 } elsif ($file =~ m{Linux/i386 swap file}) {
549 # If it's ext2/3/4, then we want the UUID and label.
550 if (exists $r{fstype} && $r{fstype} =~ /^ext/) {
551 $r{uuid} = $g->get_e2uuid ($dev);
552 $r{label} = $g->get_e2label ($dev);
555 # Try mounting it, fnarrr.
557 $r{is_mountable} = 1;
558 eval { $g->mount_ro ($dev, "/") };
560 # It's not mountable, probably empty or some format
561 # we don't understand.
562 $r{is_mountable} = 0;
567 if ($g->is_file ("/grub/menu.lst") ||
568 $g->is_file ("/grub/grub.conf")) {
569 $r{content} = "linux-grub";
570 _check_grub ($g, \%r);
575 if ($g->is_dir ("/etc") && $g->is_dir ("/bin") &&
576 $g->is_file ("/etc/fstab")) {
577 $r{content} = "linux-root";
579 _check_linux_root ($g, \%r);
584 if ($g->is_dir ("/etc") && $g->is_dir ("/bin") &&
585 $g->is_dir ("/share") && !$g->exists ("/local") &&
586 !$g->is_file ("/etc/fstab")) {
587 $r{content} = "linux-usrlocal";
592 if ($g->is_dir ("/etc") && $g->is_dir ("/bin") &&
593 $g->is_dir ("/share") && $g->exists ("/local") &&
594 !$g->is_file ("/etc/fstab")) {
595 $r{content} = "linux-usr";
600 if ($g->is_file ("/AUTOEXEC.BAT") ||
601 $g->is_file ("/autoexec.bat") ||
602 $g->is_dir ("/Program Files") ||
603 $g->is_dir ("/WINDOWS") ||
604 $g->is_file ("/boot.ini") ||
605 $g->is_file ("/ntldr")) {
606 $r{fstype} = "ntfs"; # XXX this is a guess
607 $r{fsos} = "windows";
608 $r{content} = "windows-root";
610 _check_windows_root ($g, \%r, $use_windows_registry);
620 sub _check_linux_root
626 # Look into /etc to see if we recognise the operating system.
627 # N.B. don't use $g->is_file here, because it might be a symlink
628 if ($g->exists ("/etc/redhat-release")) {
629 $r->{package_format} = "rpm";
631 $_ = $g->cat ("/etc/redhat-release");
632 if (/Fedora release (\d+)(?:\.(\d+))?/) {
633 $r->{osdistro} = "fedora";
634 $r->{os_major_version} = "$1";
635 $r->{os_minor_version} = "$2" if(defined($2));
636 $r->{package_management} = "yum";
639 elsif (/(Red Hat Enterprise Linux|CentOS|Scientific Linux)/) {
642 if($distro eq "Red Hat Enterprise Linux") {
643 $r->{osdistro} = "rhel";
646 elsif($distro eq "CentOS") {
647 $r->{osdistro} = "centos";
648 $r->{package_management} = "yum";
651 elsif($distro eq "Scientific Linux") {
652 $r->{osdistro} = "scientific";
653 $r->{package_management} = "yum";
656 # Shouldn't be possible
659 if (/$distro.*release (\d+).*Update (\d+)/) {
660 $r->{os_major_version} = "$1";
661 $r->{os_minor_version} = "$2";
664 elsif (/$distro.*release (\d+)(?:\.(\d+))?/) {
665 $r->{os_major_version} = "$1";
668 $r->{os_minor_version} = "$2";
670 $r->{os_minor_version} = "0";
674 # Package management in RHEL changed in version 5
675 if ($r->{osdistro} eq "rhel") {
676 if ($r->{os_major_version} >= 5) {
677 $r->{package_management} = "yum";
679 $r->{package_management} = "rhn";
685 $r->{osdistro} = "redhat-based";
687 } elsif ($g->is_file ("/etc/debian_version")) {
688 $r->{package_format} = "dpkg";
689 $r->{package_management} = "apt";
691 $_ = $g->cat ("/etc/debian_version");
692 if (/(\d+)\.(\d+)/) {
693 $r->{osdistro} = "debian";
694 $r->{os_major_version} = "$1";
695 $r->{os_minor_version} = "$2";
697 $r->{osdistro} = "debian";
701 # Parse the contents of /etc/fstab. This is pretty vital so
702 # we can determine where filesystems are supposed to be mounted.
703 eval "\$_ = \$g->cat ('/etc/fstab');";
705 my @lines = split /\n/;
708 my @fields = split /[ \t]+/;
710 my $spec = $fields[0]; # first column (dev/label/uuid)
711 my $file = $fields[1]; # second column (mountpoint)
712 if ($spec =~ m{^/} ||
713 $spec =~ m{^LABEL=} ||
714 $spec =~ m{^UUID=} ||
716 push @fstab, [$spec, $file]
720 $r->{fstab} = \@fstab if @fstab;
724 # We only support NT. The control file /boot.ini contains a list of
725 # Windows installations and their %systemroot%s in a simple text
728 # XXX We could parse this better. This won't work if /boot.ini is on
729 # a different drive from the %systemroot%, and in other unusual cases.
731 sub _check_windows_root
736 my $use_windows_registry = shift;
738 my $boot_ini = resolve_windows_path ($g, "/boot.ini");
739 $r->{boot_ini} = $boot_ini;
741 if (defined $r->{boot_ini}) {
742 $_ = $g->cat ($boot_ini);
743 my @lines = split /\n/;
749 } elsif (m/^default=.*?\\(\w+)$/i) {
752 } elsif (m/\\(\w+)=/) {
758 if (defined $systemroot) {
759 $r->{systemroot} = resolve_windows_path ($g, "/$systemroot");
760 if (defined $r->{systemroot} && $use_windows_registry) {
761 _check_windows_registry ($g, $r, $r->{systemroot});
767 sub _check_windows_registry
772 my $systemroot = shift;
774 # Download the system registry files. Only download the
775 # interesting ones, and we don't bother with user profiles at all.
777 my $configdir = resolve_windows_path ($g, "$systemroot/system32/config");
778 if (defined $configdir) {
779 my $softwaredir = resolve_windows_path ($g, "$configdir/software");
780 if (defined $softwaredir) {
781 _load_windows_registry ($g, $r, $softwaredir,
782 "HKEY_LOCAL_MACHINE\\SOFTWARE");
784 my $systemdir = resolve_windows_path ($g, "$configdir/system");
785 if (defined $systemdir) {
786 _load_windows_registry ($g, $r, $systemdir,
787 "HKEY_LOCAL_MACHINE\\System");
792 sub _load_windows_registry
800 my $dir = tempdir (CLEANUP => 1);
802 $g->download ($regfile, "$dir/reg");
804 # 'reged' command is particularly noisy. Redirect stdout and
805 # stderr to /dev/null temporarily.
806 open SAVEOUT, ">&STDOUT";
807 open SAVEERR, ">&STDERR";
808 open STDOUT, ">/dev/null";
809 open STDERR, ">/dev/null";
811 my @cmd = ("reged", "-x", "$dir/reg", "$prefix", "\\", "$dir/out");
812 my $res = system (@cmd);
816 open STDOUT, ">&SAVEOUT";
817 open STDERR, ">&SAVEERR";
822 warn __x("reged command failed: {errormsg}", errormsg => $?);
826 # Some versions of reged segfault on inputs. If that happens we
827 # may get no / partial output file. Anyway, if it exists, load
830 unless (open F, "$dir/out") {
831 warn __x("no output from reged command: {errormsg}", errormsg => $!);
834 { local $/ = undef; $content = <F>; }
838 @registry = @{$r->{registry}} if exists $r->{registry};
839 push @registry, $content;
840 $r->{registry} = \@registry;
849 # Grub version, if we care.
852 =head2 inspect_operating_systems
854 \%oses = inspect_operating_systems ($g, \%fses);
856 This function works out how partitions are related to each other. In
857 the case of a single-boot VM, we work out how the partitions are
858 mounted in respect of each other (eg. C</dev/sda1> is mounted as
859 C</boot>). In the case of a multi-boot VM where there are several
860 roots, we may identify several operating system roots, and mountpoints
863 This function returns a hashref C<\%oses> which at the top level looks
867 '/dev/VG/Root' => \%os,
870 (There can be multiple roots for a multi-boot VM).
872 The C<\%os> hash contains the following keys (any can be omitted):
878 Operating system type, eg. "linux", "windows".
882 Operating system distribution, eg. "debian".
886 Operating system major version, eg. "4".
890 Operating system minor version, eg "3".
894 The value is a reference to the root partition C<%fs> hash.
898 The value is the name of the root partition (as a string).
903 The value is a hashref like this:
906 '/' => '/dev/VG/Root',
907 '/boot' => '/dev/sda1',
912 Filesystems (including swap devices and unmounted partitions).
913 The value is a hashref like this:
917 '/dev/VG/Root' => \%fs,
918 '/dev/VG/Swap' => \%fs,
925 sub inspect_operating_systems
933 foreach (sort keys %$fses) {
934 if ($fses->{$_}->{is_root}) {
939 _get_os_version ($g, \%r);
940 _assign_mount_points ($g, $fses, \%r);
954 $r->{os} = $r->{root}->{fsos} if exists $r->{root}->{fsos};
955 $r->{distro} = $r->{root}->{osdistro} if exists $r->{root}->{osdistro};
956 $r->{major_version} = $r->{root}->{os_major_version}
957 if exists $r->{root}->{os_major_version};
958 $r->{minor_version} = $r->{root}->{os_minor_version}
959 if exists $r->{root}->{os_minor_version};
960 $r->{package_format} = $r->{root}->{package_format}
961 if exists $r->{root}->{package_format};
962 $r->{package_management} = $r->{root}->{package_management}
963 if exists $r->{root}->{package_management};
966 sub _assign_mount_points
973 $r->{mounts} = { "/" => $r->{root_device} };
974 $r->{filesystems} = { $r->{root_device} => $r->{root} };
976 # Use /etc/fstab if we have it to mount the rest.
977 if (exists $r->{root}->{fstab}) {
978 my @fstab = @{$r->{root}->{fstab}};
980 my ($spec, $file) = @$_;
982 my ($dev, $fs) = _find_filesystem ($g, $fses, $spec);
984 $r->{mounts}->{$file} = $dev;
985 $r->{filesystems}->{$dev} = $fs;
986 if (exists $fs->{used}) {
997 # Find filesystem by device name, LABEL=.. or UUID=..
1004 if (/^LABEL=(.*)/) {
1006 foreach (sort keys %$fses) {
1007 if (exists $fses->{$_}->{label} &&
1008 $fses->{$_}->{label} eq $label) {
1009 return ($_, $fses->{$_});
1012 warn __x("unknown filesystem label {label}\n", label => $label);
1014 } elsif (/^UUID=(.*)/) {
1016 foreach (sort keys %$fses) {
1017 if (exists $fses->{$_}->{uuid} &&
1018 $fses->{$_}->{uuid} eq $uuid) {
1019 return ($_, $fses->{$_});
1022 warn __x("unknown filesystem UUID {uuid}\n", uuid => $uuid);
1025 return ($_, $fses->{$_}) if exists $fses->{$_};
1027 # The following is to handle the case where an fstab entry specifies a
1028 # specific device rather than its label or uuid, and the libguestfs
1029 # appliance has named the device differently due to the use of a
1031 # This will work as long as the underlying drivers recognise devices in
1033 if (m{^/dev/hd(.*)} && exists $fses->{"/dev/sd$1"}) {
1034 return ("/dev/sd$1", $fses->{"/dev/sd$1"});
1036 if (m{^/dev/xvd(.*)} && exists $fses->{"/dev/sd$1"}) {
1037 return ("/dev/sd$1", $fses->{"/dev/sd$1"});
1039 if (m{^/dev/mapper/(.*)-(.*)$} && exists $fses->{"/dev/$1/$2"}) {
1040 return ("/dev/$1/$2", $fses->{"/dev/$1/$2"});
1043 return () if m{/dev/cdrom};
1045 warn __x("unknown filesystem {fs}\n", fs => $_);
1050 =head2 mount_operating_system
1052 mount_operating_system ($g, \%os);
1054 This function mounts the operating system described in the
1055 C<%os> hash according to the C<mounts> table in that hash (see
1056 C<inspect_operating_systems>).
1058 The partitions are mounted read-only.
1060 To reverse the effect of this call, use the standard
1061 libguestfs API call C<$g-E<gt>umount_all ()>.
1065 sub mount_operating_system
1071 my $mounts = $os->{mounts};
1073 # Have to mount / first. Luckily '/' is early in the ASCII
1074 # character set, so this should be OK.
1075 foreach (sort keys %$mounts) {
1076 $g->mount_ro ($mounts->{$_}, $_)
1077 if $_ ne "swap" && $_ ne "none" && ($_ eq '/' || $g->is_dir ($_));
1081 =head2 inspect_in_detail
1083 mount_operating_system ($g, \%os);
1084 inspect_in_detail ($g, \%os);
1087 The C<inspect_in_detail> function inspects the mounted operating
1088 system for installed applications, installed kernels, kernel modules
1091 It adds extra keys to the existing C<%os> hash reflecting what it
1092 finds. These extra keys are:
1098 List of applications.
1104 =item modprobe_aliases
1107 The contents of the modprobe configuration.
1109 =item initrd_modules
1112 The kernel modules installed in the initrd. The value is
1113 a hashref of kernel version to list of modules.
1119 sub inspect_in_detail
1125 _check_for_applications ($g, $os);
1126 _check_for_kernels ($g, $os);
1127 if ($os->{os} eq "linux") {
1128 _check_for_modprobe_aliases ($g, $os);
1129 _check_for_initrd ($g, $os);
1133 sub _check_for_applications
1141 my $osn = $os->{os};
1142 if ($osn eq "linux") {
1143 my $package_format = $os->{package_format};
1144 if (defined $package_format && $package_format eq "rpm") {
1145 my @lines = $g->command_lines
1148 "--qf", "%{name} %{epoch} %{version} %{release} %{arch}\n"]);
1150 if (m/^(.*) (.*) (.*) (.*) (.*)$/) {
1152 $epoch = "" if $epoch eq "(none)";
1164 } elsif ($osn eq "windows") {
1166 # I worked out a general plan for this, but haven't
1167 # implemented it yet. We can iterate over /Program Files
1168 # looking for *.EXE files, which we download, then use
1169 # i686-pc-mingw32-windres on, to find the VERSIONINFO
1170 # section, which has a lot of useful information.
1173 $os->{apps} = \@apps;
1176 sub _check_for_kernels
1184 my $osn = $os->{os};
1185 if ($osn eq "linux") {
1186 # Installed kernels will have a corresponding /lib/modules/<version>
1187 # directory, which is the easiest way to find out what kernels
1188 # are installed, and what modules are available.
1189 foreach ($g->ls ("/lib/modules")) {
1190 if ($g->is_dir ("/lib/modules/$_")) {
1192 $kernel{version} = $_;
1196 foreach ($g->find ("/lib/modules/$_")) {
1197 if (m,/([^/]+)\.ko$, || m,([^/]+)\.o$,) {
1202 $kernel{modules} = \@modules;
1204 push @kernels, \%kernel;
1208 } elsif ($osn eq "windows") {
1212 $os->{kernels} = \@kernels;
1215 # Check /etc/modprobe.conf to see if there are any specified
1216 # drivers associated with network (ethX) or hard drives. Normally
1217 # one might find something like:
1220 # alias scsi_hostadapter xenblk
1222 # XXX This doesn't look beyond /etc/modprobe.conf, eg. in /etc/modprobe.d/
1224 sub _check_for_modprobe_aliases
1232 $success = $g->aug_init("/", 16);
1234 # Register /etc/modules.conf and /etc/conf.modules to the Modprobe lens
1236 @results = $g->aug_match("/augeas/load/Modprobe/incl");
1238 # Calculate the next index of /augeas/load/Modprobe/incl
1240 foreach ( @results ) {
1241 next unless m{/augeas/load/Modprobe/incl\[(\d*)]};
1242 $i = $1 + 1 if ($1 == $i);
1245 $success = $g->aug_set("/augeas/load/Modprobe/incl[$i]",
1246 "/etc/modules.conf");
1248 $success = $g->aug_set("/augeas/load/Modprobe/incl[$i]",
1249 "/etc/conf.modules");
1251 # Make augeas reload
1252 $success = $g->aug_load();
1254 my %modprobe_aliases;
1256 for my $pattern qw(/files/etc/conf.modules/alias
1257 /files/etc/modules.conf/alias
1258 /files/etc/modprobe.conf/alias
1259 /files/etc/modprobe.d/*/alias) {
1260 @results = $g->aug_match($pattern);
1262 for my $path ( @results ) {
1263 $path =~ m{^/files(.*)/alias(?:\[\d*\])?$}
1264 or die __x("{path} doesn't match augeas pattern",
1269 $alias = $g->aug_get($path);
1272 $modulename = $g->aug_get($path.'/modulename');
1275 $aliasinfo{modulename} = $modulename;
1276 $aliasinfo{augeas} = $path;
1277 $aliasinfo{file} = $file;
1279 $modprobe_aliases{$alias} = \%aliasinfo;
1283 $os->{modprobe_aliases} = \%modprobe_aliases;
1286 # Get a listing of device drivers in any initrd corresponding to a
1287 # kernel. This is an indication of what can possibly be booted.
1289 sub _check_for_initrd
1297 foreach my $initrd ($g->ls ("/boot")) {
1298 if ($initrd =~ m/^initrd-(.*)\.img$/ && $g->is_file ("/boot/$initrd")) {
1302 # Disregard old-style compressed ext2 files, since cpio
1303 # takes ages to (fail to) process these.
1304 if ($g->file ("/boot/$initrd") !~ /gzip compressed/ ||
1305 $g->zfile ("gzip", "/boot/$initrd") !~ /ext2 filesystem/) {
1307 @modules = $g->initrd_list ("/boot/$initrd");
1310 @modules = grep { m,([^/]+)\.ko$, || m,([^/]+)\.o$, }
1312 $initrd_modules{$version} = \@modules
1314 warn __x("{filename}: could not read initrd format",
1315 filename => "/boot/$initrd");
1321 $os->{initrd_modules} = \%initrd_modules;
1329 Copyright (C) 2009 Red Hat Inc.
1333 Please see the file COPYING.LIB for the full license.
1337 L<virt-inspector(1)>,
1340 L<http://libguestfs.org/>,
1342 L<http://libvirt.org/>,