aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2013-02-20 23:03:24 +0100
committerLudovic Courtès <ludo@gnu.org>2013-02-27 20:55:41 +0100
commitbdeee95a214eedfde979958f62cee466c28e638f (patch)
tree4d06ea68efdc13552e4b42d518222be35a8be75c
parentcc68ccc5b08fff76d33c7062db35bdb646ed7ece (diff)
downloadguix-bdeee95a214eedfde979958f62cee466c28e638f.tar.gz
guix-bdeee95a214eedfde979958f62cee466c28e638f.zip
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.
-rw-r--r--guix/scripts/download.scm11
-rw-r--r--guix/scripts/package.scm7
-rw-r--r--guix/ui.scm24
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 @@
#: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 @@ all of PACKAGES, a list of name/version/output/path/deps tuples."
(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 @@
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 @@ General help using GNU software: <http://www.gnu.org/gethelp/>"))
(($ <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.