X-Git-Url: http://git.annexia.org/?a=blobdiff_plain;f=perl%2Flib%2FSys%2FGuestfs%2FLib.pm;h=fc3163f104d94f4f28d40ed6ae3d81452d17feb0;hb=72324580801f2c0e2b702b430b90eb141618c7f4;hp=9dbce2cda2b0ac5f2d0259c61efa7b81be8dc42e;hpb=4b48f93ce6407923ea23451cfe39ac63811d1f42;p=libguestfs.git diff --git a/perl/lib/Sys/Guestfs/Lib.pm b/perl/lib/Sys/Guestfs/Lib.pm index 9dbce2c..fc3163f 100644 --- a/perl/lib/Sys/Guestfs/Lib.pm +++ b/perl/lib/Sys/Guestfs/Lib.pm @@ -1,5 +1,5 @@ # Sys::Guestfs::Lib -# Copyright (C) 2009 Red Hat Inc. +# Copyright (C) 2009-2010 Red Hat Inc. # # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Lesser General Public @@ -20,6 +20,13 @@ package Sys::Guestfs::Lib; use strict; use warnings; +# The minor part of this version number is incremented when some +# change is made to this module. The major part is incremented if we +# make a change which is not backwards compatible. It is not related +# to the libguestfs version number. +use vars qw($VERSION); +$VERSION = '0.1'; + use Carp qw(croak); use Sys::Guestfs; @@ -260,16 +267,27 @@ This function takes an open libguestfs handle C<$g> and returns all partitions and logical volumes found on it. What is returned is everything that could contain a filesystem (or -swap). Physical volumes are excluded from the list, and so are any -devices which are partitioned (eg. C would not be returned -if C exists). +swap). Physical volumes are not normally included from the list +except if they contain a filesystem directly. Nor are devices which +are partitioned (eg. C would not be returned if C +exists). =cut sub get_partitions { + local $_; my $g = shift; + # Look to see if any devices directly contain filesystems (RHBZ#590167). + my @devices = $g->list_devices (); + my @fses_on_device = (); + foreach (@devices) { + eval { $g->mount_ro ($_, "/"); }; + push @fses_on_device, $_ unless $@; + $g->umount_all (); + } + my @partitions = $g->list_partitions (); my @pvs = $g->pvs (); @partitions = grep { ! _is_pv ($_, @pvs) } @partitions; @@ -277,7 +295,7 @@ sub get_partitions my @lvs; @lvs = $g->lvs () if feature_available ($g, "lvm2"); - return sort (@lvs, @partitions); + return sort (@fses_on_device, @lvs, @partitions); } sub _is_pv { @@ -1463,10 +1481,16 @@ sub _check_for_applications if ($osn eq "linux") { my $package_format = $os->{package_format}; if (defined $package_format && $package_format eq "rpm") { - my @lines = $g->command_lines - (["rpm", - "-q", "-a", - "--qf", "%{name} %{epoch} %{version} %{release} %{arch}\n"]); + my @lines = (); + eval { + @lines = $g->command_lines + (["rpm", + "-q", "-a", "--qf", + "%{name} %{epoch} %{version} %{release} %{arch}\n"]); + }; + + warn(__x("Error running rpm -qa: {error}", error => $@)) if ($@); + @lines = sort @lines; foreach (@lines) { if (m/^(.*) (.*) (.*) (.*) (.*)$/) { @@ -1483,10 +1507,16 @@ sub _check_for_applications } } } elsif (defined $package_format && $package_format eq "deb") { - my @lines = $g->command_lines - (["dpkg-query", - "-f", '${Package} ${Version} ${Architecture} ${Status}\n', - "-W"]); + my @lines = (); + eval { + @lines = $g->command_lines + (["dpkg-query", + "-f", '${Package} ${Version} ${Architecture} ${Status}\n', + "-W"]); + }; + + warn(__x("Error running dpkg-query: {error}", error => $@)) if ($@); + @lines = sort @lines; foreach (@lines) { if (m/^(.*) (.*) (.*) (.*) (.*) (.*)$/) { @@ -1631,8 +1661,14 @@ sub _check_for_kernels } $config{cmdline} = join(' ', @args) if(scalar(@args) > 0); - my $kernel = - inspect_linux_kernel($g, $path, $os->{package_format}); + my $kernel; + if ($g->exists($path)) { + $kernel = + inspect_linux_kernel($g, $path, $os->{package_format}); + } else { + warn __x("grub refers to {path}, which doesn't exist\n", + path => $path); + } # Check the kernel was recognised if(defined($kernel)) { @@ -1672,9 +1708,6 @@ sub _check_for_kernels eval { $boot{default} = $g->aug_get("/files/$grub_conf/default"); }; - if($@) { - warn __"No grub default specified"; - } $os->{boot} = \%boot; } @@ -1828,7 +1861,7 @@ sub _inspect_initrd # Disregard old-style compressed ext2 files and only work with real # compressed cpio files, since cpio takes ages to (fail to) process anything # else. - if ($g->file ($path) =~ /cpio/) { + if ($g->exists($path) && $g->file($path) =~ /cpio/) { eval { @modules = $g->initrd_list ($path); };