scripts: substitute: Extract script specific output from download-nar.

As this moves download-nar in a direction where it could be used outside the
substitute script.

* guix/scripts/substitute.scm (download-nar): Return expected and actual
hashes and move status-port output to guix-substitute.
(process-substitution/fallback): Remove port argument, and move output to port
to guix-substitute.
(process-substitution): Return hashes from download-nar or
process-substitution/fallback, plus the narinfo.
(guix-substitute): Don't pass the reply-port in to process-substitution and
implement the messages to the reply-port here.

Change-Id: Icbddb9a47620b3520cdd2e8095f37a99824c1ce0

1 files changed, 90 insertions, 72 deletions

diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm
index 0d0fd0e73b..c2bc16085d 100755
--- a/guix/scripts/substitute.scm
+++ b/guix/scripts/substitute.scm
@@ -453,14 +453,12 @@ server certificates."
     (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 @@ STATUS-PORT."
       ;; 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 @@ STATUS-PORT."
                      '(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 @@ way to download the nar."
   (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 @@ way to download the nar."
                                     (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 @@ way to download the nar."
          (()
           (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 @@ PORT."
       (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 @@ default value."
               ((? 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 @@ default value."
                         #: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))))))