scripts: substitute: restored nars only appear after verification.

The hash of a nar is only known once 'download-nar' completes.  By that point
the nar may already have been partially-restored to its destination for some
time.  Additionally, after a hash mismatch is detected, 'guix substitute'
leaves the invalid contents at the specified destination.  This means that
untrusted, attacker-controlled contents are present at what at some point may
have been or at some point may become a valid store path.  It is entirely
possible that a user or program won't check that a given store item is valid
before trying to use it (it may be that 'guix gc' was run while an obscured
reference was held).  Let's protect them in that case by ensuring that
unverified contents are kept elsewhere, in a temporary directory.

While implementing this one such program was discovered: tests/substitute.scm.
It actually incorrectly computes the hashes of the nars it supplies to (guix
scripts substitute), computing the hash of the plain contents instead of the
hash of the nar.  These tests nevertheless passed because they didn't check
what (guix scripts substitute) gave as output, instead only checking that the
expected contents were at the specified destination.

* guix/scripts/substitute.scm (call-with-temporary-directory-in): new
  procedure.
  (guix-substitute): use it to create a temporary directory next to the final
  destination to restore the nar inside of.  Once it is fully restored, if the
  hash matches, move it to the final destination, deleting the file currently
  there if it already exists.
* tests/substitute.scm (plain-file-nar-sha256): new procedure.
  (%narinfo, "substitute, narinfo with several URLS" test): use it.

Change-Id: Ifeb9b4c912f9d9b2e7477d237da04e7d5175ff83
Signed-off-by: Ludovic Courtès <ludo@gnu.org>

2 files changed, 69 insertions, 12 deletions

diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm
index 49f5389fe27..383661511e2 100755
--- a/guix/scripts/substitute.scm
+++ b/guix/scripts/substitute.scm
@@ -44,7 +44,7 @@
                            . guix:open-connection-for-uri)))
   #:use-module (guix progress)
   #:use-module ((guix build syscalls)
-                #:select (set-thread-name))
+                #:select (set-thread-name mkdtemp!))
   #:use-module (ice-9 rdelim)
   #:use-module (ice-9 match)
   #:use-module (ice-9 format)
@@ -630,6 +630,26 @@ default value."
   ;; use the current output port instead.
   (make-parameter 4))
 
+;; XXX: copied from (guix utils)
+(define (call-with-temporary-directory-in directory proc)
+  "Call PROC with a name of a temporary directory; close the directory and
+delete it when leaving the dynamic extent of this call."
+  (let* ((template  (string-append directory "/guix-directory-"
+                                   ;; In case the temporary directory may be
+                                   ;; garbage collected, including our pid
+                                   ;; ensures that no live process can mistake
+                                   ;; our freshly-created instance for their
+                                   ;; old deleted one.
+                                   (number->string (getpid))
+                                   ".XXXXXX"))
+         (tmp-dir   (mkdtemp! template)))
+    (dynamic-wind
+      (const #t)
+      (lambda ()
+        (proc tmp-dir))
+      (lambda ()
+        (false-if-exception (delete-file-recursively tmp-dir))))))
+
 (define-command (guix-substitute . args)
   (category internal)
   (synopsis "implement the build daemon's substituter protocol")
@@ -712,15 +732,35 @@ default value."
                       actual-hash
                       cpu-usage
                       (with-cpu-usage-monitoring
-                       (process-substitution
-                        store-path destination
-                        #:cache-urls (substitute-urls)
-                        #:acl (current-acl)
-                        #:deduplicate? deduplicate?
-                        #:print-build-trace?
-                        print-build-trace?
-                        #:fast-decompression?
-                        fast-decompression?))))
+                       ;; Restore inside a temporary directory until the hash
+                       ;; can be verified so that no dangling references a
+                       ;; user may have laying around will point to
+                       ;; attacker-controlled content in the meantime.
+                       (call-with-temporary-directory-in (dirname destination)
+                         (lambda (temp-directory)
+                           (let* ((temp-destination
+                                   (string-append temp-directory "/restored"))
+                                  (narinfo
+                                   expected-hash
+                                   actual-hash
+                                   (process-substitution
+                                    store-path temp-destination
+                                    #:cache-urls (substitute-urls)
+                                    #:acl (current-acl)
+                                    #:deduplicate? deduplicate?
+                                    #:print-build-trace?
+                                    print-build-trace?
+                                    #:fast-decompression?
+                                    fast-decompression?)))
+                             (when (and expected-hash actual-hash
+                                        (bytevector=? actual-hash
+                                                      expected-hash))
+                               (catch 'system-error
+                                 (lambda ()
+                                   (delete-file-recursively destination))
+                                 (const #f))
+                               (rename-file temp-destination destination))
+                             (values narinfo expected-hash actual-hash)))))))
 
                  (if expected-hash
                      (begin
@@ -777,6 +817,7 @@ default value."
 
 ;;; Local Variables:
 ;;; eval: (put 'with-redirected-error-port 'scheme-indent-function 0)
+;;; eval: (put 'call-with-temporary-directory-in 'scheme-indent-function 1)
 ;;; End:
 
 ;;; substitute.scm ends here
diff --git a/tests/substitute.scm b/tests/substitute.scm
index 10b74db084e..086bd588358 100644
--- a/tests/substitute.scm
+++ b/tests/substitute.scm
@@ -39,6 +39,7 @@
   #:use-module (rnrs io ports)
   #:use-module (web uri)
   #:use-module (ice-9 regex)
+  #:use-module (ice-9 binary-ports)
   #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-34)
@@ -142,6 +143,21 @@ version identifier.."
   ;; <https://www.rfc-editor.org/rfc/rfc5737>.
   "http://203.0.113.1")
 
+(define (plain-file-nar-sha256 string)
+  (sha256 (call-with-output-bytevector
+           (lambda (port)
+             (let ((bv (string->utf8 string)))
+               (call-with-input-bytevector
+                bv
+                (lambda (contents)
+                  (write-file-tree #t port
+                                   #:file-type+size
+                                   (lambda (_)
+                                     (values 'regular
+                                             (bytevector-length
+                                              bv)))
+                                   #:file-port
+                                   (const contents)))))))))
 
 (define %narinfo
   ;; Skeleton of the narinfo used below.
@@ -150,7 +166,7 @@ version identifier.."
 URL: example.nar
 Compression: none
 NarHash: sha256:" (bytevector->nix-base32-string
-                   (sha256 (string->utf8 "Substitutable data."))) "
+                   (plain-file-nar-sha256 "Substitutable data.")) "
 NarSize: 42
 References: bar baz
 Deriver: " (%store-prefix) "/foo.drv
@@ -819,7 +835,7 @@ Compression: lzip
 URL: example.nar
 Compression: none
 NarHash: sha256:" (bytevector->nix-base32-string
-                   (sha256 (string->utf8 "Substitutable data."))) "
+                   (plain-file-nar-sha256 "Substitutable data.")) "
 NarSize: 42
 References: bar baz
 Deriver: " (%store-prefix) "/foo.drv