daemon: Let 'guix substitute' perform hash checks.

This way, the hash of the store item can be computed as it is restored,
thereby avoiding an additional file tree traversal ('hashPath' call)
later on in the daemon.  Consequently, it should reduce latency between
subsequent substitute downloads.

This is a followup to 5ff521452b9ec2aae9ed8e4bb7bdc250a581f203.

* guix/scripts/substitute.scm (narinfo-hash-algorithm+value): New
procedure.
(process-substitution): Wrap INPUT into a hash input port, 'hashed', and
read from it.  Compare the actual and expected hashes, and print a
"hash-mismatch" status line when they differ.  When they match, print
not just "success" but also the nar hash and size.
* nix/libstore/build.cc (class SubstitutionGoal)[expectedHashStr]:
Remove.
(SubstitutionGoal::finished): Tokenize 'status'.  Parse it and handle
"success" and "hash-mismatch" accordingly.  Call 'hashPath' only when
the returned hash is not SHA256.
(SubstitutionGoal::handleChildOutput): Remove 'expectedHashStr'
handling.
* tests/substitute.scm ("substitute, invalid hash"): Rename to...
("substitute, invalid narinfo hash"): ... this.
("substitute, invalid hash"): New test.

3 files changed, 124 insertions, 44 deletions

diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm
index 25075eedff..17d0002b9f 100755
--- a/guix/scripts/substitute.scm
+++ b/guix/scripts/substitute.scm
@@ -26,6 +26,8 @@
   #:use-module (guix combinators)
   #:use-module (guix config)
   #:use-module (guix records)
+  #:use-module (guix diagnostics)
+  #:use-module (guix i18n)
   #:use-module ((guix serialization) #:select (restore-file))
   #:autoload   (guix scripts discover) (read-substitute-urls)
   #:use-module (gcrypt hash)
@@ -256,6 +258,18 @@ connection (typically PORT) is kept open once data has been fetched from URI."
   ;; for more information.
   (contents     narinfo-contents))
 
+(define (narinfo-hash-algorithm+value narinfo)
+  "Return two values: the hash algorithm used by NARINFO and its value as a
+bytevector."
+  (match (string-tokenize (narinfo-hash narinfo)
+                          (char-set-complement (char-set #\:)))
+    ((algorithm base32)
+     (values (lookup-hash-algorithm (string->symbol algorithm))
+             (nix-base32-string->bytevector base32)))
+    (_
+     (raise (formatted-message
+             (G_ "invalid narinfo hash: ~s") (narinfo-hash narinfo))))))
+
 (define (narinfo-hash->sha256 hash)
   "If the string HASH denotes a sha256 hash, return it as a bytevector.
 Otherwise return #f."
@@ -1033,7 +1047,9 @@ one.  Return #f if URI's scheme is 'file' or #f."
 (define* (process-substitution store-item destination
                                #:key cache-urls acl print-build-trace?)
   "Substitute STORE-ITEM (a store file name) from CACHE-URLS, and write it to
-DESTINATION as a nar file.  Verify the substitute against ACL."
+DESTINATION as a nar file.  Verify the substitute against ACL, and verify its
+hash against what appears in the narinfo.  Print a status line on the current
+output port."
   (define narinfo
     (lookup-narinfo cache-urls store-item
                     (cut valid-narinfo? <> acl)))
@@ -1044,9 +1060,6 @@ DESTINATION as a nar file.  Verify the substitute against ACL."
 
   (let-values (((uri compression file-size)
                 (narinfo-best-uri narinfo)))
-    ;; Tell the daemon what the expected hash of the Nar itself is.
-    (format #t "~a~%" (narinfo-hash narinfo))
-
     (unless print-build-trace?
       (format (current-error-port)
               (G_ "Downloading ~a...~%") (uri->string uri)))
@@ -1079,9 +1092,16 @@ DESTINATION as a nar file.  Verify the substitute against ACL."
                    ;; closed here, while the child process doing the
                    ;; reporting will close it upon exit.
                    (decompressed-port (string->symbol compression)
-                                      progress)))
+                                      progress))
+
+                  ;; Compute the actual nar hash as we read it.
+                  ((algorithm expected)
+                   (narinfo-hash-algorithm+value narinfo))
+                  ((hashed get-hash)
+                   (open-hash-input-port algorithm input)))
       ;; Unpack the Nar at INPUT into DESTINATION.
-      (restore-file input destination)
+      (restore-file hashed destination)
+      (close-port hashed)
       (close-port input)
 
       ;; Wait for the reporter to finish.
@@ -1091,8 +1111,17 @@ DESTINATION as a nar file.  Verify the substitute against ACL."
       ;; one to visually separate substitutions.
       (display "\n\n" (current-error-port))
 
-      ;; Tell the daemon that we're done.
-      (display "success\n" (current-output-port)))))
+      ;; Check whether we got the data announced in NARINFO.
+      (let ((actual (get-hash)))
+        (if (bytevector=? actual expected)
+            ;; Tell the daemon that we're done.
+            (format (current-output-port) "success ~a ~a~%"
+                    (narinfo-hash narinfo) (narinfo-size narinfo))
+            ;; The actual data has a different hash than that in NARINFO.
+            (format (current-output-port) "hash-mismatch ~a ~a ~a~%"
+                    (hash-algorithm-name algorithm)
+                    (bytevector->nix-base32-string expected)
+                    (bytevector->nix-base32-string actual)))))))
 
 
 ;;;
diff --git a/nix/libstore/build.cc b/nix/libstore/build.cc
index b5551b87ae..b19471a68f 100644
--- a/nix/libstore/build.cc
+++ b/nix/libstore/build.cc
@@ -2790,10 +2790,6 @@ private:
     /* The substituter. */
     std::shared_ptr<Agent> substituter;
 
-    /* Either the empty string, or the expected hash as returned by the
-       substituter.  */
-    string expectedHashStr;
-
     /* Either the empty string, or the status phrase returned by the
        substituter.  */
     string status;
@@ -3032,36 +3028,47 @@ void SubstitutionGoal::finished()
     /* Check the exit status and the build result. */
     HashResult hash;
     try {
-
-        if (status != "success")
-            throw SubstError(format("fetching path `%1%' (status: '%2%')")
-                % storePath % status);
-
-        if (!pathExists(destPath))
-            throw SubstError(format("substitute did not produce path `%1%'") % destPath);
-
-	if (expectedHashStr == "")
-	    throw SubstError(format("substituter did not communicate hash for `%1'") % storePath);
-
-        hash = hashPath(htSHA256, destPath);
-
-        /* Verify the expected hash we got from the substituer. */
-	size_t n = expectedHashStr.find(':');
-	if (n == string::npos)
-	    throw Error(format("bad hash from substituter: %1%") % expectedHashStr);
-	HashType hashType = parseHashType(string(expectedHashStr, 0, n));
-	if (hashType == htUnknown)
-	    throw Error(format("unknown hash algorithm in `%1%'") % expectedHashStr);
-	Hash expectedHash = parseHash16or32(hashType, string(expectedHashStr, n + 1));
-	Hash actualHash = hashType == htSHA256 ? hash.first : hashPath(hashType, destPath).first;
-	if (expectedHash != actualHash) {
-	    if (settings.printBuildTrace)
+	auto statusList = tokenizeString<vector<string> >(status);
+
+	if (statusList.empty()) {
+            throw SubstError(format("fetching path `%1%' (empty status: '%2%')")
+			     % storePath % status);
+	} else if (statusList[0] == "hash-mismatch") {
+	    if (settings.printBuildTrace) {
+		auto hashType = statusList[1];
+		auto expectedHash = statusList[2];
+		auto actualHash = statusList[3];
 		printMsg(lvlError, format("@ hash-mismatch %1% %2% %3% %4%")
-			 % storePath % "sha256"
-			 % printHash16or32(expectedHash)
-			 % printHash16or32(actualHash));
+			 % storePath
+			 % hashType % expectedHash % actualHash);
+	    }
 	    throw SubstError(format("hash mismatch for substituted item `%1%'") % storePath);
+	} else if (statusList[0] == "success") {
+	    if (!pathExists(destPath))
+		throw SubstError(format("substitute did not produce path `%1%'") % destPath);
+
+	    std::string hashStr = statusList[1];
+	    size_t n = hashStr.find(':');
+	    if (n == string::npos)
+		throw Error(format("bad hash from substituter: %1%") % hashStr);
+
+	    HashType hashType = parseHashType(string(hashStr, 0, n));
+	    switch (hashType) {
+	    case htUnknown:
+		throw Error(format("unknown hash algorithm in `%1%'") % hashStr);
+	    case htSHA256:
+		hash.first = parseHash16or32(hashType, string(hashStr, n + 1));
+		hash.second = std::atoi(statusList[2].c_str());
+		break;
+	    default:
+		/* The database only stores SHA256 hashes, so compute it.  */
+		hash = hashPath(htSHA256, destPath);
+		break;
+	    }
 	}
+	else
+            throw SubstError(format("fetching path `%1%' (status: '%2%')")
+                % storePath % status);
 
     } catch (SubstError & e) {
 
@@ -3123,9 +3130,7 @@ void SubstitutionGoal::handleChildOutput(int fd, const string & data)
 	    string trimmed = (end != string::npos) ? input.substr(0, end) : input;
 
 	    /* Update the goal's state accordingly.  */
-	    if (expectedHashStr == "") {
-		expectedHashStr = trimmed;
-	    } else if (status == "") {
+	    if (status == "") {
 		status = trimmed;
 		worker.wakeUp(shared_from_this());
 	    } else {
diff --git a/tests/substitute.scm b/tests/substitute.scm
index b86ce09425..5b42632552 100644
--- a/tests/substitute.scm
+++ b/tests/substitute.scm
@@ -28,7 +28,9 @@
   #:use-module (guix base32)
   #:use-module ((guix store) #:select (%store-prefix))
   #:use-module ((guix ui) #:select (guix-warning-port))
-  #:use-module ((guix utils) #:select (call-with-compressed-output-port))
+  #:use-module ((guix utils)
+                #:select (call-with-temporary-directory
+                          call-with-compressed-output-port))
   #:use-module ((guix build utils)
                 #:select (mkdir-p delete-file-recursively dump-port))
   #:use-module (guix tests http)
@@ -36,6 +38,7 @@
   #:use-module (rnrs io ports)
   #:use-module (web uri)
   #:use-module (ice-9 regex)
+  #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-34)
   #:use-module (srfi srfi-35)
@@ -304,7 +307,7 @@ System: mips64el-linux\n")
       (lambda ()
         (guix-substitute "--substitute")))))
 
-(test-quit "substitute, invalid hash"
+(test-quit "substitute, invalid narinfo hash"
     "no valid substitute"
   ;; The hash in the signature differs from the hash of %NARINFO.
   (with-narinfo (string-append %narinfo "Signature: "
@@ -317,6 +320,49 @@ System: mips64el-linux\n")
       (lambda ()
         (guix-substitute "--substitute")))))
 
+(test-equal "substitute, invalid hash"
+  (string-append "hash-mismatch sha256 "
+                 (bytevector->nix-base32-string (sha256 #vu8())) " "
+                 (let-values (((port get-hash)
+                               (open-hash-port (hash-algorithm sha256)))
+                              ((content)
+                               "Substitutable data."))
+                   (write-file-tree "foo" port
+                                    #:file-type+size
+                                    (lambda _
+                                      (values 'regular
+                                              (string-length content)))
+                                    #:file-port
+                                    (lambda _
+                                      (open-input-string content)))
+                   (close-port port)
+                   (bytevector->nix-base32-string (get-hash)))
+                 "\n")
+
+  ;; Arrange so the actual data hash does not match the 'NarHash' field in the
+  ;; narinfo.
+  (with-output-to-string
+    (lambda ()
+      (let ((narinfo (string-append "StorePath: " (%store-prefix)
+                                    "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-wrong-hash
+URL: example.nar
+Compression: none
+NarHash: sha256:" (bytevector->nix-base32-string (sha256 #vu8())) "
+NarSize: 42
+References: 
+Deriver: " (%store-prefix) "/foo.drv
+System: mips64el-linux\n")))
+        (with-narinfo (string-append narinfo "Signature: "
+                                     (signature-field narinfo) "\n")
+          (call-with-temporary-directory
+           (lambda (directory)
+             (with-input-from-string (string-append
+                                      "substitute " (%store-prefix)
+                                      "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-wrong-hash "
+                                      directory "/wrong-hash\n")
+               (lambda ()
+                 (guix-substitute "--substitute"))))))))))
+
 (test-quit "substitute, unauthorized key"
     "no valid substitute"
   (with-narinfo (string-append %narinfo "Signature: "