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 @images = map { $_->getData } @disks;
180 # We've now got the list of @images, so feed them to libguestfs.
181 my $g = Sys::Guestfs->new ();
186 $g->add_drive_ro ($_);
190 return wantarray ? ($g, $conn, $dom) : $g
193 =head2 get_partitions
195 @partitions = get_partitions ($g);
197 This function takes an open libguestfs handle C<$g> and returns all
198 partitions and logical volumes found on it.
200 What is returned is everything that could contain a filesystem (or
201 swap). Physical volumes are excluded from the list, and so are any
202 devices which are partitioned (eg. C</dev/sda> would not be returned
203 if C</dev/sda1> exists).
211 my @partitions = $g->list_partitions ();
212 my @pvs = $g->pvs ();
213 @partitions = grep { ! _is_pv ($_, @pvs) } @partitions;
215 my @lvs = $g->lvs ();
217 return sort (@lvs, @partitions);
225 return 1 if $_ eq $t;
230 =head2 resolve_windows_path
232 $path = resolve_windows_path ($g, $path);
234 $path = resolve_windows_path ($g, "/windows/system");
235 ==> "/WINDOWS/System"
236 or undef if no path exists
238 This function, which is specific to FAT/NTFS filesystems (ie. Windows
239 guests), lets you look up a case insensitive C<$path> in the
240 filesystem and returns the true, case sensitive path as required by
241 the underlying kernel or NTFS-3g driver.
243 If C<$path> does not exist then this function returns C<undef>.
245 The C<$path> parameter must begin with C</> character and be separated
246 by C</> characters. Do not use C<\>, drive names, etc.
250 sub resolve_windows_path
256 if (substr ($path, 0, 1) ne "/") {
257 warn "resolve_windows_path: path must start with a / character";
261 my @elems = split (/\//, $path);
264 # Start reconstructing the path at the top.
267 foreach my $dir (@elems) {
269 foreach ($g->ls ($path)) {
270 if (lc ($_) eq lc ($dir)) {
280 return undef unless $found;
286 =head1 OPERATING SYSTEM INSPECTION FUNCTIONS
288 The functions in this section can be used to inspect the operating
289 system(s) available inside a virtual machine image. For example, you
290 can find out if the VM is Linux or Windows, how the partitions are
291 meant to be mounted, and what applications are installed.
293 If you just want a simple command-line interface to this
294 functionality, use the L<virt-inspector(1)> tool. The documentation
295 below covers the case where you want to access this functionality from
298 Once you have the list of partitions (from C<get_partitions>) there
299 are several steps involved:
305 Look at each partition separately and find out what is on it.
307 The information you get back includes whether the partition contains a
308 filesystem or swapspace, what sort of filesystem (eg. ext3, ntfs), and
309 a first pass guess at the content of the filesystem (eg. Linux boot,
312 The result of this step is a C<%fs> hash of information, one hash for
315 See: C<inspect_partition>, C<inspect_all_partitions>
319 Work out the relationship between partitions.
321 In this step we work out how partitions are related to each other. In
322 the case of a single-boot VM, we work out how the partitions are
323 mounted in respect of each other (eg. C</dev/sda1> is mounted as
324 C</boot>). In the case of a multi-boot VM where there are several
325 roots, we may identify several operating system roots, and mountpoints
328 The result of this step is a single hash called C<%oses> which is
329 described in more detail below, but at the top level looks like:
332 '/dev/VG/Root1' => \%os1,
333 '/dev/VG/Root2' => \%os2,
339 '/' => '/dev/VG/Root1',
340 '/boot' => '/dev/sda1',
345 (example shows a multi-boot VM containing two root partitions).
347 See: C<inspect_operating_systems>
353 Previous to this point we've essentially been looking at each
354 partition in isolation. Now we construct a true guest filesystem by
355 mounting up all of the disks. Only once everything is mounted up can
356 we run commands in the OS context to do more detailed inspection.
358 See: C<mount_operating_system>
362 Check for kernels and applications.
364 This step now does more detailed inspection, where we can look for
365 kernels, applications and more installed in the guest.
367 The result of this is an enhanced C<%os> hash.
369 See: C<inspect_in_detail>
375 This library does not contain functions for generating output based on
376 the analysis steps above. Use a command line tool such as
377 L<virt-inspector(1)> to get useful output.
381 =head2 inspect_all_partitions
383 %fses = inspect_all_partitions ($g, \@partitions);
385 %fses = inspect_all_partitions ($g, \@partitions, use_windows_registry => 1);
387 This calls C<inspect_partition> for each partition in the list
390 The result is a hash which maps partition name to C<\%fs> hashref.
392 The contents of the C<%fs> hash and the meaning of the
393 C<use_windows_registry> flag are explained below.
397 sub inspect_all_partitions
403 return map { $_ => inspect_partition ($g, $_, @_) } @parts;
406 =head2 inspect_partition
408 \%fs = inspect_partition ($g, $partition);
410 \%fs = inspect_partition ($g, $partition, use_windows_registry => 1);
412 This function inspects the device named C<$partition> in isolation and
413 tries to determine what it is. It returns information such as whether
414 the partition is formatted, and with what, whether it is mountable,
415 and what it appears to contain (eg. a Windows root, or a Linux /usr).
417 If C<use_windows_registry> is set to 1, then we will try to download
418 and parse the content of the Windows registry (for Windows root
419 devices). However since this is an expensive and error-prone
420 operation, we don't do this by default. It also requires the external
421 program C<reged>, patched to remove numerous crashing bugs in the
424 The returned value is a hashref C<\%fs> which may contain the
425 following top-level keys (any key can be missing):
431 Filesystem type, eg. "ext2" or "ntfs"
435 Apparent filesystem OS, eg. "linux" or "windows"
439 If set, the partition is a swap partition.
451 If set, the partition could be mounted by libguestfs.
455 Filesystem content, if we could determine it. One of: "linux-grub",
456 "linux-root", "linux-usrlocal", "linux-usr", "windows-root".
460 (For Linux root partitions only).
461 Operating system distribution. One of: "fedora", "redhat",
466 (For root partitions only).
467 Operating system version.
471 (For Linux root partitions only).
472 The contents of the C</etc/fstab> file.
476 (For Windows root partitions only).
477 The contents of the C</boot.ini> (NTLDR) file.
481 The value is an arrayref, which is a list of Windows registry
482 file contents, in Windows C<.REG> format.
488 sub inspect_partition
492 my $dev = shift; # LV or partition name.
495 my $use_windows_registry = $params{use_windows_registry};
497 my %r; # Result hash.
499 # First try 'file(1)' on it.
500 my $file = $g->file ($dev);
501 if ($file =~ /ext2 filesystem data/) {
504 } elsif ($file =~ /ext3 filesystem data/) {
507 } elsif ($file =~ /ext4 filesystem data/) {
510 } elsif ($file =~ m{Linux/i386 swap file}) {
516 # If it's ext2/3/4, then we want the UUID and label.
517 if (exists $r{fstype} && $r{fstype} =~ /^ext/) {
518 $r{uuid} = $g->get_e2uuid ($dev);
519 $r{label} = $g->get_e2label ($dev);
522 # Try mounting it, fnarrr.
524 $r{is_mountable} = 1;
525 eval { $g->mount_ro ($dev, "/") };
527 # It's not mountable, probably empty or some format
528 # we don't understand.
529 $r{is_mountable} = 0;
534 if ($g->is_file ("/grub/menu.lst") ||
535 $g->is_file ("/grub/grub.conf")) {
536 $r{content} = "linux-grub";
537 _check_grub ($g, \%r);
542 if ($g->is_dir ("/etc") && $g->is_dir ("/bin") &&
543 $g->is_file ("/etc/fstab")) {
544 $r{content} = "linux-root";
546 _check_linux_root ($g, \%r);
551 if ($g->is_dir ("/etc") && $g->is_dir ("/bin") &&
552 $g->is_dir ("/share") && !$g->exists ("/local") &&
553 !$g->is_file ("/etc/fstab")) {
554 $r{content} = "linux-usrlocal";
559 if ($g->is_dir ("/etc") && $g->is_dir ("/bin") &&
560 $g->is_dir ("/share") && $g->exists ("/local") &&
561 !$g->is_file ("/etc/fstab")) {
562 $r{content} = "linux-usr";
567 if ($g->is_file ("/AUTOEXEC.BAT") ||
568 $g->is_file ("/autoexec.bat") ||
569 $g->is_dir ("/Program Files") ||
570 $g->is_dir ("/WINDOWS") ||
571 $g->is_file ("/boot.ini") ||
572 $g->is_file ("/ntldr")) {
573 $r{fstype} = "ntfs"; # XXX this is a guess
574 $r{fsos} = "windows";
575 $r{content} = "windows-root";
577 _check_windows_root ($g, \%r, $use_windows_registry);
587 sub _check_linux_root
593 # Look into /etc to see if we recognise the operating system.
594 if ($g->is_file ("/etc/redhat-release")) {
595 $_ = $g->cat ("/etc/redhat-release");
596 if (/Fedora release (\d+\.\d+)/) {
597 $r->{osdistro} = "fedora";
598 $r->{osversion} = "$1"
599 } elsif (/(Red Hat Enterprise Linux|CentOS|Scientific Linux).*release (\d+).*Update (\d+)/) {
600 $r->{osdistro} = "redhat";
601 $r->{osversion} = "$2.$3";
602 } elsif (/(Red Hat Enterprise Linux|CentOS|Scientific Linux).*release (\d+(?:\.(\d+))?)/) {
603 $r->{osdistro} = "redhat";
604 $r->{osversion} = "$2";
606 $r->{osdistro} = "redhat";
608 } elsif ($g->is_file ("/etc/debian_version")) {
609 $_ = $g->cat ("/etc/debian_version");
611 $r->{osdistro} = "debian";
612 $r->{osversion} = "$1";
614 $r->{osdistro} = "debian";
618 # Parse the contents of /etc/fstab. This is pretty vital so
619 # we can determine where filesystems are supposed to be mounted.
620 eval "\$_ = \$g->cat ('/etc/fstab');";
622 my @lines = split /\n/;
625 my @fields = split /[ \t]+/;
627 my $spec = $fields[0]; # first column (dev/label/uuid)
628 my $file = $fields[1]; # second column (mountpoint)
629 if ($spec =~ m{^/} ||
630 $spec =~ m{^LABEL=} ||
631 $spec =~ m{^UUID=} ||
633 push @fstab, [$spec, $file]
637 $r->{fstab} = \@fstab if @fstab;
641 # We only support NT. The control file /boot.ini contains a list of
642 # Windows installations and their %systemroot%s in a simple text
645 # XXX We could parse this better. This won't work if /boot.ini is on
646 # a different drive from the %systemroot%, and in other unusual cases.
648 sub _check_windows_root
653 my $use_windows_registry = shift;
655 my $boot_ini = resolve_windows_path ($g, "/boot.ini");
656 $r->{boot_ini} = $boot_ini;
658 if (defined $r->{boot_ini}) {
659 $_ = $g->cat ($boot_ini);
660 my @lines = split /\n/;
666 } elsif (m/^default=.*?\\(\w+)$/i) {
669 } elsif (m/\\(\w+)=/) {
675 if (defined $systemroot) {
676 $r->{systemroot} = resolve_windows_path ($g, "/$systemroot");
677 if (defined $r->{systemroot} && $use_windows_registry) {
678 _check_windows_registry ($g, $r, $r->{systemroot});
684 sub _check_windows_registry
689 my $systemroot = shift;
691 # Download the system registry files. Only download the
692 # interesting ones, and we don't bother with user profiles at all.
694 my $configdir = resolve_windows_path ($g, "$systemroot/system32/config");
695 if (defined $configdir) {
696 my $softwaredir = resolve_windows_path ($g, "$configdir/software");
697 if (defined $softwaredir) {
698 _load_windows_registry ($g, $r, $softwaredir,
699 "HKEY_LOCAL_MACHINE\\SOFTWARE");
701 my $systemdir = resolve_windows_path ($g, "$configdir/system");
702 if (defined $systemdir) {
703 _load_windows_registry ($g, $r, $systemdir,
704 "HKEY_LOCAL_MACHINE\\System");
709 sub _load_windows_registry
717 my $dir = tempdir (CLEANUP => 1);
719 $g->download ($regfile, "$dir/reg");
721 # 'reged' command is particularly noisy. Redirect stdout and
722 # stderr to /dev/null temporarily.
723 open SAVEOUT, ">&STDOUT";
724 open SAVEERR, ">&STDERR";
725 open STDOUT, ">/dev/null";
726 open STDERR, ">/dev/null";
728 my @cmd = ("reged", "-x", "$dir/reg", "$prefix", "\\", "$dir/out");
729 my $res = system (@cmd);
733 open STDOUT, ">&SAVEOUT";
734 open STDERR, ">&SAVEERR";
739 warn "reged command failed: $?";
743 # Some versions of reged segfault on inputs. If that happens we
744 # may get no / partial output file. Anyway, if it exists, load
747 unless (open F, "$dir/out") {
748 warn "no output from reged command: $!";
751 { local $/ = undef; $content = <F>; }
755 @registry = @{$r->{registry}} if exists $r->{registry};
756 push @registry, $content;
757 $r->{registry} = \@registry;
766 # Grub version, if we care.
769 =head2 inspect_operating_systems
771 \%oses = inspect_operating_systems ($g, \%fses);
773 This function works out how partitions are related to each other. In
774 the case of a single-boot VM, we work out how the partitions are
775 mounted in respect of each other (eg. C</dev/sda1> is mounted as
776 C</boot>). In the case of a multi-boot VM where there are several
777 roots, we may identify several operating system roots, and mountpoints
780 This function returns a hashref C<\%oses> which at the top level looks
784 '/dev/VG/Root' => \%os,
787 (There can be multiple roots for a multi-boot VM).
789 The C<\%os> hash contains the following keys (any can be omitted):
795 Operating system type, eg. "linux", "windows".
799 Operating system distribution, eg. "debian".
803 Operating system version, eg. "4.0".
807 The value is a reference to the root partition C<%fs> hash.
811 The value is the name of the root partition (as a string).
816 The value is a hashref like this:
819 '/' => '/dev/VG/Root',
820 '/boot' => '/dev/sda1',
825 Filesystems (including swap devices and unmounted partitions).
826 The value is a hashref like this:
830 '/dev/VG/Root' => \%fs,
831 '/dev/VG/Swap' => \%fs,
838 sub inspect_operating_systems
846 foreach (sort keys %$fses) {
847 if ($fses->{$_}->{is_root}) {
852 _get_os_version ($g, \%r);
853 _assign_mount_points ($g, $fses, \%r);
867 $r->{os} = $r->{root}->{fsos} if exists $r->{root}->{fsos};
868 $r->{distro} = $r->{root}->{osdistro} if exists $r->{root}->{osdistro};
869 $r->{version} = $r->{root}->{osversion} if exists $r->{root}->{osversion};
872 sub _assign_mount_points
879 $r->{mounts} = { "/" => $r->{root_device} };
880 $r->{filesystems} = { $r->{root_device} => $r->{root} };
882 # Use /etc/fstab if we have it to mount the rest.
883 if (exists $r->{root}->{fstab}) {
884 my @fstab = @{$r->{root}->{fstab}};
886 my ($spec, $file) = @$_;
888 my ($dev, $fs) = _find_filesystem ($g, $fses, $spec);
890 $r->{mounts}->{$file} = $dev;
891 $r->{filesystems}->{$dev} = $fs;
892 if (exists $fs->{used}) {
903 # Find filesystem by device name, LABEL=.. or UUID=..
912 foreach (sort keys %$fses) {
913 if (exists $fses->{$_}->{label} &&
914 $fses->{$_}->{label} eq $label) {
915 return ($_, $fses->{$_});
918 warn "unknown filesystem label $label\n";
920 } elsif (/^UUID=(.*)/) {
922 foreach (sort keys %$fses) {
923 if (exists $fses->{$_}->{uuid} &&
924 $fses->{$_}->{uuid} eq $uuid) {
925 return ($_, $fses->{$_});
928 warn "unknown filesystem UUID $uuid\n";
931 return ($_, $fses->{$_}) if exists $fses->{$_};
933 # The following is to handle the case where an fstab entry specifies a
934 # specific device rather than its label or uuid, and the libguestfs
935 # appliance has named the device differently due to the use of a
937 # This will work as long as the underlying drivers recognise devices in
939 if (m{^/dev/hd(.*)} && exists $fses->{"/dev/sd$1"}) {
940 return ("/dev/sd$1", $fses->{"/dev/sd$1"});
942 if (m{^/dev/xvd(.*)} && exists $fses->{"/dev/sd$1"}) {
943 return ("/dev/sd$1", $fses->{"/dev/sd$1"});
945 if (m{^/dev/mapper/(.*)-(.*)$} && exists $fses->{"/dev/$1/$2"}) {
946 return ("/dev/$1/$2", $fses->{"/dev/$1/$2"});
949 return () if m{/dev/cdrom};
951 warn "unknown filesystem $_\n";
956 =head2 mount_operating_system
958 mount_operating_system ($g, \%os);
960 This function mounts the operating system described in the
961 C<%os> hash according to the C<mounts> table in that hash (see
962 C<inspect_operating_systems>).
964 The partitions are mounted read-only.
966 To reverse the effect of this call, use the standard
967 libguestfs API call C<$g-E<gt>umount_all ()>.
971 sub mount_operating_system
977 my $mounts = $os->{mounts};
979 # Have to mount / first. Luckily '/' is early in the ASCII
980 # character set, so this should be OK.
981 foreach (sort keys %$mounts) {
982 $g->mount_ro ($mounts->{$_}, $_)
983 if $_ ne "swap" && $_ ne "none" && ($_ eq '/' || $g->is_dir ($_));
987 =head2 inspect_in_detail
989 mount_operating_system ($g, \%os);
990 inspect_in_detail ($g, \%os);
993 The C<inspect_in_detail> function inspects the mounted operating
994 system for installed applications, installed kernels, kernel modules
997 It adds extra keys to the existing C<%os> hash reflecting what it
998 finds. These extra keys are:
1004 List of applications.
1010 =item modprobe_aliases
1013 The contents of the modprobe configuration.
1015 =item initrd_modules
1018 The kernel modules installed in the initrd. The value is
1019 a hashref of kernel version to list of modules.
1025 sub inspect_in_detail
1031 _check_for_applications ($g, $os);
1032 _check_for_kernels ($g, $os);
1033 if ($os->{os} eq "linux") {
1034 _check_for_modprobe_aliases ($g, $os);
1035 _check_for_initrd ($g, $os);
1039 sub _check_for_applications
1047 my $osn = $os->{os};
1048 if ($osn eq "linux") {
1049 my $distro = $os->{distro};
1050 if (defined $distro && ($distro eq "redhat" || $distro eq "fedora")) {
1051 my @lines = $g->command_lines
1054 "--qf", "%{name} %{epoch} %{version} %{release} %{arch}\n"]);
1056 if (m/^(.*) (.*) (.*) (.*) (.*)$/) {
1058 $epoch = "" if $epoch eq "(none)";
1070 } elsif ($osn eq "windows") {
1072 # I worked out a general plan for this, but haven't
1073 # implemented it yet. We can iterate over /Program Files
1074 # looking for *.EXE files, which we download, then use
1075 # i686-pc-mingw32-windres on, to find the VERSIONINFO
1076 # section, which has a lot of useful information.
1079 $os->{apps} = \@apps;
1082 sub _check_for_kernels
1090 my $osn = $os->{os};
1091 if ($osn eq "linux") {
1092 # Installed kernels will have a corresponding /lib/modules/<version>
1093 # directory, which is the easiest way to find out what kernels
1094 # are installed, and what modules are available.
1095 foreach ($g->ls ("/lib/modules")) {
1096 if ($g->is_dir ("/lib/modules/$_")) {
1098 $kernel{version} = $_;
1102 foreach ($g->find ("/lib/modules/$_")) {
1103 if (m,/([^/]+)\.ko$, || m,([^/]+)\.o$,) {
1108 $kernel{modules} = \@modules;
1110 push @kernels, \%kernel;
1114 } elsif ($osn eq "windows") {
1118 $os->{kernels} = \@kernels;
1121 # Check /etc/modprobe.conf to see if there are any specified
1122 # drivers associated with network (ethX) or hard drives. Normally
1123 # one might find something like:
1126 # alias scsi_hostadapter xenblk
1128 # XXX This doesn't look beyond /etc/modprobe.conf, eg. in /etc/modprobe.d/
1130 sub _check_for_modprobe_aliases
1138 $success = $g->aug_init("/", 16);
1140 # Register /etc/modules.conf and /etc/conf.modules to the Modprobe lens
1142 @results = $g->aug_match("/augeas/load/Modprobe/incl");
1144 # Calculate the next index of /augeas/load/Modprobe/incl
1146 foreach ( @results ) {
1147 next unless m{/augeas/load/Modprobe/incl\[(\d*)]};
1148 $i = $1 + 1 if ($1 == $i);
1151 $success = $g->aug_set("/augeas/load/Modprobe/incl[$i]",
1152 "/etc/modules.conf");
1154 $success = $g->aug_set("/augeas/load/Modprobe/incl[$i]",
1155 "/etc/conf.modules");
1157 # Make augeas reload
1158 $success = $g->aug_load();
1160 my %modprobe_aliases;
1162 for my $pattern qw(/files/etc/conf.modules/alias
1163 /files/etc/modules.conf/alias
1164 /files/etc/modprobe.conf/alias
1165 /files/etc/modprobe.d/*/alias) {
1166 @results = $g->aug_match($pattern);
1168 for my $path ( @results ) {
1169 $path =~ m{^/files(.*)/alias(?:\[\d*\])?$}
1170 or die("$path doesn't match augeas pattern");
1174 $alias = $g->aug_get($path);
1177 $modulename = $g->aug_get($path.'/modulename');
1180 $aliasinfo{modulename} = $modulename;
1181 $aliasinfo{augeas} = $path;
1182 $aliasinfo{file} = $file;
1184 $modprobe_aliases{$alias} = \%aliasinfo;
1188 $os->{modprobe_aliases} = \%modprobe_aliases;
1191 # Get a listing of device drivers in any initrd corresponding to a
1192 # kernel. This is an indication of what can possibly be booted.
1194 sub _check_for_initrd
1202 foreach my $initrd ($g->ls ("/boot")) {
1203 if ($initrd =~ m/^initrd-(.*)\.img$/ && $g->is_file ("/boot/$initrd")) {
1208 @modules = $g->initrd_list ("/boot/$initrd");
1211 @modules = grep { m,([^/]+)\.ko$, || m,([^/]+)\.o$, } @modules;
1212 $initrd_modules{$version} = \@modules
1214 warn "/boot/$initrd: could not read initrd format"
1219 $os->{initrd_modules} = \%initrd_modules;
1227 Copyright (C) 2009 Red Hat Inc.
1231 Please see the file COPYING.LIB for the full license.
1235 L<virt-inspector(1)>,
1238 L<http://libguestfs.org/>,
1240 L<http://libvirt.org/>,