[Libguestfs] [PATCH] supermin: dpkg: Handle multiarch setups correctly

Hilko Bengen
Tue, 04 Mar 2014 17:35:27 -0000

---
 src/dpkg.ml | 39 +++++++++++++++++++++++++--------------
 1 file changed, 25 insertions(+), 14 deletions(-)

diff --git a/src/dpkg.ml b/src/dpkg.ml
index c0d3292..2662465 100644
--- a/src/dpkg.ml
+++ b/src/dpkg.ml
@@ -29,6 +29,10 @@ let dpkg_detect ()      Config.apt_get <>
"no" &&
     file_exists "/etc/debian_version"

+let dpkg_primary_arch +  let cmd = sprintf "%s --print-architecture"
Config.dpkg in
+  List.hd (run_command_get_lines cmd)
+
 let settings = ref no_settings

 let dpkg_init s = settings := s
@@ -58,17 +62,20 @@ let dpkg_package_of_string str          (quote str) in
     let lines = run_command_get_lines cmd in

-    (* AFAIK on Debian only a single package with a particular name
-     * may be installed (ie no multilib etc crap).  Hence:
-     *)
-    if List.length lines <> 1 then assert false;
-    let line = List.hd lines in
-    let line = string_split " " line in
-    match line with
-    | [ name; version; arch ] ->
-      assert (version <> "");
-      { name = name; version = version; arch = arch }
-    | xs -> assert false
+    let pkgs = List.map (
+      fun line ->
+        let line = string_split " " line in
+        match line with
+        | [ name; version; arch ] ->
+          assert (version <> "");
+          { name = name; version = version; arch = arch }
+        | xs -> assert false)
+      lines in
+
+    (* On multiarch setups, only consider the primary architecture *)
+    List.find
+      (fun pkg -> pkg.arch = dpkg_primary_arch || pkg.arch =
"all")
+      pkgs

   (* Check if a package is installed. *)
   and check_dpkg_installed name @@ -110,6 +117,10 @@ let dpkg_package_name pkg
let dpkg = dpkg_of_pkg pkg in
   dpkg.name

+let dpkg_package_name_arch pkg +  let dpkg = dpkg_of_pkg pkg in
+  sprintf "%s:%s" dpkg.name dpkg.arch
+
 let dpkg_get_package_database_mtime ()    (lstat
"/var/lib/dpkg/status").st_mtime

@@ -137,9 +148,9 @@ let dpkg_get_all_requires pkgs
 let dpkg_get_all_files pkgs    let cmd -    sprintf "%s -L %s | grep
'^/' | grep -v '^/.$' | sort -u"
-      Config.dpkg
-      (quoted_list (List.map dpkg_package_name
+    sprintf "%s --listfiles %s | grep '^/' | grep -v
'^/.$' | sort -u"
+      Config.dpkg_query
+      (quoted_list (List.map dpkg_package_name_arch
 		      (PackageSet.elements pkgs))) in
   let lines = run_command_get_lines cmd in
   List.map (
--
1.9.0