nar: Really protect the temporary store directory from GC.

Prevents garbage collection of the temporary store directory while
restoring a file set, as it could previously happen:
<https://lists.gnu.org/archive/html/guix-devel/2014-04/msg00167.html>.

* guix/nar.scm (temporary-store-directory): Rename to...
  (temporary-store-file): ... this.  Use 'add-permanent-root' instead of
  'add-indirect-root'.
  (with-temporary-store-file): New macro.
  (restore-one-item): New procedure, with code formerly in
  'restore-file-set'.  Use 'with-temporary-store-file'.
  (restore-file-set): Use it.

1 files changed, 97 insertions, 66 deletions

diff --git a/guix/nar.scm b/guix/nar.scm
index ce69163a8a..0bf8ac317d 100644
--- a/guix/nar.scm
+++ b/guix/nar.scm
@@ -333,16 +333,15 @@ held."
       (when lock?
         (unlock-store-file target)))))
 
-(define (temporary-store-directory)
-  "Return the file name of a temporary directory created in the store that is
+(define (temporary-store-file)
+  "Return the file name of a temporary file created in the store that is
 protected from garbage collection."
   (let* ((template (string-append (%store-prefix) "/guix-XXXXXX"))
          (port     (mkstemp! template)))
     (close-port port)
 
     ;; Make sure TEMPLATE is not collected while we populate it.
-    (with-store store
-      (add-indirect-root store template))
+    (add-permanent-root template)
 
     ;; There's a small window during which the GC could delete the file.  Try
     ;; again if that happens.
@@ -351,30 +350,25 @@ protected from garbage collection."
           ;; It's up to the caller to create that file or directory.
           (delete-file template)
           template)
-        (temporary-store-directory))))
-
-(define* (restore-file-set port
-                           #:key (verify-signature? #t) (lock? #t)
+        (begin
+          (remove-permanent-root template)
+          (temporary-store-file)))))
+
+(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)))))
+
+(define* (restore-one-item port
+                           #:key acl (verify-signature? #t) (lock? #t)
                            (log-port (current-error-port)))
-  "Restore the file set read from PORT to the store.  The format of the data
-on PORT must be as created by 'export-paths'---i.e., a series of Nar-formatted
-archives with interspersed meta-data joining them together, possibly with a
-digital signature at the end.  Log progress to LOG-PORT.  Return the list of
-files restored.
-
-When LOCK? is #f, assume locks for the files to be restored are already held.
-This is the case when the daemon calls a build hook.
-
-Note that this procedure accesses the store directly, so it's only meant to be
-used by the daemon's build hooks since they cannot call back to the daemon
-while the locks are held."
-  (define %export-magic
-    ;; Number used to identify genuine file set archives.
-    #x4558494e)
-
-  (define port*
-    ;; Keep that one around, for error conditions.
-    port)
+  "Restore one store item from PORT; return its file name on success."
 
   (define (assert-valid-signature signature hash file)
     ;; Bail out if SIGNATURE, which must be a string as produced by
@@ -416,51 +410,84 @@ s-expression"))
                  (&nar-signature-error
                   (signature signature) (file file) (port port))))))))
 
+  (define %export-magic
+    ;; Number used to identify genuine file set archives.
+    #x4558494e)
+
+  (define port*
+    ;; Keep that one around, for error conditions.
+    port)
+
+  (let-values (((port get-hash)
+                (open-sha256-input-port port)))
+    (with-temporary-store-file temp
+      (restore-file port temp)
+
+      (let ((magic (read-int port)))
+        (unless (= magic %export-magic)
+          (raise (condition
+                  (&message (message "corrupt file set archive"))
+                  (&nar-read-error
+                   (port port*) (file #f) (token #f))))))
+
+      (let ((file     (read-store-path port))
+            (refs     (read-store-path-list port))
+            (deriver  (read-string port))
+            (hash     (get-hash))
+            (has-sig? (= 1 (read-int port))))
+        (format log-port
+                (_ "importing file or directory '~a'...~%")
+                file)
+
+        (let ((sig (and has-sig? (read-string port))))
+          (when verify-signature?
+            (if sig
+                (begin
+                  (assert-valid-signature sig hash file)
+                  (format log-port
+                          (_ "found valid signature for '~a'~%")
+                          file)
+                  (finalize-store-file temp file
+                                       #:references refs
+                                       #:deriver deriver
+                                       #:lock? lock?))
+                (raise (condition
+                        (&message (message "imported file lacks \
+a signature"))
+                        (&nar-signature-error
+                         (port port*) (file file) (signature #f))))))
+          file)))))
+
+(define* (restore-file-set port
+                           #:key (verify-signature? #t) (lock? #t)
+                           (log-port (current-error-port)))
+  "Restore the file set read from PORT to the store.  The format of the data
+on PORT must be as created by 'export-paths'---i.e., a series of Nar-formatted
+archives with interspersed meta-data joining them together, possibly with a
+digital signature at the end.  Log progress to LOG-PORT.  Return the list of
+files restored.
+
+When LOCK? is #f, assume locks for the files to be restored are already held.
+This is the case when the daemon calls a build hook.
+
+Note that this procedure accesses the store directly, so it's only meant to be
+used by the daemon's build hooks since they cannot call back to the daemon
+while the locks are held."
+  (define acl
+    (current-acl))
+
   (let loop ((n     (read-long-long port))
              (files '()))
     (case n
       ((0)
        (reverse files))
       ((1)
-       (let-values (((port get-hash)
-                     (open-sha256-input-port port)))
-         (let ((temp (temporary-store-directory)))
-           (restore-file port temp)
-           (let ((magic (read-int port)))
-             (unless (= magic %export-magic)
-               (raise (condition
-                       (&message (message "corrupt file set archive"))
-                       (&nar-read-error
-                        (port port*) (file #f) (token #f))))))
-
-           (let ((file     (read-store-path port))
-                 (refs     (read-store-path-list port))
-                 (deriver  (read-string port))
-                 (hash     (get-hash))
-                 (has-sig? (= 1 (read-int port))))
-             (format log-port
-                     (_ "importing file or directory '~a'...~%")
-                     file)
-
-             (let ((sig (and has-sig? (read-string port))))
-               (when verify-signature?
-                 (if sig
-                     (begin
-                       (assert-valid-signature sig hash file)
-                       (format log-port
-                               (_ "found valid signature for '~a'~%")
-                               file)
-                       (finalize-store-file temp file
-                                            #:references refs
-                                            #:deriver deriver
-                                            #:lock? lock?)
-                       (loop (read-long-long port)
-                             (cons file files)))
-                     (raise (condition
-                             (&message (message "imported file lacks \
-a signature"))
-                             (&nar-signature-error
-                              (port port*) (file file) (signature #f)))))))))))
+       (let ((file
+              (restore-one-item port
+                                #:acl acl #:verify-signature? verify-signature?
+                                #:lock? lock? #:log-port log-port)))
+         (loop (read-long-long port)
+               (cons file files))))
       (else
        ;; Neither 0 nor 1.
        (raise (condition
@@ -468,4 +495,8 @@ a signature"))
                (&nar-read-error
                 (port port) (file #f) (token #f))))))))
 
+;;; Local Variables:
+;;; eval: (put 'with-temporary-store-file 'scheme-indent-function 1)
+;;; End:
+
 ;;; nar.scm ends here