diff options
author | Ludovic Courtès <ludo@gnu.org> | 2014-05-27 23:19:49 +0200 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2014-05-27 23:19:49 +0200 |
commit | af018f5e0a1b7c67e9f40ca68929bd35b94206d3 (patch) | |
tree | 8c3efe66f8ac1f6178357937c0a41c6f5ff8f0f8 /guix/nar.scm | |
parent | d84a7be6675bd647931d8eff9134d00dd5a6bd58 (diff) | |
parent | 35066aa596931ef84922298c2760ceba69940cd1 (diff) | |
download | guix-patches-af018f5e0a1b7c67e9f40ca68929bd35b94206d3.tar guix-patches-af018f5e0a1b7c67e9f40ca68929bd35b94206d3.tar.gz |
Merge branch 'master' into core-updates
Diffstat (limited to 'guix/nar.scm')
-rw-r--r-- | guix/nar.scm | 41 |
1 files changed, 17 insertions, 24 deletions
diff --git a/guix/nar.scm b/guix/nar.scm index 0bf8ac317d..0a7187c2dd 100644 --- a/guix/nar.scm +++ b/guix/nar.scm @@ -334,36 +334,29 @@ held." (unlock-store-file target))))) (define (temporary-store-file) - "Return the file name of a temporary file created in the store that is -protected from garbage collection." + "Return the file name of a temporary file created in the store." (let* ((template (string-append (%store-prefix) "/guix-XXXXXX")) (port (mkstemp! template))) (close-port port) - - ;; Make sure TEMPLATE is not collected while we populate it. - (add-permanent-root template) - - ;; There's a small window during which the GC could delete the file. Try - ;; again if that happens. - (if (file-exists? template) - (begin - ;; It's up to the caller to create that file or directory. - (delete-file template) - template) - (begin - (remove-permanent-root template) - (temporary-store-file))))) + template)) (define-syntax-rule (with-temporary-store-file name body ...) "Evaluate BODY with NAME bound to the file name of a temporary store item protected from GC." - (let ((name (temporary-store-file))) - (dynamic-wind - (const #t) - (lambda () - body ...) - (lambda () - (remove-permanent-root name))))) + (let loop ((name (temporary-store-file))) + (with-store store + ;; Add NAME to the current process' roots. (Opening this connection to + ;; the daemon allows us to reuse its code that deals with the + ;; per-process roots file.) + (add-temp-root store name) + + ;; There's a window during which GC could delete NAME. Try again when + ;; that happens. + (if (file-exists? name) + (begin + (delete-file name) + body ...) + (loop (temporary-store-file)))))) (define* (restore-one-item port #:key acl (verify-signature? #t) (lock? #t) @@ -377,7 +370,7 @@ protected from GC." (let ((signature (catch 'gcry-error (lambda () (string->canonical-sexp signature)) - (lambda (err . _) + (lambda (key proc err) (raise (condition (&message (message "signature is not a valid \ |