nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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.
master
Ludovic Courtès 2013-02-20 23:03:24 +01:00
parent 80736cdf20
commit c61b026e3a
3 changed files with 24 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
guix/scripts/download.scm
View File

@ -33,17 +33,6 @@
#:use-module (rnrs io ports) #:use-module (rnrs io ports)
#:export (guix-download)) #: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) (define (fetch-and-store store fetch name)
"Call FETCH for URI, and pass it the name of a file to write to; eventually, "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 copy data from that port to STORE, under NAME. Return the resulting

7
guix/scripts/package.scm
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))) (compose string->number (cut match:substring <> 1)))
0)) 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) (define (roll-back profile)
"Roll back to the previous generation of PROFILE." "Roll back to the previous generation of PROFILE."
(let* ((number (profile-number profile)) (let* ((number (profile-number profile))

24
guix/ui.scm
View File

@ -36,6 +36,8 @@
call-with-error-handling call-with-error-handling
with-error-handling with-error-handling
location->string location->string
call-with-temporary-output-file
switch-symlinks
fill-paragraph fill-paragraph
string->recutils string->recutils
package->recutils package->recutils
@ -125,6 +127,28 @@ General help using GNU software: <http://www.gnu.org/gethelp/>"))
(($ <location> file line column) (($ <location> file line column)
(format #f "~a:~a:~a" 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)) (define* (fill-paragraph str width #:optional (column 0))
"Fill STR such that each line contains at most WIDTH characters, assuming "Fill STR such that each line contains at most WIDTH characters, assuming
that the first character is at COLUMN. that the first character is at COLUMN.