diff options
author | Ludovic Courtès <ludo@gnu.org> | 2013-02-20 23:03:24 +0100 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2013-02-27 20:55:41 +0100 |
commit | bdeee95a214eedfde979958f62cee466c28e638f (patch) | |
tree | 4d06ea68efdc13552e4b42d518222be35a8be75c | |
parent | cc68ccc5b08fff76d33c7062db35bdb646ed7ece (diff) | |
download | patches-bdeee95a214eedfde979958f62cee466c28e638f.tar patches-bdeee95a214eedfde979958f62cee466c28e638f.tar.gz |
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.scm | 11 | ||||
-rw-r--r-- | guix/scripts/package.scm | 7 | ||||
-rw-r--r-- | 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 @@ #: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. |