diff options
Diffstat (limited to 'guix/scripts/substitute.scm')
| -rwxr-xr-x | guix/scripts/substitute.scm | 45 |
1 files changed, 37 insertions, 8 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))))))) ;;; |