[bug#41797] [PATCH] replace with-temporary-store-file

[Caleb Ristvedt <caleb.ristvedt@cune.org>]

[-- Attachment #1.1: Type: text/plain, Size: 426 bytes --]

with-temporary-store-file suffers from race conditions - see attached
patch commit message for details.

This addresses a problem that it's very likely nobody has run into yet,
due to the sheer size of the tempfile namespace, but that could
potentially cause serious issues, including store corruption.

The new procedure used to resolve this (restore-to-temp-store-file) will
be of use in the guile-daemon anyway.

- reepca


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1.2: 0001-nar-fix-race-conditions-inherent-to-with-temporary-s.patch --]
[-- Type: text/x-patch, Size: 9318 bytes --]

From 8c26304951a2e21fe9b373b9cd543353d08fe003 Mon Sep 17 00:00:00 2001
From: Caleb Ristvedt <caleb.ristvedt@cune.org>
Date: Wed, 10 Jun 2020 22:24:27 -0500
Subject: [PATCH] nar: fix race conditions inherent to
 with-temporary-store-file.

with-temporary-store-file has a fundamental flaw: it assumes that if a
temporary store file exists, is then added as a temporary root, and still
exists, then it uniquely belongs to the current process.  This is not always
the case, because the only criteria used for choosing temporary file names is
that they not be currently used and fit a certain template.  This means it's
entirely possible for another process to choose the same temporary file name
if it doesn't exist at the time it chooses.

Suppose process A chooses F as its temporary file name in
with-temporary-store-file.  Suppose before it adds it as a temp root, F gets
garbage collected.  Suppose process B then happens to, at that point, choose F
as its temporary file name.  This is completely valid, because F doesn't exist
at that point.  Then process A will check whether F exists, see that it does,
and assume that it uniquely owns that file, when in reality two processes are
now simultaneously trying to use it.  Process A will then delete the file in
question, causing errors in process A, B, or both.

The same issue (two processes both believing they've exclusively allocated a
temp file) can occur any time between when process A deletes the temp file
prior to running the body and when (if) its body actually creates the temp
file.

In short, allocating a temporary file *name* isn't possible with the
mechanisms currently in place - we have no way of telling other users of
with-temporary-store-file whether a file name is allocated or not.  Allocating
a temporary *file*, on the other hand, is possible.  This removes
with-temporary-store-file and replaces it with with-temporary-restored-file,
and adjusts its only user, restore-one-item, accordingly.

* guix/serialization.scm (restore-to-temp-store-file): new procedure.
* guix/nar.scm (with-temporary-store-file): replaced with
  with-temporary-restored-file.
  (with-temporary-restored-file): new macro.
  (restore-one-item): use with-temporary-restored-file instead of
  with-temporary-store-file.
  (temporary-store-file): removed, as it is no longer used.
  (Local Variables footer): update indenting information for
  with-temporary-restored-file.
---
 guix/nar.scm           | 38 +++++++-------------
 guix/serialization.scm | 79 +++++++++++++++++++++++++++++++++++++++++-
 2 files changed, 90 insertions(+), 27 deletions(-)

diff --git a/guix/nar.scm b/guix/nar.scm
index eff4becbce..2666d32169 100644
--- a/guix/nar.scm
+++ b/guix/nar.scm
@@ -128,30 +128,18 @@ held."
           (force-output lock)
           (unlock-file lock))))))
 
-(define (temporary-store-file)
-  "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)
-    template))
-
-(define-syntax-rule (with-temporary-store-file name body ...)
+(define-syntax-rule (with-temporary-restored-file port name body ...)
   "Evaluate BODY with NAME bound to the file name of a temporary store item
-protected from GC."
+restored from PORT and protected from GC.  Note that the temporary store item
+won't be automatically deleted."
   (with-store store
-    (let loop ((name (temporary-store-file)))
-      ;; 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))))))
+    ;; 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.)
+    (let ((name (restore-to-temp-store-file port
+                                            (lambda (root)
+                                              (add-temp-root store root)))))
+      body ...)))
 
 (define* (restore-one-item port
                            #:key acl (verify-signature? #t) (lock? #t)
@@ -208,9 +196,7 @@ s-expression"))
 
   (let-values (((port get-hash)
                 (open-sha256-input-port port)))
-    (with-temporary-store-file temp
-      (restore-file port temp)
-
+    (with-temporary-restored-file port temp
       (let ((magic (read-int port)))
         (unless (= magic %export-magic)
           (raise (condition
@@ -286,7 +272,7 @@ while the locks are held."
                 (port port) (file #f) (token #f))))))))
 
 ;;; Local Variables:
-;;; eval: (put 'with-temporary-store-file 'scheme-indent-function 1)
+;;; eval: (put 'with-temporary-restored-file 'scheme-indent-function 2)
 ;;; End:
 
 ;;; nar.scm ends here
diff --git a/guix/serialization.scm b/guix/serialization.scm
index 836ad06caf..c6b9674104 100644
--- a/guix/serialization.scm
+++ b/guix/serialization.scm
@@ -18,6 +18,7 @@
 
 (define-module (guix serialization)
   #:use-module (guix combinators)
+  #:use-module (guix config)
   #:use-module (rnrs bytevectors)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
@@ -28,6 +29,7 @@
   #:use-module (ice-9 match)
   #:use-module (ice-9 ftw)
   #:use-module (system foreign)
+  #:use-module (rnrs io ports)
   #:export (write-int read-int
             write-long-long read-long-long
             write-padding
@@ -51,7 +53,8 @@
             write-file
             write-file-tree
             fold-archive
-            restore-file))
+            restore-file
+            restore-to-temp-store-file))
 
 ;;; Comment:
 ;;;
@@ -477,6 +480,80 @@ Restore it as FILE."
                 port
                 file))
 
+(define* (restore-to-temp-store-file port add-temp-root #:optional name)
+  "Read a file (possibly a directory structure) in Nar format from PORT.
+Restore it as a temporary file and return the temporary file name.
+ADD-TEMP-ROOT must be a procedure of one argument (the file name) that
+protects that file name from garbage collection.  Note that ADD-TEMP-ROOT may
+be called multiple times."
+  (define (tempname)
+    (let ((template (string-append %store-directory "/guix-temp-file"
+                                   (if name
+                                       (string-append "-" name)
+                                       "")
+                                   ".XXXXXX")))
+      (close (mkstemp! template))
+      (delete-file template)
+      template))
+
+  (define (create/top-level create)
+    (let ((name (tempname)))
+      (add-temp-root name)
+      (catch 'system-error
+        (lambda ()
+          (create name)
+          name)
+        (lambda args
+          (if (= (system-error-errno args) EEXIST)
+              (mkdir/top-level)
+              (apply throw args))))))
+
+  (define (create-output-file name input size type)
+    (call-with-port (open name (logior O_WRONLY
+                                       O_EXCL
+                                       O_CREAT))
+                    (lambda (output)
+                      (dump input output size)
+                      (when (eq? type 'executable)
+                        (chmod output #o755)))))
+
+  (define (create-output-file/top-level input size type)
+    (create/top-level (cut create-output-file <> input size type)))
+
+  (define mkdir/top-level
+    (cut create/top-level mkdir))
+
+  (define (symlink/top-level target)
+    (create/top-level (cut symlink target <>)))
+
+  (fold-archive (lambda (file type content top-name)
+                  (define-syntax-rule (if-top-level exp1 exp2)
+                    (if top-name
+                        (begin
+                          exp2
+                          top-name)
+                        exp1))
+
+                  (match type
+                    ('directory
+                     (if-top-level (mkdir/top-level)
+                                   (mkdir (string-append top-name file))))
+                    ('symlink
+                     (if-top-level
+                      (symlink/top-level content)
+                      (symlink content (string-append top-name file))))
+                    ((or 'regular 'executable)
+                     (match content
+                       ((input . size)
+                        (if-top-level
+                         (create-output-file/top-level input size type)
+                         (create-output-file (string-append top-name
+                                                            file)
+                                             input size type)))))))
+                #f
+                port
+                ""))
+
 ;;; Local Variables:
 ;;; eval: (put 'call-with-binary-input-file 'scheme-indent-function 1)
 ;;; End:
-- 
2.26.2


[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 487 bytes --]