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

[Hilko Bengen]

---
 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