From c61b026e3ae0ee2aca438100828ed55d226bfad6 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 20 Feb 2013 23:03:24 +0100 Subject: 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. --- guix/ui.scm | 24 ++++++++++++++++++++++++ 1 file changed, 24 insertions(+) (limited to 'guix/ui.scm') 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 @@ (define-module (guix ui) 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 @@ (define (location->string loc) (($ 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. -- cgit v1.2.3