From bdeee95a214eedfde979958f62cee466c28e638f Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Wed, 20 Feb 2013 23:03:24 +0100
Subject: [PATCH] ui: Add temporary file handling and atomic symlink switch.

* guix/scripts/download.scm (call-with-temporary-output-file): Move to
  ui.scm.
* guix/scripts/package.scm (switch-symlinks): Likewise.
* guix/ui.scm (call-with-temporary-output-file, switch-symlinks): New
  procedures.
---
 guix/scripts/download.scm | 11 -----------
 guix/scripts/package.scm  |  7 -------
 guix/ui.scm               | 24 ++++++++++++++++++++++++
 3 files changed, 24 insertions(+), 18 deletions(-)

diff --git a/guix/scripts/download.scm b/guix/scripts/download.scm
index 10370e59af..3dc227fdcd 100644
--- a/guix/scripts/download.scm
+++ b/guix/scripts/download.scm
@@ -33,17 +33,6 @@ (define-module (guix scripts download)
   #:use-module (rnrs io ports)
   #:export (guix-download))
 
-(define (call-with-temporary-output-file proc)
-  (let* ((template (string-copy "guix-download.XXXXXX"))
-         (out      (mkstemp! template)))
-    (dynamic-wind
-      (lambda ()
-        #t)
-      (lambda ()
-        (proc template out))
-      (lambda ()
-        (false-if-exception (delete-file template))))))
-
 (define (fetch-and-store store fetch name)
   "Call FETCH for URI, and pass it the name of a file to write to; eventually,
 copy data from that port to STORE, under NAME.  Return the resulting
diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index 23786fb7d8..38e8ae1150 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -192,13 +192,6 @@ (define (profile-number profile)
              (compose string->number (cut match:substring <> 1)))
       0))
 
-(define (switch-symlinks link target)
-  "Atomically switch LINK, a symbolic link, to point to TARGET.  Works
-both when LINK already exists and when it does not."
-  (let ((pivot (string-append link ".new")))
-    (symlink target pivot)
-    (rename-file pivot link)))
-
 (define (roll-back profile)
   "Roll back to the previous generation of PROFILE."
   (let* ((number           (profile-number profile))
diff --git a/guix/ui.scm b/guix/ui.scm
index af8b238ce1..9c27dd8b3a 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -36,6 +36,8 @@ (define-module (guix ui)
             call-with-error-handling
             with-error-handling
             location->string
+            call-with-temporary-output-file
+            switch-symlinks
             fill-paragraph
             string->recutils
             package->recutils
@@ -125,6 +127,28 @@ (define (location->string loc)
     (($ <location> file line column)
      (format #f "~a:~a:~a" file line column))))
 
+(define (call-with-temporary-output-file proc)
+  "Call PROC with a name of a temporary file and open output port to that
+file; close the file and delete it when leaving the dynamic extent of this
+call."
+  (let* ((template (string-copy "guix-file.XXXXXX"))
+         (out      (mkstemp! template)))
+    (dynamic-wind
+      (lambda ()
+        #t)
+      (lambda ()
+        (proc template out))
+      (lambda ()
+        (false-if-exception (close out))
+        (false-if-exception (delete-file template))))))
+
+(define (switch-symlinks link target)
+  "Atomically switch LINK, a symbolic link, to point to TARGET.  Works
+both when LINK already exists and when it does not."
+  (let ((pivot (string-append link ".new")))
+    (symlink target pivot)
+    (rename-file pivot link)))
+
 (define* (fill-paragraph str width #:optional (column 0))
   "Fill STR such that each line contains at most WIDTH characters, assuming
 that the first character is at COLUMN.