diff options
Diffstat (limited to 'guix/scripts/substitute.scm')
-rwxr-xr-x | guix/scripts/substitute.scm | 70 |
1 files changed, 60 insertions, 10 deletions
diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm index 25075eedff..38702d0c4b 100755 --- a/guix/scripts/substitute.scm +++ b/guix/scripts/substitute.scm @@ -26,7 +26,10 @@ #:use-module (guix combinators) #:use-module (guix config) #:use-module (guix records) - #:use-module ((guix serialization) #:select (restore-file)) + #:use-module (guix diagnostics) + #:use-module (guix i18n) + #:use-module ((guix serialization) #:select (restore-file dump-file)) + #:autoload (guix store deduplication) (dump-file/deduplicate) #:autoload (guix scripts discover) (read-substitute-urls) #:use-module (gcrypt hash) #:use-module (guix base32) @@ -256,6 +259,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." @@ -1031,22 +1046,33 @@ one. Return #f if URI's scheme is 'file' or #f." (call-with-cached-connection uri (lambda (port) exp ...))) (define* (process-substitution store-item destination - #:key cache-urls acl print-build-trace?) + #:key cache-urls acl + deduplicate? 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. When DEDUPLICATE? is true, and if +DESTINATION is in the store, deduplicate its files. Print a status line on +the current output port." (define narinfo (lookup-narinfo cache-urls store-item (cut valid-narinfo? <> acl))) + (define destination-in-store? + (string-prefix? (string-append (%store-prefix) "/") + destination)) + + (define (dump-file/deduplicate* . args) + ;; Make sure deduplication looks at the right store (necessary in test + ;; environments). + (apply dump-file/deduplicate + (append args (list #:store (%store-prefix))))) + (unless narinfo (leave (G_ "no valid substitute for '~a'~%") store-item)) (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 +1105,20 @@ 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 + #:dump-file (if (and destination-in-store? + deduplicate?) + dump-file/deduplicate* + dump-file)) + (close-port hashed) (close-port input) ;; Wait for the reporter to finish. @@ -1091,8 +1128,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))))))) ;;; @@ -1219,6 +1265,9 @@ default value." ((= string->number number) (> number 0)) (_ #f))) + (define deduplicate? + (find-daemon-option "deduplicate")) + ;; The daemon's agent code opens file descriptor 4 for us and this is where ;; stderr should go. (parameterize ((current-error-port (if (%error-to-file-descriptor-4?) @@ -1278,6 +1327,7 @@ default value." (process-substitution store-path destination #:cache-urls (substitute-urls) #:acl (current-acl) + #:deduplicate? deduplicate? #:print-build-trace? print-build-trace?) (loop)))))) |