X-Git-Url: http://git.annexia.org/?p=libguestfs.git;a=blobdiff_plain;f=perl%2Flib%2FSys%2FGuestfs%2FLib.pm;h=00a9bdb87a8891787ed47bc1db9b124812d4252e;hp=925c494582ade63b5fc55d48df75e3b564c20294;hb=22eb7fc966bafebedfde437c9b9c9fb903a8bc35;hpb=b3595c5553035798b7b33d05c9326f7e8dd55e69

diff --git a/perl/lib/Sys/Guestfs/Lib.pm b/perl/lib/Sys/Guestfs/Lib.pm
index 925c494..00a9bdb 100644
--- a/perl/lib/Sys/Guestfs/Lib.pm
+++ b/perl/lib/Sys/Guestfs/Lib.pm
@@ -78,7 +78,7 @@ use vars qw(@EXPORT_OK @ISA);
 
  $g = open_guest ([$img1, $img2, ...], address => $uri, ...);
 
- ($g, $conn, $dom) = open_guest ($name);
+ ($g, $conn, $dom, @images) = open_guest ($name);
 
 This function opens a libguestfs handle for either the libvirt domain
 called C<$name>, or the disk image called C<$name>.  Any disk images
@@ -108,10 +108,10 @@ passed through to C<Sys::Virt-E<gt>new> unchanged.
 The implicit libvirt handle is closed after this function, I<unless>
 you call the function in C<wantarray> context, in which case the
 function returns a tuple of: the open libguestfs handle, the open
-libvirt handle, and the open libvirt domain handle.  (This is useful
-if you want to do other things like pulling the XML description of the
-guest).  Note that if this is a straight disk image, then C<$conn> and
-C<$dom> will be C<undef>.
+libvirt handle, and the open libvirt domain handle, and a list of
+images.  (This is useful if you want to do other things like pulling
+the XML description of the guest).  Note that if this is a straight
+disk image, then C<$conn> and C<$dom> will be C<undef>.
 
 If the C<Sys::Virt> module is not available, then libvirt is bypassed,
 and this function can only open disk images.
@@ -204,7 +204,7 @@ sub open_guest
 	}
     }
 
-    return wantarray ? ($g, $conn, $dom) : $g
+    return wantarray ? ($g, $conn, $dom, @images) : $g
 }
 
 =head2 get_partitions
@@ -475,13 +475,29 @@ Filesystem content, if we could determine it.  One of: "linux-grub",
 =item osdistro
 
 (For Linux root partitions only).
-Operating system distribution.  One of: "fedora", "redhat",
-"debian".
+Operating system distribution.  One of: "fedora", "rhel", "centos",
+"scientific", "debian".
 
-=item osversion
+=item package_format
+
+(For Linux root partitions only)
+The package format used by the guest distribution. One of: "rpm", "dpkg".
+
+=item package_management
+
+(For Linux root partitions only)
+The package management tool used by the guest distribution. One of: "rhn",
+"yum", "apt".
+
+=item os_major_version
 
 (For root partitions only).
-Operating system version.
+Operating system major version number.
+
+=item os_minor_version
+
+(For root partitions only).
+Operating system minor version number.
 
 =item fstab
 
@@ -608,25 +624,75 @@ sub _check_linux_root
     my $r = shift;
 
     # Look into /etc to see if we recognise the operating system.
-    if ($g->is_file ("/etc/redhat-release")) {
+    # N.B. don't use $g->is_file here, because it might be a symlink
+    if ($g->exists ("/etc/redhat-release")) {
+        $r->{package_format} = "rpm";
+
 	$_ = $g->cat ("/etc/redhat-release");
-	if (/Fedora release (\d+\.\d+)/) {
+	if (/Fedora release (\d+)(?:\.(\d+))?/) {
 	    $r->{osdistro} = "fedora";
-	    $r->{osversion} = "$1"
-	} elsif (/(Red Hat Enterprise Linux|CentOS|Scientific Linux).*release (\d+).*Update (\d+)/) {
-	    $r->{osdistro} = "redhat";
-	    $r->{osversion} = "$2.$3";
-        } elsif (/(Red Hat Enterprise Linux|CentOS|Scientific Linux).*release (\d+(?:\.(\d+))?)/) {
-	    $r->{osdistro} = "redhat";
-	    $r->{osversion} = "$2";
-	} else {
-	    $r->{osdistro} = "redhat";
+	    $r->{os_major_version} = "$1";
+	    $r->{os_minor_version} = "$2" if(defined($2));
+	    $r->{package_management} = "yum";
+	}
+        
+        elsif (/(Red Hat Enterprise Linux|CentOS|Scientific Linux)/) {
+            my $distro = $1;
+
+            if($distro eq "Red Hat Enterprise Linux") {
+                $r->{osdistro} = "rhel";
+            }
+
+            elsif($distro eq "CentOS") {
+                $r->{osdistro} = "centos";
+                $r->{package_management} = "yum";
+            }
+
+            elsif($distro eq "Scientific Linux") {
+                $r->{osdistro} = "scientific";
+                $r->{package_management} = "yum";
+            }
+
+            # Shouldn't be possible
+            else { die };
+
+            if (/$distro.*release (\d+).*Update (\d+)/) {
+                $r->{os_major_version} = "$1";
+                $r->{os_minor_version} = "$2";
+            }
+
+            elsif (/$distro.*release (\d+)(?:\.(\d+))?/) {
+                $r->{os_major_version} = "$1";
+
+                if(defined($2)) {
+                    $r->{os_minor_version} = "$2";
+                } else {
+                    $r->{os_minor_version} = "0";
+                }
+            }
+
+            # Package management in RHEL changed in version 5
+            if ($r->{osdistro} eq "rhel") {
+                if ($r->{os_major_version} >= 5) {
+                    $r->{package_management} = "yum";
+                } else {
+                    $r->{package_management} = "rhn";
+                }
+            }
+        }
+
+        else {
+	    $r->{osdistro} = "redhat-based";
 	}
     } elsif ($g->is_file ("/etc/debian_version")) {
+        $r->{package_format} = "dpkg";
+        $r->{package_management} = "apt";
+
 	$_ = $g->cat ("/etc/debian_version");
-	if (/(\d+\.\d+)/) {
+	if (/(\d+)\.(\d+)/) {
 	    $r->{osdistro} = "debian";
-	    $r->{osversion} = "$1";
+	    $r->{os_major_version} = "$1";
+	    $r->{os_minor_version} = "$2";
 	} else {
 	    $r->{osdistro} = "debian";
 	}
@@ -815,9 +881,13 @@ Operating system type, eg. "linux", "windows".
 
 Operating system distribution, eg. "debian".
 
-=item version
+=item major_version
 
-Operating system version, eg. "4.0".
+Operating system major version, eg. "4".
+
+=item minor_version
+
+Operating system minor version, eg "3".
 
 =item root
 
@@ -883,7 +953,14 @@ sub _get_os_version
 
     $r->{os} = $r->{root}->{fsos} if exists $r->{root}->{fsos};
     $r->{distro} = $r->{root}->{osdistro} if exists $r->{root}->{osdistro};
-    $r->{version} = $r->{root}->{osversion} if exists $r->{root}->{osversion};
+    $r->{major_version} = $r->{root}->{os_major_version}
+        if exists $r->{root}->{os_major_version};
+    $r->{minor_version} = $r->{root}->{os_minor_version}
+        if exists $r->{root}->{os_minor_version};
+    $r->{package_format} = $r->{root}->{package_format}
+        if exists $r->{root}->{package_format};
+    $r->{package_management} = $r->{root}->{package_management}
+        if exists $r->{root}->{package_management};
 }
 
 sub _assign_mount_points
@@ -990,14 +1067,22 @@ sub mount_operating_system
     local $_;
     my $g = shift;
     my $os = shift;
+    my $ro = shift; # Read-only?
+
+    $ro = 1 unless(defined($ro)); # ro defaults to 1 if unspecified
 
     my $mounts = $os->{mounts};
 
     # Have to mount / first.  Luckily '/' is early in the ASCII
     # character set, so this should be OK.
     foreach (sort keys %$mounts) {
-	$g->mount_ro ($mounts->{$_}, $_)
-	    if $_ ne "swap" && $_ ne "none" && ($_ eq '/' || $g->is_dir ($_));
+        if($_ ne "swap" && $_ ne "none" && ($_ eq '/' || $g->is_dir ($_))) {
+            if($ro) {
+                $g->mount_ro ($mounts->{$_}, $_)
+            } else {
+                $g->mount ($mounts->{$_}, $_)
+            }
+        }
     }
 }
 
@@ -1063,8 +1148,8 @@ sub _check_for_applications
 
     my $osn = $os->{os};
     if ($osn eq "linux") {
-	my $distro = $os->{distro};
-	if (defined $distro && ($distro eq "redhat" || $distro eq "fedora")) {
+	my $package_format = $os->{package_format};
+	if (defined $package_format && $package_format eq "rpm") {
 	    my @lines = $g->command_lines
 		(["rpm",
 		  "-q", "-a",