nar: Really really protect the temporary store directory from GC.

This is a follow-up to 6071b55e10.
See <https://lists.gnu.org/archive/html/guix-devel/2014-04/msg00167.html>
for the original report, and
<https://lists.gnu.org/archive/html/guix-devel/2014-04/msg00198.html>
for an alternate solution that has been discussed.

* guix/nar.scm (temporary-store-file): Remove call to
  'add-permanent-root'; don't loop.
  (with-temporary-store-file): Rewrite using 'with-store' and
  'add-temp-root'.
This commit is contained in:
Ludovic Courtès 2014-04-21 23:23:34 +02:00
parent ace6924327
commit 50db7d82b3
1 changed files with 16 additions and 23 deletions

View File

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