From 50db7d82b3f3ab8ec382132b06a1400c0044b89e Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Mon, 21 Apr 2014 23:23:34 +0200
Subject: [PATCH] nar: Really really protect the temporary store directory from
 GC.

This is a follow-up to 6071b55e10b7b6e67d77ae058c8744834889e0b4.
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'.
---
 guix/nar.scm | 39 ++++++++++++++++-----------------------
 1 file changed, 16 insertions(+), 23 deletions(-)

diff --git a/guix/nar.scm b/guix/nar.scm
index 0bf8ac317d..6beda91c02 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)