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/;
27 eval "use Sys::Virt;";
28 eval "use XML::XPath;";
29 eval "use XML::XPath::XMLParser;";
35 Sys::Guestfs::Lib - Useful functions for using libguestfs from Perl
39 use Sys::Guestfs::Lib qw(open_guest inspect_all_partitions ...);
41 $g = open_guest ($name);
43 %fses = inspect_all_partitions ($g, \@partitions);
45 (and many more calls - see the rest of this manpage)
49 C<Sys::Guestfs::Lib> is an extra library of useful functions for using
50 the libguestfs API from Perl. It also provides tighter integration
53 The basic libguestfs API is not covered by this manpage. Please refer
54 instead to L<Sys::Guestfs(3)> and L<guestfs(3)>. The libvirt API is
55 also not covered. For that, see L<Sys::Virt(3)>.
57 =head1 BASIC FUNCTIONS
63 use vars qw(@EXPORT_OK @ISA);
66 @EXPORT_OK = qw(open_guest get_partitions resolve_windows_path
67 inspect_all_partitions inspect_partition
68 inspect_operating_systems mount_operating_system inspect_in_detail);
72 $g = open_guest ($name);
74 $g = open_guest ($name, rw => 1, ...);
76 $g = open_guest ($name, address => $uri, ...);
78 $g = open_guest ([$img1, $img2, ...], address => $uri, ...);
80 ($g, $conn, $dom) = open_guest ($name);
82 This function opens a libguestfs handle for either the libvirt domain
83 called C<$name>, or the disk image called C<$name>. Any disk images
84 found through libvirt or specified explicitly are attached to the
87 The C<Sys::Guestfs> handle C<$g> is returned, or if there was an error
88 it throws an exception. To catch errors, wrap the call in an eval
91 The first parameter is either a string referring to a libvirt domain
92 or a disk image, or (if a guest has several disk images) an arrayref
93 C<[$img1, $img2, ...]>.
95 The handle is I<read-only> by default. Use the optional parameter
96 C<rw =E<gt> 1> to open a read-write handle. However if you open a
97 read-write handle, this function will refuse to use active libvirt
100 The handle is still in the config state when it is returned, so you
101 have to call C<$g-E<gt>launch ()> and C<$g-E<gt>wait_ready>.
103 The optional C<address> parameter can be added to specify the libvirt
104 URI. In addition, L<Sys::Virt(3)> lists other parameters which are
105 passed through to C<Sys::Virt-E<gt>new> unchanged.
107 The implicit libvirt handle is closed after this function, I<unless>
108 you call the function in C<wantarray> context, in which case the
109 function returns a tuple of: the open libguestfs handle, the open
110 libvirt handle, and the open libvirt domain handle. (This is useful
111 if you want to do other things like pulling the XML description of the
112 guest). Note that if this is a straight disk image, then C<$conn> and
113 C<$dom> will be C<undef>.
115 If the C<Sys::Virt> module is not available, then libvirt is bypassed,
116 and this function can only open disk images.
126 my $readwrite = $params{rw};
129 if (ref ($first) eq "ARRAY") {
131 } elsif (ref ($first) eq "SCALAR") {
134 die "open_guest: first parameter must be a string or an arrayref"
141 die "guest image $_ does not exist or is not readable"
145 die "open_guest: no libvirt support (install Sys::Virt, XML::XPath and XML::XPath::XMLParser)"
146 unless exists $INC{"Sys/Virt.pm"} &&
147 exists $INC{"XML/XPath.pm"} &&
148 exists $INC{"XML/XPath/XMLParser.pm"};
150 die "open_guest: too many domains listed on command line"
153 $conn = Sys::Virt->new (readonly => 1, @_);
154 die "open_guest: cannot connect to libvirt" unless $conn;
156 my @doms = $conn->list_defined_domains ();
157 my $isitinactive = "an inactive libvirt domain";
158 unless ($readwrite) {
159 # In the case where we want read-only access to a domain,
160 # allow the user to specify an active domain too.
161 push @doms, $conn->list_domains ();
162 $isitinactive = "a libvirt domain";
165 if ($_->get_name () eq $images[0]) {
170 die "$images[0] is not the name of $isitinactive\n" unless $dom;
172 # Get the names of the image(s).
173 my $xml = $dom->get_xml_description ();
175 my $p = XML::XPath->new (xml => $xml);
176 my @disks = $p->findnodes ('//devices/disk/source/@dev');
177 push (@disks, $p->findnodes ('//devices/disk/source/@file'));
179 die "$images[0] seems to have no disk devices\n" unless @disks;
181 @images = map { $_->getData } @disks;
184 # We've now got the list of @images, so feed them to libguestfs.
185 my $g = Sys::Guestfs->new ();
190 $g->add_drive_ro ($_);
194 return wantarray ? ($g, $conn, $dom) : $g
197 =head2 get_partitions
199 @partitions = get_partitions ($g);
201 This function takes an open libguestfs handle C<$g> and returns all
202 partitions and logical volumes found on it.
204 What is returned is everything that could contain a filesystem (or
205 swap). Physical volumes are excluded from the list, and so are any
206 devices which are partitioned (eg. C</dev/sda> would not be returned
207 if C</dev/sda1> exists).
215 my @partitions = $g->list_partitions ();
216 my @pvs = $g->pvs ();
217 @partitions = grep { ! _is_pv ($_, @pvs) } @partitions;
219 my @lvs = $g->lvs ();
221 return sort (@lvs, @partitions);
229 return 1 if $_ eq $t;
234 =head2 resolve_windows_path
236 $path = resolve_windows_path ($g, $path);
238 $path = resolve_windows_path ($g, "/windows/system");
239 ==> "/WINDOWS/System"
240 or undef if no path exists
242 This function, which is specific to FAT/NTFS filesystems (ie. Windows
243 guests), lets you look up a case insensitive C<$path> in the
244 filesystem and returns the true, case sensitive path as required by
245 the underlying kernel or NTFS-3g driver.
247 If C<$path> does not exist then this function returns C<undef>.
249 The C<$path> parameter must begin with C</> character and be separated
250 by C</> characters. Do not use C<\>, drive names, etc.
254 sub resolve_windows_path
260 if (substr ($path, 0, 1) ne "/") {
261 warn "resolve_windows_path: path must start with a / character";
265 my @elems = split (/\//, $path);
268 # Start reconstructing the path at the top.
271 foreach my $dir (@elems) {
273 foreach ($g->ls ($path)) {
274 if (lc ($_) eq lc ($dir)) {
284 return undef unless $found;
290 =head1 OPERATING SYSTEM INSPECTION FUNCTIONS
292 The functions in this section can be used to inspect the operating
293 system(s) available inside a virtual machine image. For example, you
294 can find out if the VM is Linux or Windows, how the partitions are
295 meant to be mounted, and what applications are installed.
297 If you just want a simple command-line interface to this
298 functionality, use the L<virt-inspector(1)> tool. The documentation
299 below covers the case where you want to access this functionality from
302 Once you have the list of partitions (from C<get_partitions>) there
303 are several steps involved:
309 Look at each partition separately and find out what is on it.
311 The information you get back includes whether the partition contains a
312 filesystem or swapspace, what sort of filesystem (eg. ext3, ntfs), and
313 a first pass guess at the content of the filesystem (eg. Linux boot,
316 The result of this step is a C<%fs> hash of information, one hash for
319 See: C<inspect_partition>, C<inspect_all_partitions>
323 Work out the relationship between partitions.
325 In this step we work out how partitions are related to each other. In
326 the case of a single-boot VM, we work out how the partitions are
327 mounted in respect of each other (eg. C</dev/sda1> is mounted as
328 C</boot>). In the case of a multi-boot VM where there are several
329 roots, we may identify several operating system roots, and mountpoints
332 The result of this step is a single hash called C<%oses> which is
333 described in more detail below, but at the top level looks like:
336 '/dev/VG/Root1' => \%os1,
337 '/dev/VG/Root2' => \%os2,
343 '/' => '/dev/VG/Root1',
344 '/boot' => '/dev/sda1',
349 (example shows a multi-boot VM containing two root partitions).
351 See: C<inspect_operating_systems>
357 Previous to this point we've essentially been looking at each
358 partition in isolation. Now we construct a true guest filesystem by
359 mounting up all of the disks. Only once everything is mounted up can
360 we run commands in the OS context to do more detailed inspection.
362 See: C<mount_operating_system>
366 Check for kernels and applications.
368 This step now does more detailed inspection, where we can look for
369 kernels, applications and more installed in the guest.
371 The result of this is an enhanced C<%os> hash.
373 See: C<inspect_in_detail>
379 This library does not contain functions for generating output based on
380 the analysis steps above. Use a command line tool such as
381 L<virt-inspector(1)> to get useful output.
385 =head2 inspect_all_partitions
387 %fses = inspect_all_partitions ($g, \@partitions);
389 %fses = inspect_all_partitions ($g, \@partitions, use_windows_registry => 1);
391 This calls C<inspect_partition> for each partition in the list
394 The result is a hash which maps partition name to C<\%fs> hashref.
396 The contents of the C<%fs> hash and the meaning of the
397 C<use_windows_registry> flag are explained below.
401 sub inspect_all_partitions
407 return map { $_ => inspect_partition ($g, $_, @_) } @parts;
410 =head2 inspect_partition
412 \%fs = inspect_partition ($g, $partition);
414 \%fs = inspect_partition ($g, $partition, use_windows_registry => 1);
416 This function inspects the device named C<$partition> in isolation and
417 tries to determine what it is. It returns information such as whether
418 the partition is formatted, and with what, whether it is mountable,
419 and what it appears to contain (eg. a Windows root, or a Linux /usr).
421 If C<use_windows_registry> is set to 1, then we will try to download
422 and parse the content of the Windows registry (for Windows root
423 devices). However since this is an expensive and error-prone
424 operation, we don't do this by default. It also requires the external
425 program C<reged>, patched to remove numerous crashing bugs in the
428 The returned value is a hashref C<\%fs> which may contain the
429 following top-level keys (any key can be missing):
435 Filesystem type, eg. "ext2" or "ntfs"
439 Apparent filesystem OS, eg. "linux" or "windows"
443 If set, the partition is a swap partition.
455 If set, the partition could be mounted by libguestfs.
459 Filesystem content, if we could determine it. One of: "linux-grub",
460 "linux-root", "linux-usrlocal", "linux-usr", "windows-root".
464 (For Linux root partitions only).
465 Operating system distribution. One of: "fedora", "redhat",
470 (For root partitions only).
471 Operating system version.
475 (For Linux root partitions only).
476 The contents of the C</etc/fstab> file.
480 (For Windows root partitions only).
481 The contents of the C</boot.ini> (NTLDR) file.
485 The value is an arrayref, which is a list of Windows registry
486 file contents, in Windows C<.REG> format.
492 sub inspect_partition
496 my $dev = shift; # LV or partition name.
499 my $use_windows_registry = $params{use_windows_registry};
501 my %r; # Result hash.
503 # First try 'file(1)' on it.
504 my $file = $g->file ($dev);
505 if ($file =~ /ext2 filesystem data/) {
508 } elsif ($file =~ /ext3 filesystem data/) {
511 } elsif ($file =~ /ext4 filesystem data/) {
514 } elsif ($file =~ m{Linux/i386 swap file}) {
520 # If it's ext2/3/4, then we want the UUID and label.
521 if (exists $r{fstype} && $r{fstype} =~ /^ext/) {
522 $r{uuid} = $g->get_e2uuid ($dev);
523 $r{label} = $g->get_e2label ($dev);
526 # Try mounting it, fnarrr.
528 $r{is_mountable} = 1;
529 eval { $g->mount_ro ($dev, "/") };
531 # It's not mountable, probably empty or some format
532 # we don't understand.
533 $r{is_mountable} = 0;
538 if ($g->is_file ("/grub/menu.lst") ||
539 $g->is_file ("/grub/grub.conf")) {
540 $r{content} = "linux-grub";
541 _check_grub ($g, \%r);
546 if ($g->is_dir ("/etc") && $g->is_dir ("/bin") &&
547 $g->is_file ("/etc/fstab")) {
548 $r{content} = "linux-root";
550 _check_linux_root ($g, \%r);
555 if ($g->is_dir ("/etc") && $g->is_dir ("/bin") &&
556 $g->is_dir ("/share") && !$g->exists ("/local") &&
557 !$g->is_file ("/etc/fstab")) {
558 $r{content} = "linux-usrlocal";
563 if ($g->is_dir ("/etc") && $g->is_dir ("/bin") &&
564 $g->is_dir ("/share") && $g->exists ("/local") &&
565 !$g->is_file ("/etc/fstab")) {
566 $r{content} = "linux-usr";
571 if ($g->is_file ("/AUTOEXEC.BAT") ||
572 $g->is_file ("/autoexec.bat") ||
573 $g->is_dir ("/Program Files") ||
574 $g->is_dir ("/WINDOWS") ||
575 $g->is_file ("/boot.ini") ||
576 $g->is_file ("/ntldr")) {
577 $r{fstype} = "ntfs"; # XXX this is a guess
578 $r{fsos} = "windows";
579 $r{content} = "windows-root";
581 _check_windows_root ($g, \%r, $use_windows_registry);
591 sub _check_linux_root
597 # Look into /etc to see if we recognise the operating system.
598 if ($g->is_file ("/etc/redhat-release")) {
599 $_ = $g->cat ("/etc/redhat-release");
600 if (/Fedora release (\d+\.\d+)/) {
601 $r->{osdistro} = "fedora";
602 $r->{osversion} = "$1"
603 } elsif (/(Red Hat Enterprise Linux|CentOS|Scientific Linux).*release (\d+).*Update (\d+)/) {
604 $r->{osdistro} = "redhat";
605 $r->{osversion} = "$2.$3";
606 } elsif (/(Red Hat Enterprise Linux|CentOS|Scientific Linux).*release (\d+(?:\.(\d+))?)/) {
607 $r->{osdistro} = "redhat";
608 $r->{osversion} = "$2";
610 $r->{osdistro} = "redhat";
612 } elsif ($g->is_file ("/etc/debian_version")) {
613 $_ = $g->cat ("/etc/debian_version");
615 $r->{osdistro} = "debian";
616 $r->{osversion} = "$1";
618 $r->{osdistro} = "debian";
622 # Parse the contents of /etc/fstab. This is pretty vital so
623 # we can determine where filesystems are supposed to be mounted.
624 eval "\$_ = \$g->cat ('/etc/fstab');";
626 my @lines = split /\n/;
629 my @fields = split /[ \t]+/;
631 my $spec = $fields[0]; # first column (dev/label/uuid)
632 my $file = $fields[1]; # second column (mountpoint)
633 if ($spec =~ m{^/} ||
634 $spec =~ m{^LABEL=} ||
635 $spec =~ m{^UUID=} ||
637 push @fstab, [$spec, $file]
641 $r->{fstab} = \@fstab if @fstab;
645 # We only support NT. The control file /boot.ini contains a list of
646 # Windows installations and their %systemroot%s in a simple text
649 # XXX We could parse this better. This won't work if /boot.ini is on
650 # a different drive from the %systemroot%, and in other unusual cases.
652 sub _check_windows_root
657 my $use_windows_registry = shift;
659 my $boot_ini = resolve_windows_path ($g, "/boot.ini");
660 $r->{boot_ini} = $boot_ini;
662 if (defined $r->{boot_ini}) {
663 $_ = $g->cat ($boot_ini);
664 my @lines = split /\n/;
670 } elsif (m/^default=.*?\\(\w+)$/i) {
673 } elsif (m/\\(\w+)=/) {
679 if (defined $systemroot) {
680 $r->{systemroot} = resolve_windows_path ($g, "/$systemroot");
681 if (defined $r->{systemroot} && $use_windows_registry) {
682 _check_windows_registry ($g, $r, $r->{systemroot});
688 sub _check_windows_registry
693 my $systemroot = shift;
695 # Download the system registry files. Only download the
696 # interesting ones, and we don't bother with user profiles at all.
698 my $configdir = resolve_windows_path ($g, "$systemroot/system32/config");
699 if (defined $configdir) {
700 my $softwaredir = resolve_windows_path ($g, "$configdir/software");
701 if (defined $softwaredir) {
702 _load_windows_registry ($g, $r, $softwaredir,
703 "HKEY_LOCAL_MACHINE\\SOFTWARE");
705 my $systemdir = resolve_windows_path ($g, "$configdir/system");
706 if (defined $systemdir) {
707 _load_windows_registry ($g, $r, $systemdir,
708 "HKEY_LOCAL_MACHINE\\System");
713 sub _load_windows_registry
721 my $dir = tempdir (CLEANUP => 1);
723 $g->download ($regfile, "$dir/reg");
725 # 'reged' command is particularly noisy. Redirect stdout and
726 # stderr to /dev/null temporarily.
727 open SAVEOUT, ">&STDOUT";
728 open SAVEERR, ">&STDERR";
729 open STDOUT, ">/dev/null";
730 open STDERR, ">/dev/null";
732 my @cmd = ("reged", "-x", "$dir/reg", "$prefix", "\\", "$dir/out");
733 my $res = system (@cmd);
737 open STDOUT, ">&SAVEOUT";
738 open STDERR, ">&SAVEERR";
743 warn "reged command failed: $?";
747 # Some versions of reged segfault on inputs. If that happens we
748 # may get no / partial output file. Anyway, if it exists, load
751 unless (open F, "$dir/out") {
752 warn "no output from reged command: $!";
755 { local $/ = undef; $content = <F>; }
759 @registry = @{$r->{registry}} if exists $r->{registry};
760 push @registry, $content;
761 $r->{registry} = \@registry;
770 # Grub version, if we care.
773 =head2 inspect_operating_systems
775 \%oses = inspect_operating_systems ($g, \%fses);
777 This function works out how partitions are related to each other. In
778 the case of a single-boot VM, we work out how the partitions are
779 mounted in respect of each other (eg. C</dev/sda1> is mounted as
780 C</boot>). In the case of a multi-boot VM where there are several
781 roots, we may identify several operating system roots, and mountpoints
784 This function returns a hashref C<\%oses> which at the top level looks
788 '/dev/VG/Root' => \%os,
791 (There can be multiple roots for a multi-boot VM).
793 The C<\%os> hash contains the following keys (any can be omitted):
799 Operating system type, eg. "linux", "windows".
803 Operating system distribution, eg. "debian".
807 Operating system version, eg. "4.0".
811 The value is a reference to the root partition C<%fs> hash.
815 The value is the name of the root partition (as a string).
820 The value is a hashref like this:
823 '/' => '/dev/VG/Root',
824 '/boot' => '/dev/sda1',
829 Filesystems (including swap devices and unmounted partitions).
830 The value is a hashref like this:
834 '/dev/VG/Root' => \%fs,
835 '/dev/VG/Swap' => \%fs,
842 sub inspect_operating_systems
850 foreach (sort keys %$fses) {
851 if ($fses->{$_}->{is_root}) {
856 _get_os_version ($g, \%r);
857 _assign_mount_points ($g, $fses, \%r);
871 $r->{os} = $r->{root}->{fsos} if exists $r->{root}->{fsos};
872 $r->{distro} = $r->{root}->{osdistro} if exists $r->{root}->{osdistro};
873 $r->{version} = $r->{root}->{osversion} if exists $r->{root}->{osversion};
876 sub _assign_mount_points
883 $r->{mounts} = { "/" => $r->{root_device} };
884 $r->{filesystems} = { $r->{root_device} => $r->{root} };
886 # Use /etc/fstab if we have it to mount the rest.
887 if (exists $r->{root}->{fstab}) {
888 my @fstab = @{$r->{root}->{fstab}};
890 my ($spec, $file) = @$_;
892 my ($dev, $fs) = _find_filesystem ($g, $fses, $spec);
894 $r->{mounts}->{$file} = $dev;
895 $r->{filesystems}->{$dev} = $fs;
896 if (exists $fs->{used}) {
907 # Find filesystem by device name, LABEL=.. or UUID=..
916 foreach (sort keys %$fses) {
917 if (exists $fses->{$_}->{label} &&
918 $fses->{$_}->{label} eq $label) {
919 return ($_, $fses->{$_});
922 warn "unknown filesystem label $label\n";
924 } elsif (/^UUID=(.*)/) {
926 foreach (sort keys %$fses) {
927 if (exists $fses->{$_}->{uuid} &&
928 $fses->{$_}->{uuid} eq $uuid) {
929 return ($_, $fses->{$_});
932 warn "unknown filesystem UUID $uuid\n";
935 return ($_, $fses->{$_}) if exists $fses->{$_};
937 # The following is to handle the case where an fstab entry specifies a
938 # specific device rather than its label or uuid, and the libguestfs
939 # appliance has named the device differently due to the use of a
941 # This will work as long as the underlying drivers recognise devices in
943 if (m{^/dev/hd(.*)} && exists $fses->{"/dev/sd$1"}) {
944 return ("/dev/sd$1", $fses->{"/dev/sd$1"});
946 if (m{^/dev/xvd(.*)} && exists $fses->{"/dev/sd$1"}) {
947 return ("/dev/sd$1", $fses->{"/dev/sd$1"});
949 if (m{^/dev/mapper/(.*)-(.*)$} && exists $fses->{"/dev/$1/$2"}) {
950 return ("/dev/$1/$2", $fses->{"/dev/$1/$2"});
953 return () if m{/dev/cdrom};
955 warn "unknown filesystem $_\n";
960 =head2 mount_operating_system
962 mount_operating_system ($g, \%os);
964 This function mounts the operating system described in the
965 C<%os> hash according to the C<mounts> table in that hash (see
966 C<inspect_operating_systems>).
968 The partitions are mounted read-only.
970 To reverse the effect of this call, use the standard
971 libguestfs API call C<$g-E<gt>umount_all ()>.
975 sub mount_operating_system
981 my $mounts = $os->{mounts};
983 # Have to mount / first. Luckily '/' is early in the ASCII
984 # character set, so this should be OK.
985 foreach (sort keys %$mounts) {
986 $g->mount_ro ($mounts->{$_}, $_)
987 if $_ ne "swap" && $_ ne "none" && ($_ eq '/' || $g->is_dir ($_));
991 =head2 inspect_in_detail
993 mount_operating_system ($g, \%os);
994 inspect_in_detail ($g, \%os);
997 The C<inspect_in_detail> function inspects the mounted operating
998 system for installed applications, installed kernels, kernel modules
1001 It adds extra keys to the existing C<%os> hash reflecting what it
1002 finds. These extra keys are:
1008 List of applications.
1014 =item modprobe_aliases
1017 The contents of the modprobe configuration.
1019 =item initrd_modules
1022 The kernel modules installed in the initrd. The value is
1023 a hashref of kernel version to list of modules.
1029 sub inspect_in_detail
1035 _check_for_applications ($g, $os);
1036 _check_for_kernels ($g, $os);
1037 if ($os->{os} eq "linux") {
1038 _check_for_modprobe_aliases ($g, $os);
1039 _check_for_initrd ($g, $os);
1043 sub _check_for_applications
1051 my $osn = $os->{os};
1052 if ($osn eq "linux") {
1053 my $distro = $os->{distro};
1054 if (defined $distro && ($distro eq "redhat" || $distro eq "fedora")) {
1055 my @lines = $g->command_lines
1058 "--qf", "%{name} %{epoch} %{version} %{release} %{arch}\n"]);
1060 if (m/^(.*) (.*) (.*) (.*) (.*)$/) {
1062 $epoch = "" if $epoch eq "(none)";
1074 } elsif ($osn eq "windows") {
1076 # I worked out a general plan for this, but haven't
1077 # implemented it yet. We can iterate over /Program Files
1078 # looking for *.EXE files, which we download, then use
1079 # i686-pc-mingw32-windres on, to find the VERSIONINFO
1080 # section, which has a lot of useful information.
1083 $os->{apps} = \@apps;
1086 sub _check_for_kernels
1094 my $osn = $os->{os};
1095 if ($osn eq "linux") {
1096 # Installed kernels will have a corresponding /lib/modules/<version>
1097 # directory, which is the easiest way to find out what kernels
1098 # are installed, and what modules are available.
1099 foreach ($g->ls ("/lib/modules")) {
1100 if ($g->is_dir ("/lib/modules/$_")) {
1102 $kernel{version} = $_;
1106 foreach ($g->find ("/lib/modules/$_")) {
1107 if (m,/([^/]+)\.ko$, || m,([^/]+)\.o$,) {
1112 $kernel{modules} = \@modules;
1114 push @kernels, \%kernel;
1118 } elsif ($osn eq "windows") {
1122 $os->{kernels} = \@kernels;
1125 # Check /etc/modprobe.conf to see if there are any specified
1126 # drivers associated with network (ethX) or hard drives. Normally
1127 # one might find something like:
1130 # alias scsi_hostadapter xenblk
1132 # XXX This doesn't look beyond /etc/modprobe.conf, eg. in /etc/modprobe.d/
1134 sub _check_for_modprobe_aliases
1142 $success = $g->aug_init("/", 16);
1144 # Register /etc/modules.conf and /etc/conf.modules to the Modprobe lens
1146 @results = $g->aug_match("/augeas/load/Modprobe/incl");
1148 # Calculate the next index of /augeas/load/Modprobe/incl
1150 foreach ( @results ) {
1151 next unless m{/augeas/load/Modprobe/incl\[(\d*)]};
1152 $i = $1 + 1 if ($1 == $i);
1155 $success = $g->aug_set("/augeas/load/Modprobe/incl[$i]",
1156 "/etc/modules.conf");
1158 $success = $g->aug_set("/augeas/load/Modprobe/incl[$i]",
1159 "/etc/conf.modules");
1161 # Make augeas reload
1162 $success = $g->aug_load();
1164 my %modprobe_aliases;
1166 for my $pattern qw(/files/etc/conf.modules/alias
1167 /files/etc/modules.conf/alias
1168 /files/etc/modprobe.conf/alias
1169 /files/etc/modprobe.d/*/alias) {
1170 @results = $g->aug_match($pattern);
1172 for my $path ( @results ) {
1173 $path =~ m{^/files(.*)/alias(?:\[\d*\])?$}
1174 or die("$path doesn't match augeas pattern");
1178 $alias = $g->aug_get($path);
1181 $modulename = $g->aug_get($path.'/modulename');
1184 $aliasinfo{modulename} = $modulename;
1185 $aliasinfo{augeas} = $path;
1186 $aliasinfo{file} = $file;
1188 $modprobe_aliases{$alias} = \%aliasinfo;
1192 $os->{modprobe_aliases} = \%modprobe_aliases;
1195 # Get a listing of device drivers in any initrd corresponding to a
1196 # kernel. This is an indication of what can possibly be booted.
1198 sub _check_for_initrd
1206 foreach my $initrd ($g->ls ("/boot")) {
1207 if ($initrd =~ m/^initrd-(.*)\.img$/ && $g->is_file ("/boot/$initrd")) {
1211 # Disregard old-style compressed ext2 files, since cpio
1212 # takes ages to (fail to) process these.
1213 if ($g->file ("/boot/$initrd") !~ /gzip compressed/ ||
1214 $g->zfile ("gzip", "/boot/$initrd") !~ /ext2 filesystem/) {
1216 @modules = $g->initrd_list ("/boot/$initrd");
1219 @modules = grep { m,([^/]+)\.ko$, || m,([^/]+)\.o$, }
1221 $initrd_modules{$version} = \@modules
1223 warn "/boot/$initrd: could not read initrd format";
1229 $os->{initrd_modules} = \%initrd_modules;
1237 Copyright (C) 2009 Red Hat Inc.
1241 Please see the file COPYING.LIB for the full license.
1245 L<virt-inspector(1)>,
1248 L<http://libguestfs.org/>,
1250 L<http://libvirt.org/>,