X-Git-Url: http://git.annexia.org/?p=libguestfs.git;a=blobdiff_plain;f=perl%2Flib%2FSys%2FGuestfs%2FLib.pm;h=98cdb88358c344fe0804ff767ec060dbd9595157;hp=49c08b39c57161398512675979bc9aa11b6a4a54;hb=dcfa05f703ca0c281c12a14450d06dfb4ac7893d;hpb=a59dcdbd1b0a28c960e3792165a13f2daf4f6c35

diff --git a/perl/lib/Sys/Guestfs/Lib.pm b/perl/lib/Sys/Guestfs/Lib.pm
index 49c08b3..98cdb88 100644
--- a/perl/lib/Sys/Guestfs/Lib.pm
+++ b/perl/lib/Sys/Guestfs/Lib.pm
@@ -104,8 +104,7 @@ The handle is still in the config state when it is returned, so you
 have to call C<$g-E<gt>launch ()>.
 
 The optional C<address> parameter can be added to specify the libvirt
-URI.  In addition, L<Sys::Virt(3)> lists other parameters which are
-passed through to C<Sys::Virt-E<gt>new> unchanged.
+URI.
 
 The implicit libvirt handle is closed after this function, I<unless>
 you call the function in C<wantarray> context, in which case the
@@ -118,6 +117,10 @@ 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.
 
+The optional C<interface> parameter can be used to open devices with
+C<add_drive{,_ro}_with_if>.  See
+L<Sys::Guestfs/guestfs_add_drive_with_if> for more details.
+
 =cut
 
 sub open_guest
@@ -126,7 +129,9 @@ sub open_guest
     my $first = shift;
     my %params = @_;
 
-    my $readwrite = $params{rw};
+    my $rw = $params{rw};
+    my $address = $params{address};
+    my $interface = $params{interface};
 
     my @images = ();
     if (ref ($first) eq "ARRAY") {
@@ -154,12 +159,15 @@ sub open_guest
         die __"open_guest: too many domains listed on command line"
             if @images > 1;
 
-        $conn = Sys::Virt->new (readonly => 1, @_);
+        my @libvirt_args = ();
+        push @libvirt_args, address => $address if defined $address;
+
+        $conn = Sys::Virt->new (readonly => 1, @libvirt_args);
         die __"open_guest: cannot connect to libvirt" unless $conn;
 
         my @doms = $conn->list_defined_domains ();
         my $isitinactive = 1;
-        unless ($readwrite) {
+        unless ($rw) {
             # In the case where we want read-only access to a domain,
             # allow the user to specify an active domain too.
             push @doms, $conn->list_domains ();
@@ -199,10 +207,18 @@ sub open_guest
     # We've now got the list of @images, so feed them to libguestfs.
     my $g = Sys::Guestfs->new ();
     foreach (@images) {
-        if ($readwrite) {
-            $g->add_drive ($_);
+        if ($rw) {
+            if ($interface) {
+                $g->add_drive_with_if ($_, $interface);
+            } else {
+                $g->add_drive ($_);
+            }
         } else {
-            $g->add_drive_ro ($_);
+            if ($interface) {
+                $g->add_drive_ro_with_if ($_, $interface);
+            } else {
+                $g->add_drive_ro ($_);
+            }
         }
     }
 
@@ -649,7 +665,7 @@ Operating system distribution.  One of: "fedora", "rhel", "centos",
 =item package_format
 
 (For Linux root partitions only)
-The package format used by the guest distribution. One of: "rpm", "dpkg".
+The package format used by the guest distribution. One of: "rpm", "deb".
 
 =item package_management
 
@@ -853,7 +869,7 @@ sub _check_linux_root
             $r->{osdistro} = "redhat-based";
         }
     } elsif ($g->is_file ("/etc/debian_version")) {
-        $r->{package_format} = "dpkg";
+        $r->{package_format} = "deb";
         $r->{package_management} = "apt";
 
         $_ = $g->cat ("/etc/debian_version");
@@ -1282,7 +1298,7 @@ sub mount_operating_system
             if($ro) {
                 $g->mount_ro ($mounts->{$_}, $_)
             } else {
-                $g->mount ($mounts->{$_}, $_)
+                $g->mount_options ("", $mounts->{$_}, $_)
             }
         }
     }
@@ -1423,6 +1439,7 @@ sub _check_for_applications
                 (["rpm",
                   "-q", "-a",
                   "--qf", "%{name} %{epoch} %{version} %{release} %{arch}\n"]);
+            @lines = sort @lines;
             foreach (@lines) {
                 if (m/^(.*) (.*) (.*) (.*) (.*)$/) {
                     my $epoch = $2;
@@ -1437,6 +1454,24 @@ sub _check_for_applications
                     push @apps, $app
                 }
             }
+        } elsif (defined $package_format && $package_format eq "deb") {
+            my @lines = $g->command_lines
+                (["dpkg-query",
+                  "-f", '${Package} ${Version} ${Architecture} ${Status}\n',
+                  "-W"]);
+            @lines = sort @lines;
+            foreach (@lines) {
+                if (m/^(.*) (.*) (.*) (.*) (.*) (.*)$/) {
+                    if ( $6 eq "installed" ) {
+                        my $app = {
+                            name => $1,
+                            version => $2,
+                            arch => $3
+                        };
+                        push @apps, $app
+                    }
+                }
+            }
         }
     } elsif ($osn eq "windows") {
         # XXX
@@ -1509,6 +1544,12 @@ sub _check_for_kernels
         # For every kernel we find, inspect it and add to $os->{kernels}
 
         my $grub = _find_grub_prefix($g, $os);
+        my $grub_conf = "/etc/grub.conf";
+
+        # Debian and other's have no /etc/grub.conf:
+        if ( ! -f "$grub_conf" ) {
+            $grub_conf = "$grub/grub/menu.lst";
+        }
 
         my @boot_configs;
 
@@ -1528,7 +1569,7 @@ sub _check_for_kernels
         my @configs = ();
         # Get all configurations from grub
         foreach my $bootable
-            ($g->aug_match("/files/etc/grub.conf/title"))
+            ($g->aug_match("/files/$grub_conf/title"))
         {
             my %config = ();
             $config{title} = $g->aug_get($bootable);
@@ -1601,7 +1642,7 @@ sub _check_for_kernels
 
         # Add the default configuration
         eval {
-            $boot{default} = $g->aug_get("/files/etc/grub.conf/default");
+            $boot{default} = $g->aug_get("/files/$grub_conf/default");
         };
         if($@) {
             warn __"No grub default specified";