2 # Copyright (C) 2009-2010 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;
23 # The minor part of this version number is incremented when some
24 # change is made to this module. The major part is incremented if we
25 # make a change which is not backwards compatible. It is not related
26 # to the libguestfs version number.
27 use vars qw($VERSION);
33 use File::Temp qw/tempdir/;
34 use Locale::TextDomain 'libguestfs';
37 eval "use Sys::Virt;";
38 eval "use XML::XPath;";
39 eval "use XML::XPath::XMLParser;";
40 eval "use Win::Hivex;";
46 Sys::Guestfs::Lib - Useful functions for using libguestfs from Perl
50 use Sys::Guestfs::Lib qw(open_guest ...);
52 $g = open_guest ($name);
56 C<Sys::Guestfs::Lib> is an extra library of useful functions for using
57 the libguestfs API from Perl. It also provides tighter integration
60 The basic libguestfs API is not covered by this manpage. Please refer
61 instead to L<Sys::Guestfs(3)> and L<guestfs(3)>. The libvirt API is
62 also not covered. For that, see L<Sys::Virt(3)>.
64 =head1 DEPRECATION OF SOME FUNCTIONS
66 This module contains functions and code to perform inspection of guest
67 images. Since libguestfs 1.5.3 this ability has moved into the core
68 API (see L<guestfs(3)/INSPECTION>). The inspection functions in this
69 module are deprecated and will not be updated. Each deprecated
70 function is marked in the documentation below.
72 =head1 BASIC FUNCTIONS
78 use vars qw(@EXPORT_OK @ISA);
81 @EXPORT_OK = qw(open_guest feature_available
82 get_partitions resolve_windows_path
83 inspect_all_partitions inspect_partition
84 inspect_operating_systems mount_operating_system inspect_in_detail
85 inspect_linux_kernel);
89 $g = open_guest ($name);
91 $g = open_guest ($name, rw => 1, ...);
93 $g = open_guest ($name, address => $uri, ...);
95 $g = open_guest ([$img1, $img2, ...], address => $uri, format => $format, ...);
97 ($g, $conn, $dom, @images) = open_guest ($name);
99 This function opens a libguestfs handle for either the libvirt domain
100 called C<$name>, or the disk image called C<$name>. Any disk images
101 found through libvirt or specified explicitly are attached to the
104 The C<Sys::Guestfs> handle C<$g> is returned, or if there was an error
105 it throws an exception. To catch errors, wrap the call in an eval
108 The first parameter is either a string referring to a libvirt domain
109 or a disk image, or (if a guest has several disk images) an arrayref
110 C<[$img1, $img2, ...]>. For disk images, if the C<format> parameter
111 is specified then that format is forced.
113 The handle is I<read-only> by default. Use the optional parameter
114 C<rw =E<gt> 1> to open a read-write handle. However if you open a
115 read-write handle, this function will refuse to use active libvirt
118 The handle is still in the config state when it is returned, so you
119 have to call C<$g-E<gt>launch ()>.
121 The optional C<address> parameter can be added to specify the libvirt
124 The implicit libvirt handle is closed after this function, I<unless>
125 you call the function in C<wantarray> context, in which case the
126 function returns a tuple of: the open libguestfs handle, the open
127 libvirt handle, and the open libvirt domain handle, and a list of
128 [image,format] pairs. (This is useful if you want to do other things
129 like pulling the XML description of the guest). Note that if this is
130 a straight disk image, then C<$conn> and C<$dom> will be C<undef>.
132 If the C<Sys::Virt> module is not available, then libvirt is bypassed,
133 and this function can only open disk images.
135 The optional C<interface> parameter can be used to open devices with a
136 specified qemu interface. See L<Sys::Guestfs/guestfs_add_drive_opts>
147 my $rw = $params{rw};
148 my $address = $params{address};
149 my $interface = $params{interface};
150 my $format = $params{format}; # undef == autodetect
153 if (ref ($first) eq "ARRAY") {
155 } elsif (ref ($first) eq "SCALAR") {
158 croak __"open_guest: first parameter must be a string or an arrayref"
161 # Check each element of @images is defined.
162 # (See https://bugzilla.redhat.com/show_bug.cgi?id=601092#c3).
164 croak __"open_guest: first argument contains undefined element"
172 croak __x("guest image {imagename} does not exist or is not readable",
177 @images = map { [ $_, $format ] } @images;
179 die __"open_guest: no libvirt support (install Sys::Virt, XML::XPath and XML::XPath::XMLParser)"
180 unless exists $INC{"Sys/Virt.pm"} &&
181 exists $INC{"XML/XPath.pm"} &&
182 exists $INC{"XML/XPath/XMLParser.pm"};
184 die __"open_guest: too many domains listed on command line"
187 my @libvirt_args = ();
188 push @libvirt_args, address => $address if defined $address;
190 $conn = Sys::Virt->new (readonly => 1, @libvirt_args);
191 die __"open_guest: cannot connect to libvirt" unless $conn;
193 my @doms = $conn->list_defined_domains ();
194 my $isitinactive = 1;
196 # In the case where we want read-only access to a domain,
197 # allow the user to specify an active domain too.
198 push @doms, $conn->list_domains ();
202 if ($_->get_name () eq $images[0]) {
210 die __x("{imagename} is not the name of an inactive libvirt domain\n",
211 imagename => $images[0]);
213 die __x("{imagename} is not the name of a libvirt domain\n",
214 imagename => $images[0]);
218 # Get the names of the image(s).
219 my $xml = $dom->get_xml_description ();
221 my $p = XML::XPath->new (xml => $xml);
222 my $nodes = $p->find ('//devices/disk');
226 foreach $node ($nodes->get_nodelist) {
227 # The filename can be in dev or file attribute, hence:
228 my $filename = $p->find ('./source/@dev', $node);
230 $filename = $p->find ('./source/@file', $node);
231 next unless $filename;
233 $filename = $filename->to_literal;
235 # Get the disk format (may not be set).
236 my $format = $p->find ('./driver/@type', $node);
237 $format = $format->to_literal if $format;
239 push @disks, [ $filename, $format ];
242 die __x("{imagename} seems to have no disk devices\n",
243 imagename => $images[0])
249 # We've now got the list of @images, so feed them to libguestfs.
250 my $g = Sys::Guestfs->new ();
252 my @args = ($_->[0]);
253 push @args, format => $_->[1] if defined $_->[1];
254 push @args, readonly => 1 unless $rw;
255 push @args, iface => $interface if defined $interface;
256 $g->add_drive_opts (@args);
259 return wantarray ? ($g, $conn, $dom, @images) : $g
262 =head2 feature_available
264 $bool = feature_available ($g, $feature [, $feature ...]);
266 This function is a useful wrapper around the basic
267 C<$g-E<gt>available> call.
269 C<$g-E<gt>available> tests for availability of a list of features and
270 dies with an error if any is not available.
272 This call tests for the list of features and returns true if all are
273 available, or false otherwise.
275 For a list of features you can test for, see L<guestfs(3)/AVAILABILITY>.
279 sub feature_available {
282 eval { $g->available (\@_); };
286 =head2 get_partitions
288 @partitions = get_partitions ($g);
290 This function takes an open libguestfs handle C<$g> and returns all
291 partitions and logical volumes found on it.
293 What is returned is everything that could contain a filesystem (or
294 swap). Physical volumes are not normally included from the list
295 except if they contain a filesystem directly. Nor are devices which
296 are partitioned (eg. C</dev/sda> would not be returned if C</dev/sda1>
306 # Look to see if any devices directly contain filesystems (RHBZ#590167).
307 my @devices = $g->list_devices ();
308 my @fses_on_device = ();
310 eval { $g->mount_ro ($_, "/"); };
311 push @fses_on_device, $_ unless $@;
315 my @partitions = $g->list_partitions ();
316 my @pvs = $g->pvs ();
317 @partitions = grep { ! _is_pv ($_, @pvs) } @partitions;
320 @lvs = $g->lvs () if feature_available ($g, "lvm2");
322 return sort (@fses_on_device, @lvs, @partitions);
330 return 1 if $_ eq $t;
335 =head2 resolve_windows_path
337 $path = resolve_windows_path ($g, $path);
339 $path = resolve_windows_path ($g, "/windows/system");
340 ==> "/WINDOWS/System"
341 or undef if no path exists
343 This function, which is specific to FAT/NTFS filesystems (ie. Windows
344 guests), lets you look up a case insensitive C<$path> in the
345 filesystem and returns the true, case sensitive path as required by
346 the underlying kernel or NTFS-3g driver.
348 If C<$path> does not exist then this function returns C<undef>.
350 The C<$path> parameter must begin with C</> character and be separated
351 by C</> characters. Do not use C<\>, drive names, etc.
355 sub resolve_windows_path
361 eval { $r = $g->case_sensitive_path ($path); };
365 =head2 file_architecture
367 Deprecated function. Replace any calls to this function with:
369 $g->file_architecture ($path);
373 sub file_architecture
378 return $g->file_architecture ($path);
381 =head1 OPERATING SYSTEM INSPECTION FUNCTIONS
383 =head2 inspect_all_partitions
385 This function is deprecated. It will not be updated in future
386 versions of libguestfs. New code should not use this function. Use
387 the core API functions instead, see L<guestfs(3)/INSPECTION>.
391 # Turn /dev/vd* and /dev/hd* into canonical device names
392 # (see BLOCK DEVICE NAMING in guestfs(3)).
394 sub _canonical_dev ($)
397 return "/dev/sd$1" if $dev =~ m{^/dev/[vh]d(\w+)};
401 sub inspect_all_partitions
407 return map { _canonical_dev ($_) => inspect_partition ($g, $_) } @parts;
410 =head2 inspect_partition
412 This function is deprecated. It will not be updated in future
413 versions of libguestfs. New code should not use this function. Use
414 the core API functions instead, see L<guestfs(3)/INSPECTION>.
418 sub inspect_partition
422 my $dev = shift; # LV or partition name.
424 my %r; # Result hash.
426 # First try 'file(1)' on it.
427 my $file = $g->file ($dev);
428 if ($file =~ /ext2 filesystem data/) {
431 } elsif ($file =~ /ext3 filesystem data/) {
434 } elsif ($file =~ /ext4 filesystem data/) {
437 } elsif ($file =~ m{Linux/i386 swap file}) {
443 # If it's ext2/3/4, then we want the UUID and label.
444 if (exists $r{fstype} && $r{fstype} =~ /^ext/) {
445 $r{uuid} = $g->get_e2uuid ($dev);
446 $r{label} = $g->get_e2label ($dev);
449 # Try mounting it, fnarrr.
451 $r{is_mountable} = 1;
452 eval { $g->mount_ro ($dev, "/") };
454 # It's not mountable, probably empty or some format
455 # we don't understand.
456 $r{is_mountable} = 0;
461 if ($g->is_file ("/grub/menu.lst") ||
462 $g->is_file ("/grub/grub.conf")) {
463 $r{content} = "linux-grub";
464 _check_grub ($g, \%r);
469 if ($g->is_dir ("/etc") && $g->is_dir ("/bin") &&
470 $g->is_file ("/etc/fstab")) {
471 $r{content} = "linux-root";
473 _check_linux_root ($g, \%r);
478 if ($g->is_dir ("/etc") && $g->is_dir ("/bin") &&
479 $g->is_dir ("/share") && !$g->exists ("/local") &&
480 !$g->is_file ("/etc/fstab")) {
481 $r{content} = "linux-usrlocal";
486 if ($g->is_dir ("/etc") && $g->is_dir ("/bin") &&
487 $g->is_dir ("/share") && $g->exists ("/local") &&
488 !$g->is_file ("/etc/fstab")) {
489 $r{content} = "linux-usr";
494 if ($g->is_file ("/AUTOEXEC.BAT") ||
495 $g->is_file ("/autoexec.bat") ||
496 $g->is_dir ("/Program Files") ||
497 $g->is_dir ("/WINDOWS") ||
498 $g->is_file ("/boot.ini") ||
499 $g->is_file ("/ntldr")) {
500 $r{fstype} = "ntfs"; # XXX this is a guess
501 $r{fsos} = "windows";
502 $r{content} = "windows-root";
504 _check_windows_root ($g, \%r);
514 sub _check_linux_root
520 # Look into /etc to see if we recognise the operating system.
521 # N.B. don't use $g->is_file here, because it might be a symlink
522 if ($g->exists ("/etc/redhat-release")) {
523 $r->{package_format} = "rpm";
525 $_ = $g->cat ("/etc/redhat-release");
526 if (/Fedora release (\d+)(?:\.(\d+))?/) {
527 chomp; $r->{product_name} = $_;
528 $r->{osdistro} = "fedora";
529 $r->{os_major_version} = "$1";
530 $r->{os_minor_version} = "$2" if(defined($2));
531 $r->{package_management} = "yum";
534 elsif (/(Red Hat Enterprise Linux|CentOS|Scientific Linux)/) {
535 chomp; $r->{product_name} = $_;
539 if($distro eq "Red Hat Enterprise Linux") {
540 $r->{osdistro} = "rhel";
543 elsif($distro eq "CentOS") {
544 $r->{osdistro} = "centos";
545 $r->{package_management} = "yum";
548 elsif($distro eq "Scientific Linux") {
549 $r->{osdistro} = "scientific";
550 $r->{package_management} = "yum";
553 # Shouldn't be possible
556 if (/$distro.*release (\d+).*Update (\d+)/) {
557 $r->{os_major_version} = "$1";
558 $r->{os_minor_version} = "$2";
561 elsif (/$distro.*release (\d+)(?:\.(\d+))?/) {
562 $r->{os_major_version} = "$1";
565 $r->{os_minor_version} = "$2";
567 $r->{os_minor_version} = "0";
571 # Package management in RHEL changed in version 5
572 if ($r->{osdistro} eq "rhel") {
573 if ($r->{os_major_version} >= 5) {
574 $r->{package_management} = "yum";
576 $r->{package_management} = "rhn";
582 $r->{osdistro} = "redhat-based";
584 } elsif ($g->is_file ("/etc/debian_version")) {
585 $r->{package_format} = "deb";
586 $r->{package_management} = "apt";
588 $_ = $g->cat ("/etc/debian_version");
589 if (/(\d+)\.(\d+)/) {
590 chomp; $r->{product_name} = $_;
591 $r->{osdistro} = "debian";
592 $r->{os_major_version} = "$1";
593 $r->{os_minor_version} = "$2";
595 $r->{osdistro} = "debian";
599 # Parse the contents of /etc/fstab. This is pretty vital so
600 # we can determine where filesystems are supposed to be mounted.
601 eval "\$_ = \$g->cat ('/etc/fstab');";
603 my @lines = split /\n/;
606 my @fields = split /[ \t]+/;
608 my $spec = $fields[0]; # first column (dev/label/uuid)
609 my $file = $fields[1]; # second column (mountpoint)
610 if ($spec =~ m{^/} ||
611 $spec =~ m{^LABEL=} ||
612 $spec =~ m{^UUID=} ||
614 push @fstab, [$spec, $file]
618 $r->{fstab} = \@fstab if @fstab;
621 # Determine the architecture of this root.
623 foreach ("/bin/bash", "/bin/ls", "/bin/echo", "/bin/rm", "/bin/sh") {
624 if ($g->is_file ($_)) {
625 $arch = file_architecture ($g, $_);
630 $r->{arch} = $arch if defined $arch;
633 # We only support NT. The control file /boot.ini contains a list of
634 # Windows installations and their %systemroot%s in a simple text
637 # XXX We don't handle the case where /boot.ini is on a different
638 # partition very well (Windows Vista and later).
640 sub _check_windows_root
646 my $boot_ini = resolve_windows_path ($g, "/boot.ini");
647 $r->{boot_ini} = $boot_ini;
650 if (defined $r->{boot_ini}) {
651 $_ = $g->cat ($boot_ini);
652 my @lines = split /\n/;
657 } elsif (m/^default=.*?\\(\w+)$/i) {
660 } elsif (m/\\(\w+)=/) {
667 if (!defined $systemroot) {
668 # Last ditch ... try to guess %systemroot% location.
669 foreach ("windows", "winnt") {
670 my $dir = resolve_windows_path ($g, "/$_/system32");
678 if (defined $systemroot) {
679 $r->{systemroot} = resolve_windows_path ($g, "/$systemroot");
680 if (defined $r->{systemroot}) {
681 _check_windows_arch ($g, $r, $r->{systemroot});
682 _check_windows_registry ($g, $r, $r->{systemroot});
687 # Find Windows userspace arch.
689 sub _check_windows_arch
694 my $systemroot = shift;
697 resolve_windows_path ($g, $r->{systemroot} . "/system32/cmd.exe");
698 $r->{arch} = file_architecture ($g, $cmd_exe) if $cmd_exe;
701 sub _check_windows_registry
706 my $systemroot = shift;
708 # Download the system registry files. Only download the
709 # interesting ones (SOFTWARE and SYSTEM). We don't bother with
712 return unless exists $INC{"Win/Hivex.pm"};
714 my $configdir = resolve_windows_path ($g, "$systemroot/system32/config");
715 return unless defined $configdir;
717 my $tmpdir = tempdir (CLEANUP => 1);
719 my $software = resolve_windows_path ($g, "$configdir/software");
721 if (defined $software) {
723 $g->download ($software, "$tmpdir/software");
724 $software_hive = Win::Hivex->open ("$tmpdir/software");
727 $r->{windows_software_hive} = $software;
730 my $system = resolve_windows_path ($g, "$configdir/system");
732 if (defined $system) {
734 $g->download ($system, "$tmpdir/system");
735 $system_hive = Win::Hivex->open ("$tmpdir/system");
738 $r->{windows_system_hive} = $system;
741 # Get the ProductName, major and minor version, etc.
742 if (defined $software_hive) {
745 $cv_node = $software_hive->root;
746 $cv_node = $software_hive->node_get_child ($cv_node, $_)
747 foreach ("Microsoft", "Windows NT", "CurrentVersion");
752 my @values = $software_hive->node_values ($cv_node);
755 my $k = $software_hive->value_key ($_);
756 if ($k eq "ProductName") {
757 $_ = $software_hive->value_string ($_);
758 $r->{product_name} = $_ if defined $_;
759 } elsif ($k eq "CurrentVersion") {
760 $_ = $software_hive->value_string ($_);
761 if (defined $_ && m/^(\d+)\.(\d+)/) {
762 $r->{os_major_version} = $1;
763 $r->{os_minor_version} = $2;
765 } elsif ($k eq "CurrentBuild") {
766 $_ = $software_hive->value_string ($_);
767 $r->{windows_current_build} = $_ if defined $_;
768 } elsif ($k eq "SoftwareType") {
769 $_ = $software_hive->value_string ($_);
770 $r->{windows_software_type} = $_ if defined $_;
771 } elsif ($k eq "CurrentType") {
772 $_ = $software_hive->value_string ($_);
773 $r->{windows_current_type} = $_ if defined $_;
774 } elsif ($k eq "RegisteredOwner") {
775 $_ = $software_hive->value_string ($_);
776 $r->{windows_registered_owner} = $_ if defined $_;
777 } elsif ($k eq "RegisteredOrganization") {
778 $_ = $software_hive->value_string ($_);
779 $r->{windows_registered_organization} = $_ if defined $_;
780 } elsif ($k eq "InstallationType") {
781 $_ = $software_hive->value_string ($_);
782 $r->{windows_installation_type} = $_ if defined $_;
783 } elsif ($k eq "EditionID") {
784 $_ = $software_hive->value_string ($_);
785 $r->{windows_edition_id} = $_ if defined $_;
786 } elsif ($k eq "ProductID") {
787 $_ = $software_hive->value_string ($_);
788 $r->{windows_product_id} = $_ if defined $_;
801 # Grub version, if we care.
804 =head2 inspect_operating_systems
806 This function is deprecated. It will not be updated in future
807 versions of libguestfs. New code should not use this function. Use
808 the core API functions instead, see L<guestfs(3)/INSPECTION>.
812 sub inspect_operating_systems
820 foreach (sort keys %$fses) {
821 if ($fses->{$_}->{is_root}) {
826 _get_os_version ($g, \%r);
827 _assign_mount_points ($g, $fses, \%r);
832 # If we didn't find any operating systems then it's an error (RHBZ#591142).
833 if (0 == keys %oses) {
834 die __"No operating system could be detected inside this disk image.\n\nThis may be because the file is not a disk image, or is not a virtual machine\nimage, or because the OS type is not understood by virt-inspector.\n\nIf you feel this is an error, please file a bug report including as much\ninformation about the disk image as possible.\n";
846 $r->{os} = $r->{root}->{fsos} if exists $r->{root}->{fsos};
847 $r->{product_name} = $r->{root}->{product_name}
848 if exists $r->{root}->{product_name};
849 $r->{distro} = $r->{root}->{osdistro} if exists $r->{root}->{osdistro};
850 $r->{major_version} = $r->{root}->{os_major_version}
851 if exists $r->{root}->{os_major_version};
852 $r->{minor_version} = $r->{root}->{os_minor_version}
853 if exists $r->{root}->{os_minor_version};
854 $r->{package_format} = $r->{root}->{package_format}
855 if exists $r->{root}->{package_format};
856 $r->{package_management} = $r->{root}->{package_management}
857 if exists $r->{root}->{package_management};
858 $r->{arch} = $r->{root}->{arch} if exists $r->{root}->{arch};
861 sub _assign_mount_points
868 $r->{mounts} = { "/" => $r->{root_device} };
869 $r->{filesystems} = { $r->{root_device} => $r->{root} };
871 # Use /etc/fstab if we have it to mount the rest.
872 if (exists $r->{root}->{fstab}) {
873 my @fstab = @{$r->{root}->{fstab}};
875 my ($spec, $file) = @$_;
877 my ($dev, $fs) = _find_filesystem ($g, $fses, $spec);
879 $r->{mounts}->{$file} = $dev;
880 $r->{filesystems}->{$dev} = $fs;
881 if (exists $fs->{used}) {
892 # Find filesystem by device name, LABEL=.. or UUID=..
901 foreach (sort keys %$fses) {
902 if (exists $fses->{$_}->{label} &&
903 $fses->{$_}->{label} eq $label) {
904 return ($_, $fses->{$_});
907 warn __x("unknown filesystem label {label}\n", label => $label);
909 } elsif (/^UUID=(.*)/) {
911 foreach (sort keys %$fses) {
912 if (exists $fses->{$_}->{uuid} &&
913 $fses->{$_}->{uuid} eq $uuid) {
914 return ($_, $fses->{$_});
917 warn __x("unknown filesystem UUID {uuid}\n", uuid => $uuid);
920 return ($_, $fses->{$_}) if exists $fses->{$_};
922 # The following is to handle the case where an fstab entry specifies a
923 # specific device rather than its label or uuid, and the libguestfs
924 # appliance has named the device differently due to the use of a
926 # This will work as long as the underlying drivers recognise devices in
928 if (m{^/dev/hd(.*)} && exists $fses->{"/dev/sd$1"}) {
929 return ("/dev/sd$1", $fses->{"/dev/sd$1"});
931 if (m{^/dev/xvd(.*)} && exists $fses->{"/dev/sd$1"}) {
932 return ("/dev/sd$1", $fses->{"/dev/sd$1"});
934 if (m{^/dev/mapper/(.*)-(.*)$} && exists $fses->{"/dev/$1/$2"}) {
935 return ("/dev/$1/$2", $fses->{"/dev/$1/$2"});
938 return () if m{/dev/cdrom};
940 warn __x("unknown filesystem {fs}\n", fs => $_);
945 =head2 mount_operating_system
947 This function is deprecated. It will not be updated in future
948 versions of libguestfs. New code should not use this function. Use
949 the core API functions instead, see L<guestfs(3)/INSPECTION>.
953 sub mount_operating_system
958 my $ro = shift; # Read-only?
960 $ro = 1 unless defined $ro; # ro defaults to 1 if unspecified
962 my $mounts = $os->{mounts};
964 # Have to mount / first. Luckily '/' is early in the ASCII
965 # character set, so this should be OK.
966 foreach (sort keys %$mounts) {
967 if($_ ne "swap" && $_ ne "none" && ($_ eq '/' || $g->is_dir ($_))) {
969 $g->mount_ro ($mounts->{$_}, $_)
971 $g->mount_options ("", $mounts->{$_}, $_)
977 =head2 inspect_in_detail
979 This function is deprecated. It will not be updated in future
980 versions of libguestfs. New code should not use this function. Use
981 the core API functions instead, see L<guestfs(3)/INSPECTION>.
985 sub inspect_in_detail
991 _check_for_applications ($g, $os);
992 _check_for_kernels ($g, $os);
993 if ($os->{os} eq "linux") {
994 _find_modprobe_aliases ($g, $os);
998 sub _check_for_applications
1006 my $osn = $os->{os};
1007 if ($osn eq "linux") {
1008 my $package_format = $os->{package_format};
1009 if (defined $package_format && $package_format eq "rpm") {
1012 @lines = $g->command_lines
1015 "%{name} %{epoch} %{version} %{release} %{arch}\n"]);
1018 warn(__x("Error running rpm -qa: {error}", error => $@)) if ($@);
1020 @lines = sort @lines;
1022 if (m/^(.*) (.*) (.*) (.*) (.*)$/) {
1024 undef $epoch if $epoch eq "(none)";
1035 } elsif (defined $package_format && $package_format eq "deb") {
1038 @lines = $g->command_lines
1040 "-f", '${Package} ${Version} ${Architecture} ${Status}\n',
1044 warn(__x("Error running dpkg-query: {error}", error => $@)) if ($@);
1046 @lines = sort @lines;
1048 if (m/^(.*) (.*) (.*) (.*) (.*) (.*)$/) {
1049 if ( $6 eq "installed" ) {
1060 } elsif ($osn eq "windows") {
1062 # I worked out a general plan for this, but haven't
1063 # implemented it yet. We can iterate over /Program Files
1064 # looking for *.EXE files, which we download, then use
1065 # i686-pc-mingw32-windres on, to find the VERSIONINFO
1066 # section, which has a lot of useful information.
1069 $os->{apps} = \@apps;
1072 # Find the path which needs to be prepended to paths in grub.conf to make them
1074 sub _find_grub_prefix
1078 my $fses = $os->{filesystems};
1079 die("filesystems undefined") unless(defined($fses));
1081 # Look for the filesystem which contains grub
1083 foreach my $dev (keys(%$fses)) {
1084 my $fsinfo = $fses->{$dev};
1085 if(exists($fsinfo->{content}) && $fsinfo->{content} eq "linux-grub") {
1091 my $mounts = $os->{mounts};
1092 die("mounts undefined") unless(defined($mounts));
1094 # Find where the filesystem is mounted
1095 if(defined($grubdev)) {
1096 foreach my $mount (keys(%$mounts)) {
1097 if($mounts->{$mount} eq $grubdev) {
1098 return "" if($mount eq '/');
1103 die("$grubdev defined in filesystems, but not in mounts");
1106 # If we didn't find it, look for /boot/grub/menu.lst, then try to work out
1107 # what filesystem it's on. We use menu.lst rather than grub.conf because
1108 # debian only uses menu.lst, and anaconda creates a symlink for it.
1109 die(__"Can't find grub on guest") unless($g->exists('/boot/grub/menu.lst'));
1111 # Look for the most specific mount point in mounts
1112 foreach my $path qw(/boot/grub /boot /) {
1113 if(exists($mounts->{$path})) {
1114 return "" if($path eq '/');
1119 die("Couldn't determine which filesystem holds /boot/grub/menu.lst");
1122 sub _check_for_kernels
1126 if ($os->{os} eq "linux" && feature_available ($g, "augeas")) {
1127 # Iterate over entries in grub.conf, populating $os->{boot}
1128 # For every kernel we find, inspect it and add to $os->{kernels}
1130 my $grub = _find_grub_prefix($g, $os);
1131 my $grub_conf = "/etc/grub.conf";
1133 # Debian and other's have no /etc/grub.conf:
1134 if ( ! -f "$grub_conf" ) {
1135 $grub_conf = "$grub/grub/menu.lst";
1144 # ->{title} = "Fedora (2.6.29.6-213.fc11.i686.PAE)"
1145 # ->{kernel} = \kernel
1146 # ->{cmdline} = "ro root=/dev/mapper/vg_mbooth-lv_root rhgb"
1147 # ->{initrd} = \initrd
1148 # ->{default} = \config
1149 # ->{grub_fs} = "/boot"
1151 $g->aug_init("/", 16);
1154 # Get all configurations from grub
1155 foreach my $bootable
1156 ($g->aug_match("/files/$grub_conf/title"))
1159 $config{title} = $g->aug_get($bootable);
1162 eval { $grub_kernel = $g->aug_get("$bootable/kernel"); };
1164 warn __x("Grub entry {title} has no kernel",
1165 title => $config{title});
1168 # Check we've got a kernel entry
1169 if(defined($grub_kernel)) {
1170 my $path = "$grub$grub_kernel";
1172 # Reconstruct the kernel command line
1174 foreach my $arg ($g->aug_match("$bootable/kernel/*")) {
1175 $arg =~ m{/kernel/([^/]*)$}
1176 or die("Unexpected return from aug_match: $arg");
1180 eval { $value = $g->aug_get($arg); };
1182 if(defined($value)) {
1183 push(@args, "$name=$value");
1188 $config{cmdline} = join(' ', @args) if(scalar(@args) > 0);
1191 if ($g->exists($path)) {
1193 inspect_linux_kernel($g, $path, $os->{package_format});
1195 warn __x("grub refers to {path}, which doesn't exist\n",
1199 # Check the kernel was recognised
1200 if(defined($kernel)) {
1201 # Put this kernel on the top level kernel list
1202 $os->{kernels} ||= [];
1203 push(@{$os->{kernels}}, $kernel);
1205 $config{kernel} = $kernel;
1207 # Look for an initrd entry
1210 $initrd = $g->aug_get("$bootable/initrd");
1215 _inspect_initrd($g, $os, "$grub$initrd",
1216 $kernel->{version});
1218 warn __x("Grub entry {title} does not specify an ".
1219 "initrd", title => $config{title});
1224 push(@configs, \%config);
1228 # Create the top level boot entry
1230 $boot{configs} = \@configs;
1231 $boot{grub_fs} = $grub;
1233 # Add the default configuration
1235 $boot{default} = $g->aug_get("/files/$grub_conf/default");
1238 $os->{boot} = \%boot;
1241 elsif ($os->{os} eq "windows") {
1246 =head2 inspect_linux_kernel
1248 This function is deprecated. It will not be updated in future
1249 versions of libguestfs. New code should not use this function. Use
1250 the core API functions instead, see L<guestfs(3)/INSPECTION>.
1254 sub inspect_linux_kernel
1256 my ($g, $path, $package_format) = @_;
1260 $kernel{path} = $path;
1262 # If this is a packaged kernel, try to work out the name of the package
1263 # which installed it. This lets us know what to install to replace it with,
1264 # e.g. kernel, kernel-smp, kernel-hugemem, kernel-PAE
1265 if($package_format eq "rpm") {
1267 eval { $package = $g->command(['rpm', '-qf', '--qf',
1268 '%{NAME}', $path]); };
1269 $kernel{package} = $package if defined($package);;
1272 # Try to get the kernel version by running file against it
1274 my $filedesc = $g->file($path);
1275 if($filedesc =~ /^$path: Linux kernel .*\bversion\s+(\S+)\b/) {
1279 # Sometimes file can't work out the kernel version, for example because it's
1280 # a Xen PV kernel. In this case try to guess the version from the filename
1282 if($path =~ m{/boot/vmlinuz-(.*)}) {
1285 # Check /lib/modules/$version exists
1286 if(!$g->is_dir("/lib/modules/$version")) {
1287 warn __x("Didn't find modules directory {modules} for kernel ".
1288 "{path}", modules => "/lib/modules/$version",
1295 warn __x("Couldn't guess kernel version number from path for ".
1296 "kernel {path}", path => $path);
1303 $kernel{version} = $version;
1308 my $prefix = "/lib/modules/$version";
1309 foreach my $module ($g->find ($prefix)) {
1310 if ($module =~ m{/([^/]+)\.(?:ko|o)$}) {
1311 $any_module = "$prefix$module" unless defined $any_module;
1316 $kernel{modules} = \@modules;
1318 # Determine kernel architecture by looking at the arch
1319 # of any kernel module.
1320 $kernel{arch} = file_architecture ($g, $any_module);
1325 # Find all modprobe aliases. Specifically, this looks in the following
1327 # * /etc/conf.modules
1328 # * /etc/modules.conf
1329 # * /etc/modprobe.conf
1330 # * /etc/modprobe.d/*
1332 sub _find_modprobe_aliases
1339 $g->aug_init("/", 16);
1341 my %modprobe_aliases;
1343 for my $pattern qw(/files/etc/conf.modules/alias
1344 /files/etc/modules.conf/alias
1345 /files/etc/modprobe.conf/alias
1346 /files/etc/modprobe.d/*/alias) {
1347 for my $path ( $g->aug_match($pattern) ) {
1348 $path =~ m{^/files(.*)/alias(?:\[\d*\])?$}
1349 or die __x("{path} doesn't match augeas pattern",
1354 $alias = $g->aug_get($path);
1357 $modulename = $g->aug_get($path.'/modulename');
1360 $aliasinfo{modulename} = $modulename;
1361 $aliasinfo{augeas} = $path;
1362 $aliasinfo{file} = $file;
1364 $modprobe_aliases{$alias} = \%aliasinfo;
1368 $os->{modprobe_aliases} = \%modprobe_aliases;
1371 # Get a listing of device drivers from an initrd
1374 my ($g, $os, $path, $version) = @_;
1378 # Disregard old-style compressed ext2 files and only work with real
1379 # compressed cpio files, since cpio takes ages to (fail to) process anything
1381 if ($g->exists($path) && $g->file($path) =~ /cpio/) {
1383 @modules = $g->initrd_list ($path);
1386 @modules = grep { m{([^/]+)\.(?:ko|o)$} } @modules;
1388 warn __x("{filename}: could not read initrd format",
1389 filename => "$path");
1393 # Add to the top level initrd_modules entry
1394 $os->{initrd_modules} ||= {};
1395 $os->{initrd_modules}->{$version} = \@modules;
1404 Copyright (C) 2009-2010 Red Hat Inc.
1408 Please see the file COPYING.LIB for the full license.
1412 L<virt-inspector(1)>,
1415 L<http://libguestfs.org/>,
1417 L<http://libvirt.org/>,