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.
This commit is contained in:
Ludovic Courtès 2013-02-20 23:03:24 +01:00
parent 80736cdf20
commit c61b026e3a
3 changed files with 24 additions and 18 deletions

View File

@ -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

View File

@ -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))

View File

@ -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.