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:
parent
ace6924327
commit
50db7d82b3
37
guix/nar.scm
37
guix/nar.scm
|
@ -334,36 +334,29 @@ held."
|
||||||
(unlock-store-file target)))))
|
(unlock-store-file target)))))
|
||||||
|
|
||||||
(define (temporary-store-file)
|
(define (temporary-store-file)
|
||||||
"Return the file name of a temporary file created in the store that is
|
"Return the file name of a temporary file created in the store."
|
||||||
protected from garbage collection."
|
|
||||||
(let* ((template (string-append (%store-prefix) "/guix-XXXXXX"))
|
(let* ((template (string-append (%store-prefix) "/guix-XXXXXX"))
|
||||||
(port (mkstemp! template)))
|
(port (mkstemp! template)))
|
||||||
(close-port port)
|
(close-port port)
|
||||||
|
template))
|
||||||
;; 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)))))
|
|
||||||
|
|
||||||
(define-syntax-rule (with-temporary-store-file name body ...)
|
(define-syntax-rule (with-temporary-store-file name body ...)
|
||||||
"Evaluate BODY with NAME bound to the file name of a temporary store item
|
"Evaluate BODY with NAME bound to the file name of a temporary store item
|
||||||
protected from GC."
|
protected from GC."
|
||||||
(let ((name (temporary-store-file)))
|
(let loop ((name (temporary-store-file)))
|
||||||
(dynamic-wind
|
(with-store store
|
||||||
(const #t)
|
;; Add NAME to the current process' roots. (Opening this connection to
|
||||||
(lambda ()
|
;; 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 ...)
|
body ...)
|
||||||
(lambda ()
|
(loop (temporary-store-file))))))
|
||||||
(remove-permanent-root name)))))
|
|
||||||
|
|
||||||
(define* (restore-one-item port
|
(define* (restore-one-item port
|
||||||
#:key acl (verify-signature? #t) (lock? #t)
|
#:key acl (verify-signature? #t) (lock? #t)
|
||||||
|
|
Loading…
Reference in New Issue