From 5461115e8fd9a3181506307b6090716a0d5c202c Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Fri, 17 Mar 2017 22:45:32 +0100
Subject: pack: Add '--target'.

* guix/scripts/pack.scm (self-contained-tarball): Add #:target.
(docker-image): Add #:target.
[build]: Pass it to 'build-docker-image'.
(%options, show-help): Add '--target'.
(guix-pack): Pass TARGET to 'profile-derivation' and to 'build-image'.
* guix/docker.scm (build-docker-image): Add #:system parameter and honor it.
* doc/guix.texi (Invoking guix pack): Document '--target'.
(Additional Build Options): Refer to the Autoconf manual instead of the
obsolete 'configure.info' for cross-compilation.
---
 guix/docker.scm | 21 +++++++++++++++------
 1 file changed, 15 insertions(+), 6 deletions(-)

(limited to 'guix/docker.scm')

diff --git a/guix/docker.scm b/guix/docker.scm
index 290ad3dcf1..060232148e 100644
--- a/guix/docker.scm
+++ b/guix/docker.scm
@@ -105,12 +105,14 @@ return \"a\"."
 (define* (build-docker-image image path
                              #:key closure compressor
                              (symlinks '())
+                             (system (utsname:machine (uname)))
                              (creation-time (current-time time-utc)))
   "Write to IMAGE a Docker image archive from the given store PATH.  The image
 contains the closure of PATH, as specified in CLOSURE (a file produced by
 #:references-graphs).  SYMLINKS must be a list of (SOURCE -> TARGET) tuples
 describing symlinks to be created in the image, where each TARGET is relative
-to PATH.
+to PATH.  SYSTEM is a GNU triplet (or prefix thereof) of the system the
+binaries at PATH are for; it is used to produce metadata in the image.
 
 Use COMPRESSOR, a command such as '(\"gzip\" \"-9n\"), to compress IMAGE.  Use
 CREATION-TIME, a SRFI-19 time-utc object, as the creation time in metadata."
@@ -118,11 +120,18 @@ CREATION-TIME, a SRFI-19 time-utc object, as the creation time in metadata."
         (closure (canonicalize-path closure))
         (id (docker-id path))
         (time (date->string (time-utc->date creation-time) "~4"))
-        (arch (match (utsname:machine (uname))
-                ("x86_64" "amd64")
-                ("i686"   "386")
-                ("armv7l" "arm")
-                ("mips64" "mips64le"))))
+        (arch (let-syntax ((cond* (syntax-rules ()
+                                    ((_ (pattern clause) ...)
+                                     (cond ((string-prefix? pattern system)
+                                            clause)
+                                           ...
+                                           (else
+                                            (error "unsupported system"
+                                                   system)))))))
+                (cond* ("x86_64" "amd64")
+                       ("i686"   "386")
+                       ("arm"    "arm")
+                       ("mips64" "mips64le")))))
     ;; Make sure we start with a fresh, empty working directory.
     (mkdir directory)
 
-- 
cgit v1.2.3