X-Git-Url: http://git.annexia.org/?a=blobdiff_plain;f=perl%2Flib%2FSys%2FGuestfs%2FLib.pm;h=d5dfb4eaf500ef0805a2dd7ebdc08f6ff0f6e2e2;hb=4e444d5c09d78b0d292d95d1f97de12f26cc139d;hp=fc5173af2c23a2ae72a7d815f7d4bd35382d0c9b;hpb=22528e9bc486cbb6357192bd758c417c61bba955;p=libguestfs.git

diff --git a/perl/lib/Sys/Guestfs/Lib.pm b/perl/lib/Sys/Guestfs/Lib.pm
index fc5173a..d5dfb4e 100644
--- a/perl/lib/Sys/Guestfs/Lib.pm
+++ b/perl/lib/Sys/Guestfs/Lib.pm
@@ -21,6 +21,7 @@ use strict;
 use warnings;
 
 use Sys::Guestfs;
+use File::Temp qw/tempdir/;
 
 # Optional:
 eval "use Sys::Virt;";
@@ -35,10 +36,14 @@ Sys::Guestfs::Lib - Useful functions for using libguestfs from Perl
 
 =head1 SYNOPSIS
 
- use Sys::Guestfs::Lib qw(#any symbols you want to use);
+ use Sys::Guestfs::Lib qw(open_guest inspect_all_partitions ...);
 
  $g = open_guest ($name);
 
+ %fses = inspect_all_partitions ($g, \@partitions);
+
+(and many more calls - see the rest of this manpage)
+
 =head1 DESCRIPTION
 
 C<Sys::Guestfs::Lib> is an extra library of useful functions for using
@@ -114,6 +119,7 @@ and this function can only open disk images.
 
 sub open_guest
 {
+    local $_;
     my $first = shift;
     my %params = @_;
 
@@ -168,6 +174,10 @@ sub open_guest
 
 	my $p = XML::XPath->new (xml => $xml);
 	my @disks = $p->findnodes ('//devices/disk/source/@dev');
+	push (@disks, $p->findnodes ('//devices/disk/source/@file'));
+
+	die "$images[0] seems to have no disk devices\n" unless @disks;
+
 	@images = map { $_->getData } @disks;
     }
 
@@ -204,14 +214,14 @@ sub get_partitions
 
     my @partitions = $g->list_partitions ();
     my @pvs = $g->pvs ();
-    @partitions = grep { ! is_pv ($_, @pvs) } @partitions;
+    @partitions = grep { ! _is_pv ($_, @pvs) } @partitions;
 
     my @lvs = $g->lvs ();
 
     return sort (@lvs, @partitions);
 }
 
-sub is_pv {
+sub _is_pv {
     local $_;
     my $t = shift;
 
@@ -528,7 +538,7 @@ sub inspect_partition
 	if ($g->is_file ("/grub/menu.lst") ||
 	    $g->is_file ("/grub/grub.conf")) {
 	    $r{content} = "linux-grub";
-	    check_grub ($g, \%r);
+	    _check_grub ($g, \%r);
 	    goto OUT;
 	}
 
@@ -537,7 +547,7 @@ sub inspect_partition
 	    $g->is_file ("/etc/fstab")) {
 	    $r{content} = "linux-root";
 	    $r{is_root} = 1;
-	    check_linux_root ($g, \%r);
+	    _check_linux_root ($g, \%r);
 	    goto OUT;
 	}
 
@@ -568,7 +578,7 @@ sub inspect_partition
 	    $r{fsos} = "windows";
 	    $r{content} = "windows-root";
 	    $r{is_root} = 1;
-	    check_windows_root ($g, \%r, $use_windows_registry);
+	    _check_windows_root ($g, \%r, $use_windows_registry);
 	    goto OUT;
 	}
     }
@@ -578,7 +588,7 @@ sub inspect_partition
     return \%r;
 }
 
-sub check_linux_root
+sub _check_linux_root
 {
     local $_;
     my $g = shift;
@@ -639,7 +649,7 @@ sub check_linux_root
 # XXX We could parse this better.  This won't work if /boot.ini is on
 # a different drive from the %systemroot%, and in other unusual cases.
 
-sub check_windows_root
+sub _check_windows_root
 {
     local $_;
     my $g = shift;
@@ -669,13 +679,13 @@ sub check_windows_root
 	if (defined $systemroot) {
 	    $r->{systemroot} = resolve_windows_path ($g, "/$systemroot");
 	    if (defined $r->{systemroot} && $use_windows_registry) {
-		check_windows_registry ($g, $r, $r->{systemroot});
+		_check_windows_registry ($g, $r, $r->{systemroot});
 	    }
 	}
     }
 }
 
-sub check_windows_registry
+sub _check_windows_registry
 {
     local $_;
     my $g = shift;
@@ -689,18 +699,18 @@ sub check_windows_registry
     if (defined $configdir) {
 	my $softwaredir = resolve_windows_path ($g, "$configdir/software");
 	if (defined $softwaredir) {
-	    load_windows_registry ($g, $r, $softwaredir,
-				   "HKEY_LOCAL_MACHINE\\SOFTWARE");
+	    _load_windows_registry ($g, $r, $softwaredir,
+				    "HKEY_LOCAL_MACHINE\\SOFTWARE");
 	}
 	my $systemdir = resolve_windows_path ($g, "$configdir/system");
 	if (defined $systemdir) {
-	    load_windows_registry ($g, $r, $systemdir,
-				   "HKEY_LOCAL_MACHINE\\System");
+	    _load_windows_registry ($g, $r, $systemdir,
+				    "HKEY_LOCAL_MACHINE\\System");
 	}
     }
 }
 
-sub load_windows_registry
+sub _load_windows_registry
 {
     local $_;
     my $g = shift;
@@ -751,7 +761,7 @@ sub load_windows_registry
     $r->{registry} = \@registry;
 }
 
-sub check_grub
+sub _check_grub
 {
     local $_;
     my $g = shift;
@@ -843,8 +853,8 @@ sub inspect_operating_systems
 		root => $fses->{$_},
 		root_device => $_
 		);
-	    get_os_version ($g, \%r);
-	    assign_mount_points ($g, $fses, \%r);
+	    _get_os_version ($g, \%r);
+	    _assign_mount_points ($g, $fses, \%r);
 	    $oses{$_} = \%r;
 	}
     }
@@ -852,7 +862,7 @@ sub inspect_operating_systems
     return \%oses;
 }
 
-sub get_os_version
+sub _get_os_version
 {
     local $_;
     my $g = shift;
@@ -863,7 +873,7 @@ sub get_os_version
     $r->{version} = $r->{root}->{osversion} if exists $r->{root}->{osversion};
 }
 
-sub assign_mount_points
+sub _assign_mount_points
 {
     local $_;
     my $g = shift;
@@ -879,7 +889,7 @@ sub assign_mount_points
 	foreach (@fstab) {
 	    my ($spec, $file) = @$_;
 
-	    my ($dev, $fs) = find_filesystem ($g, $fses, $spec);
+	    my ($dev, $fs) = _find_filesystem ($g, $fses, $spec);
 	    if ($dev) {
 		$r->{mounts}->{$file} = $dev;
 		$r->{filesystems}->{$dev} = $fs;
@@ -895,7 +905,7 @@ sub assign_mount_points
 }
 
 # Find filesystem by device name, LABEL=.. or UUID=..
-sub find_filesystem
+sub _find_filesystem
 {
     my $g = shift;
     my $fses = shift;
@@ -1022,15 +1032,15 @@ sub inspect_in_detail
     my $g = shift;
     my $os = shift;
 
-    check_for_applications ($g, $os);
-    check_for_kernels ($g, $os);
+    _check_for_applications ($g, $os);
+    _check_for_kernels ($g, $os);
     if ($os->{os} eq "linux") {
-	check_for_modprobe_aliases ($g, $os);
-	check_for_initrd ($g, $os);
+	_check_for_modprobe_aliases ($g, $os);
+	_check_for_initrd ($g, $os);
     }
 }
 
-sub check_for_applications
+sub _check_for_applications
 {
     local $_;
     my $g = shift;
@@ -1073,7 +1083,7 @@ sub check_for_applications
     $os->{apps} = \@apps;
 }
 
-sub check_for_kernels
+sub _check_for_kernels
 {
     local $_;
     my $g = shift;
@@ -1121,7 +1131,7 @@ sub check_for_kernels
 #
 # XXX This doesn't look beyond /etc/modprobe.conf, eg. in /etc/modprobe.d/
 
-sub check_for_modprobe_aliases
+sub _check_for_modprobe_aliases
 {
     local $_;
     my $g = shift;
@@ -1185,7 +1195,7 @@ sub check_for_modprobe_aliases
 # Get a listing of device drivers in any initrd corresponding to a
 # kernel.  This is an indication of what can possibly be booted.
 
-sub check_for_initrd
+sub _check_for_initrd
 {
     local $_;
     my $g = shift;
@@ -1198,14 +1208,20 @@ sub check_for_initrd
 	    my $version = $1;
 	    my @modules;
 
-	    eval {
-		@modules = $g->initrd_list ("/boot/$initrd");
-	    };
-	    unless ($@) {
-		@modules = grep { m,([^/]+)\.ko$, || m,([^/]+)\.o$, } @modules;
-		$initrd_modules{$version} = \@modules
-	    } else {
-		warn "/boot/$initrd: could not read initrd format"
+	    # Disregard old-style compressed ext2 files, since cpio
+	    # takes ages to (fail to) process these.
+	    if ($g->file ("/boot/$initrd") !~ /gzip compressed/ ||
+		$g->zfile ("gzip", "/boot/$initrd") !~ /ext2 filesystem/) {
+		eval {
+		    @modules = $g->initrd_list ("/boot/$initrd");
+		};
+		unless ($@) {
+		    @modules = grep { m,([^/]+)\.ko$, || m,([^/]+)\.o$, }
+		    @modules;
+		    $initrd_modules{$version} = \@modules
+		} else {
+		    warn "/boot/$initrd: could not read initrd format";
+	        }
 	    }
 	}
     }