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:
parent
80736cdf20
commit
c61b026e3a
|
@ -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
|
||||
|
|
|
@ -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))
|
||||
|
|
24
guix/ui.scm
24
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.
|
||||
|
|
Loading…
Reference in New Issue