20/21: installer: Do not use /tmp for holding the configuration.

[John Darrington]

jmd pushed a commit to branch wip-installer
in repository guix.

commit 88c305ba47c11c167b98010012ff059c5a65d9c8
Author: John Darrington <address@hidden>
Date:   Sat Dec 31 09:52:31 2016 +0100

    installer: Do not use /tmp for holding the configuration.
    
    * gnu/system/installer/configure.scm (tempdir): New variable.
---
 gnu/system/installer/configure.scm |   28 +++++++++++++++++++++++++++-
 1 file changed, 27 insertions(+), 1 deletion(-)

diff --git a/gnu/system/installer/configure.scm 
b/gnu/system/installer/configure.scm
index a7cf3bf..1878956 100644
--- a/gnu/system/installer/configure.scm
+++ b/gnu/system/installer/configure.scm
@@ -25,6 +25,7 @@
   #:use-module  (gnu system installer partition-reader)
   #:use-module  (gnu system installer disks)
   #:use-module (ice-9 format)
+  #:use-module (ice-9 rdelim)
   #:use-module (ice-9 match)
   #:use-module (ice-9 pretty-print)
   #:use-module (gurses buttons)
@@ -32,6 +33,7 @@
   #:use-module (guix store)
   #:use-module (guix utils)
 
+
   #:export (make-configure-page))
 
 
@@ -46,6 +48,29 @@
 (define my-buttons `((save ,(N_ "_Save") #t)
                      (back ,(N_ "_Back") #t)))
 
+
+;; Kludge!  For testing.
+(define tempdir
+  (if
+   ;; Try to infer whether we are running the installation image or
+   ;; if we are just testing.
+   (and (file-exists? "/etc/issue")
+        (let loop ((p (open "/etc/issue" O_RDONLY)))
+          (let ((l (read-line p)))
+            (cond
+             ((eof-object? l)
+              (close p)
+              #f)
+             ((string-contains l "installation image")
+              (close p)
+              #t)
+             (else
+              (loop p))))))
+   ;; In the installer image we cannot use /tmp because the cow-store
+   ;; does not play nicely with it.  Bug 25286 refers.
+   ""
+   "/tmp"))
+
 (define (configure-page-key-handler page ch)
 
   (let ((nav  (page-datum page 'navigation))
@@ -81,7 +106,8 @@
      ((buttons-key-matches-symbol? nav ch 'save)
 
       ;; Write the configuration and set the file name
-      (let ((cfg-port (mkstemp! (string-copy "/tmp/guix-config-XXXXXX"))))
+      (let ((cfg-port (mkstemp! (string-copy
+                                 (string-append tempdir 
"/guix-config-XXXXXX")))))
         (generate-guix-config cfg-port)
         (set! config-file (port-filename cfg-port))
         (close-port cfg-port))