From 4bca56cc619e90b1c820c2a7f8f7a5fe1f4a8645 Mon Sep 17 00:00:00 2001
From: Chris Marusich <address@hidden>
Date: Mon, 19 Feb 2018 05:45:03 +0100
Subject: [PATCH 4/8] docker: Allow the use of a custom temporary directory.

* guix/docker.scm: (build-docker-image): Add #:tmpdir keyword argument.
---
 guix/docker.scm | 21 +++++++++++++--------
 1 file changed, 13 insertions(+), 8 deletions(-)

diff --git a/guix/docker.scm b/guix/docker.scm
index 060232148..659d228aa 100644
--- a/guix/docker.scm
+++ b/guix/docker.scm
@@ -106,7 +106,8 @@ return \"a\"."
                              #:key closure compressor
                              (symlinks '())
                              (system (utsname:machine (uname)))
-                             (creation-time (current-time time-utc)))
+                             (creation-time (current-time time-utc))
+                             (tmpdir "/tmp/docker-image"))
   "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
@@ -115,9 +116,13 @@ 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."
-  (let ((directory "/tmp/docker-image")           ;temporary working directory
-        (closure (canonicalize-path closure))
+CREATION-TIME, a SRFI-19 time-utc object, as the creation time in metadata.
+
+TMPDIR is the name of the temporary working directory to use.  This can be
+useful if you need to use a specific temporary directory, for example because
+the default temporary directory lies on a file system with insufficient
+space."
+  (let ((closure (canonicalize-path closure))
         (id (docker-id path))
         (time (date->string (time-utc->date creation-time) "~4"))
         (arch (let-syntax ((cond* (syntax-rules ()
@@ -133,9 +138,9 @@ CREATION-TIME, a SRFI-19 time-utc object, as the creation time in metadata."
                        ("arm"    "arm")
                        ("mips64" "mips64le")))))
     ;; Make sure we start with a fresh, empty working directory.
-    (mkdir directory)
+    (mkdir-p tmpdir)
 
-    (and (with-directory-excursion directory
+    (and (with-directory-excursion tmpdir
            (mkdir id)
            (with-directory-excursion id
              (with-output-to-file "VERSION"
@@ -174,10 +179,10 @@ CREATION-TIME, a SRFI-19 time-utc object, as the creation time in metadata."
              (lambda ()
                (scm->json (repositories path id)))))
 
-         (and (zero? (apply system* "tar" "-C" directory "-cf" image
+         (and (zero? (apply system* "tar" "-cf" image "-C" tmpdir
                             `(,@%tar-determinism-options
                               ,@(if compressor
                                     (list "-I" (string-join compressor))
                                     '())
                               ".")))
-              (begin (delete-file-recursively directory) #t)))))
+              (begin (delete-file-recursively tmpdir) #t)))))
-- 
2.15.1