@@ -453,14 +453,12 @@ (define-syntax-rule (catch-system-error exp)
(const #f)))
(define* (download-nar narinfo destination
- #:key status-port
- deduplicate? print-build-trace?
+ #:key deduplicate? print-build-trace?
(fetch-timeout %fetch-timeout)
prefer-fast-decompression?)
"Download the nar prescribed in NARINFO, which is assumed to be authentic
and authorized, and write it to DESTINATION. When DEDUPLICATE? is true, and
-if DESTINATION is in the store, deduplicate its files. Print a status line to
-STATUS-PORT."
+if DESTINATION is in the store, deduplicate its files."
(define destination-in-store?
(string-prefix? (string-append (%store-prefix) "/")
destination))
@@ -576,24 +574,8 @@ (define* (download-nar narinfo destination
;; Wait for the reporter to finish.
(every (compose zero? cdr waitpid) pids)
- ;; Skip a line after what 'progress-reporter/file' printed, and another
- ;; one to visually separate substitutions. When PRINT-BUILD-TRACE? is
- ;; true, leave it up to (guix status) to prettify things.
- (newline (current-error-port))
- (unless print-build-trace?
- (newline (current-error-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 status-port "success ~a ~a~%"
- (narinfo-hash narinfo) (narinfo-size narinfo))
- ;; The actual data has a different hash than that in NARINFO.
- (format status-port "hash-mismatch ~a ~a ~a~%"
- (hash-algorithm-name algorithm)
- (bytevector->nix-base32-string expected)
- (bytevector->nix-base32-string actual)))))))
+ (values expected
+ (get-hash)))))
(define (system-error? exception)
"Return true if EXCEPTION is a Guile 'system-error exception."
@@ -615,7 +597,7 @@ (define network-error?
'(gnutls-error getaddrinfo-error)))
(http-get-error? exception)))))
-(define* (process-substitution/fallback port narinfo destination
+(define* (process-substitution/fallback narinfo destination
#:key cache-urls acl
deduplicate? print-build-trace?
prefer-fast-decompression?)
@@ -630,9 +612,8 @@ (define* (process-substitution/fallback port narinfo destination
(let loop ((cache-urls cache-urls))
(match cache-urls
(()
- (report-error (G_ "failed to find alternative substitute for '~a'~%")
- (narinfo-path narinfo))
- (display "not-found\n" port))
+ ;; Failure, so return two values like download-nar
+ (values #f #f))
((cache-url rest ...)
(match (lookup-narinfos cache-url
(list (narinfo-path narinfo))
@@ -650,7 +631,6 @@ (define* (process-substitution/fallback port narinfo destination
(http-get-error-reason c)))
(loop rest)))
(download-nar alternate destination
- #:status-port port
#:deduplicate? deduplicate?
#:print-build-trace? print-build-trace?
#:prefer-fast-decompression?
@@ -659,7 +639,7 @@ (define* (process-substitution/fallback port narinfo destination
(()
(loop rest)))))))
-(define* (process-substitution port store-item destination
+(define* (process-substitution store-item destination
#:key cache-urls acl
deduplicate? print-build-trace?
prefer-fast-decompression?)
@@ -680,28 +660,34 @@ (define* (process-substitution port store-item destination
(G_ "no valid substitute for '~a'~%")
store-item)))
- (guard (c ((network-error? c)
- (when (http-get-error? c)
- (warning (G_ "download from '~a' failed: ~a, ~s~%")
- (uri->string (http-get-error-uri c))
- (http-get-error-code c)
- (http-get-error-reason c)))
- (format (current-error-port)
- (G_ "retrying download of '~a' with other substitute URLs...~%")
- store-item)
- (process-substitution/fallback port narinfo destination
- #:cache-urls cache-urls
- #:acl acl
- #:deduplicate? deduplicate?
- #:print-build-trace?
- print-build-trace?
- #:prefer-fast-decompression?
- prefer-fast-decompression?)))
- (download-nar narinfo destination
- #:status-port port
- #:deduplicate? deduplicate?
- #:print-build-trace? print-build-trace?
- #:prefer-fast-decompression? prefer-fast-decompression?)))
+ (let ((expected-hash
+ actual-hash
+ (guard
+ (c ((network-error? c)
+ (when (http-get-error? c)
+ (warning (G_ "download from '~a' failed: ~a, ~s~%")
+ (uri->string (http-get-error-uri c))
+ (http-get-error-code c)
+ (http-get-error-reason c)))
+ (format
+ (current-error-port)
+ (G_ "retrying download of '~a' with other substitute URLs...~%")
+ store-item)
+ (process-substitution/fallback narinfo destination
+ #:cache-urls cache-urls
+ #:acl acl
+ #:deduplicate? deduplicate?
+ #:print-build-trace?
+ print-build-trace?
+ #:prefer-fast-decompression?
+ prefer-fast-decompression?)))
+ (download-nar narinfo destination
+ #:deduplicate? deduplicate?
+ #:print-build-trace? print-build-trace?
+ #:prefer-fast-decompression? prefer-fast-decompression?))))
+ (values narinfo
+ expected-hash
+ actual-hash)))
;;;
@@ -897,10 +883,13 @@ (define-command (guix-substitute . args)
((? eof-object?)
#t)
((= string-tokenize ("substitute" store-path destination))
- (let ((cpu-usage
+ (let ((narinfo
+ expected-hash
+ actual-hash
+ cpu-usage
(with-cpu-usage-monitoring
(process-substitution
- reply-port store-path destination
+ store-path destination
#:cache-urls (substitute-urls)
#:acl (current-acl)
#:deduplicate? deduplicate?
@@ -909,26 +898,55 @@ (define-command (guix-substitute . args)
#:prefer-fast-decompression?
prefer-fast-decompression?))))
- ;; Create a hysteresis: depending on CPU usage, favor
- ;; compression methods with faster decompression (like ztsd)
- ;; or methods with better compression ratios (like lzip).
- ;; This stems from the observation that substitution can be
- ;; CPU-bound when high-speed networks are used:
- ;; <https://lists.gnu.org/archive/html/guix-devel/2020-12/msg00177.html>.
- ;; To simulate "slow" networking or changing conditions, run:
- ;; sudo tc qdisc add dev eno1 root tbf rate 512kbit latency
- ;; 50ms burst 1540 and then cancel with: sudo tc qdisc del
- ;; dev eno1 root
- (loop (cond
- ;; Whether to prefer fast decompression over good
- ;; compression ratios. This serves in particular to
- ;; choose between lzip (high compression ratio but low
- ;; decompression throughput) and zstd (lower
- ;; compression ratio but high decompression
- ;; throughput).
- ((> cpu-usage .8) #t)
- ((< cpu-usage .2) #f)
- (else prefer-fast-decompression?)))))))))
+ (if expected-hash
+ (begin
+ ;; Skip a line after what 'progress-reporter/file'
+ ;; printed, and another one to visually separate
+ ;; substitutions. When PRINT-BUILD-TRACE? is true,
+ ;; leave it up to (guix status) to prettify things.
+ (newline (current-error-port))
+ (unless print-build-trace?
+ (newline (current-error-port)))
+
+ ;; Check whether we got the data announced in NARINFO.
+ (if (bytevector=? actual-hash expected-hash)
+ ;; Tell the daemon that we're done.
+ (format reply-port "success ~a ~a~%"
+ (narinfo-hash narinfo) (narinfo-size narinfo))
+ ;; The actual data has a different hash than that in NARINFO.
+ (format reply-port "hash-mismatch ~a ~a ~a~%"
+ (hash-algorithm-name
+ (narinfo-hash-algorithm+value narinfo))
+ (bytevector->nix-base32-string expected-hash)
+ (bytevector->nix-base32-string actual-hash)))
+
+ ;; Create a hysteresis: depending on CPU usage, favor
+ ;; compression methods with faster decompression (like
+ ;; ztsd) or methods with better compression ratios
+ ;; (like lzip). This stems from the observation that
+ ;; substitution can be CPU-bound when high-speed
+ ;; networks are used:
+ ;; <https://lists.gnu.org/archive/html/guix-devel/2020-12/msg00177.html>.
+ ;; To simulate "slow" networking or changing
+ ;; conditions, run: sudo tc qdisc add dev eno1 root tbf
+ ;; rate 512kbit latency 50ms burst 1540 and then cancel
+ ;; with: sudo tc qdisc del dev eno1 root
+ (loop (cond
+ ;; Whether to prefer fast decompression over
+ ;; good compression ratios. This serves in
+ ;; particular to choose between lzip (high
+ ;; compression ratio but low decompression
+ ;; throughput) and zstd (lower compression ratio
+ ;; but high decompression throughput).
+ ((> cpu-usage .8) #t)
+ ((< cpu-usage .2) #f)
+ (else prefer-fast-decompression?))))
+ (begin
+ (report-error (G_ "failed to find alternative substitute for '~a'~%")
+ (narinfo-path narinfo))
+ (display "not-found\n" reply-port)
+
+ (loop prefer-fast-decompression?)))))))))
(opts
(leave (G_ "~a: unrecognized options~%") opts))))))