[bug#69291] [PATCH 0/5] Start making substitute code less coupled

[bug#69291] [PATCH 0/5] Start making substitute code less coupled

[Christopher Baines]

[-- Attachment #1: Type: text/plain, Size: 682 bytes --]

These changes should help with using the substitute code in a Guile
implementation of the Guix daemon.


Christopher Baines (5):
  scripts: substitute: Remove side effect warning from network-error?.
  scripts: substitute: Allow not using with-timeout in download-nar.
  scripts: substitute: Replace some leave calls with raise.
  scripts: substitute: Untangle selecting fast vs small compressions.
  scripts: substitute: Extract script specific output from download-nar.

 guix/scripts/substitute.scm | 207 +++++++++++++++++++++---------------
 1 file changed, 123 insertions(+), 84 deletions(-)


base-commit: 3d061d9677027be7651f8e5a3a02e19daacd9a85
-- 
2.41.0

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 987 bytes --]

[bug#69291] [PATCH 1/5] scripts: substitute: Remove side effect warning from network-error?.

[Christopher Baines]

Instead, display the warning from process-substitution and
process-substitution/fallback in the relevant places.

I'm looking at this because I want to make the substitute code less tied to
the script and usable in the Guile guix-daemon.

* guix/scripts/substitute.scm (network-error?): Move warning to…
(process-substitution/fallback, process-substitution): here.

Change-Id: I082b482c0e6ec7e02a8d437ba22dcefca5c40787
---
 guix/scripts/substitute.scm | 21 +++++++++++++--------
 1 file changed, 13 insertions(+), 8 deletions(-)

diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm
index 37cd08e289..f3eed0eb44 100755
--- a/guix/scripts/substitute.scm
+++ b/guix/scripts/substitute.scm
@@ -613,13 +613,7 @@ (define network-error?
           (and (kind-and-args? exception)
                (memq (exception-kind exception)
                      '(gnutls-error getaddrinfo-error)))
-          (and (http-get-error? exception)
-               (begin
-                 (warning (G_ "download from '~a' failed: ~a, ~s~%")
-                          (uri->string (http-get-error-uri exception))
-                          (http-get-error-code exception)
-                          (http-get-error-reason exception))
-                 #t))))))
+          (http-get-error? exception)))))
 
 (define* (process-substitution/fallback port narinfo destination
                                         #:key cache-urls acl
@@ -647,7 +641,13 @@ (define* (process-substitution/fallback port narinfo destination
           (if (or (equivalent-narinfo? narinfo alternate)
                   (valid-narinfo? alternate acl)
                   (%allow-unauthenticated-substitutes?))
-              (guard (c ((network-error? c) (loop rest)))
+              (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)))
+                         (loop rest)))
                 (download-nar alternate destination
                               #:status-port port
                               #:deduplicate? deduplicate?
@@ -675,6 +675,11 @@ (define* (process-substitution port store-item destination
            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)

base-commit: 3d061d9677027be7651f8e5a3a02e19daacd9a85
-- 
2.41.0

[bug#69291] [PATCH 2/5] scripts: substitute: Allow not using with-timeout in download-nar.

[Christopher Baines]

I don't think the approach of using SIGALARM here for the timeout will work
well in all cases (e.g. when using Guile Fibers), so make it possible to avoid
this.

* guix/scripts/substitute.scm (download-nar): Pass the fetch timeout in as an
option.

Change-Id: I8cbe6cdfa10cdaa7d41974cbea56a95f5efecfe6
---
 guix/scripts/substitute.scm | 37 ++++++++++++++++++++++---------------
 1 file changed, 22 insertions(+), 15 deletions(-)

diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm
index f3eed0eb44..575fa2a0b3 100755
--- a/guix/scripts/substitute.scm
+++ b/guix/scripts/substitute.scm
@@ -452,7 +452,8 @@ (define-syntax-rule (catch-system-error exp)
 
 (define* (download-nar narinfo destination
                        #:key status-port
-                       deduplicate? print-build-trace?)
+                       deduplicate? print-build-trace?
+                       (fetch-timeout %fetch-timeout))
   "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
@@ -473,20 +474,26 @@ (define* (download-nar narinfo destination
        (let ((port (open-file (uri-path uri) "r0b")))
          (values port (stat:size (stat port)))))
       ((http https)
-       ;; Test this with:
-       ;;   sudo tc qdisc add dev eth0 root netem delay 1500ms
-       ;; and then cancel with:
-       ;;   sudo tc qdisc del dev eth0 root
-       (with-timeout %fetch-timeout
-         (begin
-           (warning (G_ "while fetching ~a: server is somewhat slow~%")
-                    (uri->string uri))
-           (warning (G_ "try `--no-substitutes' if the problem persists~%")))
-         (with-cached-connection uri port
-           (http-fetch uri #:text? #f
-                       #:port port
-                       #:keep-alive? #t
-                       #:buffered? #f))))
+       (if fetch-timeout
+           ;; Test this with:
+           ;;   sudo tc qdisc add dev eth0 root netem delay 1500ms
+           ;; and then cancel with:
+           ;;   sudo tc qdisc del dev eth0 root
+           (with-timeout %fetch-timeout
+             (begin
+               (warning (G_ "while fetching ~a: server is somewhat slow~%")
+                        (uri->string uri))
+               (warning (G_ "try `--no-substitutes' if the problem persists~%")))
+             (with-cached-connection uri port
+               (http-fetch uri #:text? #f
+                           #:port port
+                           #:keep-alive? #t
+                           #:buffered? #f)))
+           (with-cached-connection uri port
+             (http-fetch uri #:text? #f
+                         #:port port
+                         #:keep-alive? #t
+                         #:buffered? #f))))
       (else
        (leave (G_ "unsupported substitute URI scheme: ~a~%")
               (uri->string uri)))))
-- 
2.41.0

[bug#69291] [PATCH 3/5] scripts: substitute: Replace some leave calls with raise.

[Christopher Baines]

These calls happen inside of with-error-handling, so the effect should be the
same, but this opens up the possibility of using this code in a program that
doesn't want to exit when one of these error conditions is met.

Change-Id: I15d963615d85d419559fa0f4333fa4dc1dfbfd3b

* guix/scripts/substitute.scm (download-nar, process-substitution): Use raise
formatted-message rather than leave.

Change-Id: Idd0880206b69e3903e19e0536b87d65a52c200d5
---
 guix/scripts/substitute.scm | 20 +++++++++++++-------
 1 file changed, 13 insertions(+), 7 deletions(-)

diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm
index 575fa2a0b3..1875a4332d 100755
--- a/guix/scripts/substitute.scm
+++ b/guix/scripts/substitute.scm
@@ -495,8 +495,10 @@ (define* (download-nar narinfo destination
                          #:keep-alive? #t
                          #:buffered? #f))))
       (else
-       (leave (G_ "unsupported substitute URI scheme: ~a~%")
-              (uri->string uri)))))
+       (raise
+        (formatted-message
+         (G_ "unsupported substitute URI scheme: ~a~%")
+         (uri->string uri))))))
 
   (define (try-fetch choices)
     (match choices
@@ -511,9 +513,11 @@ (define* (download-nar narinfo destination
                      (G_ "Downloading ~a...~%") (uri->string uri)))
            (values port uri compression download-size))))
       (()
-       (leave (G_ "no valid nar URLs for ~a at ~a~%")
-              (narinfo-path narinfo)
-              (narinfo-uri-base narinfo)))))
+       (raise
+        (formatted-message
+         (G_ "no valid nar URLs for ~a at ~a~%")
+         (narinfo-path narinfo)
+         (narinfo-uri-base narinfo))))))
 
   ;; Delete DESTINATION first--necessary when starting over after a failed
   ;; download.
@@ -678,8 +682,10 @@ (define* (process-substitution port store-item destination
                         (cut valid-narinfo? <> acl))))
 
   (unless narinfo
-    (leave (G_ "no valid substitute for '~a'~%")
-           store-item))
+    (raise
+     (formatted-message
+      (G_ "no valid substitute for '~a'~%")
+      store-item)))
 
   (guard (c ((network-error? c)
              (when (http-get-error? c)
-- 
2.41.0

[bug#69291] [PATCH 4/5] scripts: substitute: Untangle selecting fast vs small compressions.

[Christopher Baines]

Pulling the logic up to the script makes this code more portable and not
reliant on setting a global variable.

* guix/scripts/substitute.scm (%prefer-fast-decompression?): Rename to…
(%default-prefer-fast-decompression?): this.
(display-narinfo-data): Update accordingly.
(download-nar): Add prefer-fast-decompression? as a keyword argument, remove
code to set! it and return the cpu-usage recorded.
(process-substitution, process-substitution/fallback): Accept and pass through
prefer-fast-decompression? to download-nar.
(guix-substitute): Move the prefer fast decompression switching logic here.

Change-Id: I4e80b457b55bcda8c0ff4ee224dd94a55e1b24fb
---
 guix/scripts/substitute.scm | 90 +++++++++++++++++++++----------------
 1 file changed, 52 insertions(+), 38 deletions(-)

diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm
index 1875a4332d..61e16b22db 100755
--- a/guix/scripts/substitute.scm
+++ b/guix/scripts/substitute.scm
@@ -261,12 +261,7 @@ (define (show-help)
 ;;; Daemon/substituter protocol.
 ;;;
 
-(define %prefer-fast-decompression?
-  ;; 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).
-  #f)
+(define %default-prefer-fast-decompression? #f)
 
 (define (call-with-cpu-usage-monitoring proc)
   (let ((before (times)))
@@ -297,7 +292,7 @@ (define (display-narinfo-data port narinfo)
   (let ((uri compression file-size
              (narinfo-best-uri narinfo
                                #:fast-decompression?
-                               %prefer-fast-decompression?)))
+                               %default-prefer-fast-decompression?)))
     (format port "~a\n~a\n"
             (or file-size 0)
             (or (narinfo-size narinfo) 0))))
@@ -453,7 +448,8 @@ (define-syntax-rule (catch-system-error exp)
 (define* (download-nar narinfo destination
                        #:key status-port
                        deduplicate? print-build-trace?
-                       (fetch-timeout %fetch-timeout))
+                       (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
@@ -525,7 +521,7 @@ (define* (download-nar narinfo destination
 
   (let ((choices (narinfo-preferred-uris narinfo
                                          #:fast-decompression?
-                                         %prefer-fast-decompression?)))
+                                         prefer-fast-decompression?)))
     ;; 'guix publish' without '--cache' doesn't specify a Content-Length, so
     ;; DOWNLOAD-SIZE is #f in this case.
     (let* ((raw uri compression download-size (try-fetch choices))
@@ -566,21 +562,6 @@ (define* (download-nar narinfo destination
                                             deduplicate?)
                                        dump-file/deduplicate*
                                        dump-file))))
-
-      ;; 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
-      (when (> cpu-usage .8)
-        (set! %prefer-fast-decompression? #t))
-      (when (< cpu-usage .2)
-        (set! %prefer-fast-decompression? #f))
-
       (close-port hashed)
       (close-port input)
 
@@ -604,7 +585,9 @@ (define* (download-nar narinfo destination
             (format status-port "hash-mismatch ~a ~a ~a~%"
                     (hash-algorithm-name algorithm)
                     (bytevector->nix-base32-string expected)
-                    (bytevector->nix-base32-string actual)))))))
+                    (bytevector->nix-base32-string actual))))
+
+      cpu-usage)))
 
 (define (system-error? exception)
   "Return true if EXCEPTION is a Guile 'system-error exception."
@@ -628,7 +611,8 @@ (define network-error?
 
 (define* (process-substitution/fallback port narinfo destination
                                         #:key cache-urls acl
-                                        deduplicate? print-build-trace?)
+                                        deduplicate? print-build-trace?
+                                        prefer-fast-decompression?)
   "Attempt to substitute NARINFO, which is assumed to be authorized or
 equivalent, by trying to download its nar from each entry in CACHE-URLS.
 
@@ -662,14 +646,17 @@ (define* (process-substitution/fallback port narinfo destination
                 (download-nar alternate destination
                               #:status-port port
                               #:deduplicate? deduplicate?
-                              #:print-build-trace? print-build-trace?))
+                              #:print-build-trace? print-build-trace?
+                              #:prefer-fast-decompression?
+                              prefer-fast-decompression?))
               (loop rest)))
          (()
           (loop rest)))))))
 
 (define* (process-substitution port store-item destination
                                #:key cache-urls acl
-                               deduplicate? print-build-trace?)
+                               deduplicate? print-build-trace?
+                               prefer-fast-decompression?)
   "Substitute STORE-ITEM (a store file name) from CACHE-URLS, and write it to
 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
@@ -701,11 +688,14 @@ (define* (process-substitution port store-item destination
                                             #:acl acl
                                             #:deduplicate? deduplicate?
                                             #:print-build-trace?
-                                            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?)))
+                  #:print-build-trace? print-build-trace?
+                  #:prefer-fast-decompression? prefer-fast-decompression?)))
 
 \f
 ;;;
@@ -895,18 +885,42 @@ (define-command (guix-substitute . args)
         ;; Specify the number of columns of the terminal so the progress
         ;; report displays nicely.
         (parameterize ((current-terminal-columns (client-terminal-columns)))
-          (let loop ()
+          (let loop ((prefer-fast-decompression?
+                      %default-prefer-fast-decompression?))
             (match (read-line)
               ((? eof-object?)
                #t)
               ((= string-tokenize ("substitute" store-path destination))
-               (process-substitution reply-port store-path destination
-                                     #:cache-urls (substitute-urls)
-                                     #:acl (current-acl)
-                                     #:deduplicate? deduplicate?
-                                     #:print-build-trace?
-                                     print-build-trace?)
-               (loop))))))
+               (let ((cpu-usage
+                      (process-substitution reply-port store-path destination
+                                            #:cache-urls (substitute-urls)
+                                            #:acl (current-acl)
+                                            #:deduplicate? deduplicate?
+                                            #:print-build-trace?
+                                            print-build-trace?
+                                            #: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?)))))))))
        (opts
         (leave (G_ "~a: unrecognized options~%") opts))))))
 
-- 
2.41.0

[bug#69291] [PATCH 5/5] scripts: substitute: Extract script specific output from download-nar.

[Christopher Baines]

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

* guix/scripts/substitute.scm (download-nar): Return more information and move
status-port output to…
(guix-substitute): here.

Change-Id: Icbddb9a47620b3520cdd2e8095f37a99824c1ce0
---
 guix/scripts/substitute.scm | 49 +++++++++++++++++++++----------------
 1 file changed, 28 insertions(+), 21 deletions(-)

diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm
index 61e16b22db..94eb6d2f71 100755
--- a/guix/scripts/substitute.scm
+++ b/guix/scripts/substitute.scm
@@ -568,26 +568,10 @@ (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))))
-
-      cpu-usage)))
+      (values narinfo
+              expected
+              (get-hash)
+              cpu-usage))))
 
 (define (system-error? exception)
   "Return true if EXCEPTION is a Guile 'system-error exception."
@@ -891,7 +875,10 @@ (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
                       (process-substitution reply-port store-path destination
                                             #:cache-urls (substitute-urls)
                                             #:acl (current-acl)
@@ -901,6 +888,26 @@ (define-command (guix-substitute . args)
                                             #:prefer-fast-decompression?
                                             prefer-fast-decompression?)))
 
+                 ;; 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).
-- 
2.41.0

[bug#69291] [PATCH 1/5] scripts: substitute: Remove side effect warning from network-error?.

[Ludovic Courtès]

Christopher Baines <mail@cbaines.net> skribis:

> Instead, display the warning from process-substitution and
> process-substitution/fallback in the relevant places.
>
> I'm looking at this because I want to make the substitute code less tied to
> the script and usable in the Guile guix-daemon.
>
> * guix/scripts/substitute.scm (network-error?): Move warning to…
> (process-substitution/fallback, process-substitution): here.
>
> Change-Id: I082b482c0e6ec7e02a8d437ba22dcefca5c40787

LGTM.

[bug#69291] [PATCH 2/5] scripts: substitute: Allow not using with-timeout in download-nar.

[Ludovic Courtès]

Christopher Baines <mail@cbaines.net> skribis:

> I don't think the approach of using SIGALARM here for the timeout will work
> well in all cases (e.g. when using Guile Fibers), so make it possible to avoid
> this.
>
> * guix/scripts/substitute.scm (download-nar): Pass the fetch timeout in as an
> option.
>
> Change-Id: I8cbe6cdfa10cdaa7d41974cbea56a95f5efecfe6

The patch LGTM.

That said, maybe we should just pass #:timeout to ‘http-fetch’?  It’s
not strictly equivalent because it only controls the timeout on
connection establishment, but in practice it should have the same
effect.

Ludo’.

[bug#69291] [PATCH 3/5] scripts: substitute: Replace some leave calls with raise.

[Ludovic Courtès]

Christopher Baines <mail@cbaines.net> skribis:

> These calls happen inside of with-error-handling, so the effect should be the
> same, but this opens up the possibility of using this code in a program that
> doesn't want to exit when one of these error conditions is met.
>
> Change-Id: I15d963615d85d419559fa0f4333fa4dc1dfbfd3b
>
> * guix/scripts/substitute.scm (download-nar, process-substitution): Use raise
> formatted-message rather than leave.
>
> Change-Id: Idd0880206b69e3903e19e0536b87d65a52c200d5

LGTM.

[bug#69291] [PATCH 4/5] scripts: substitute: Untangle selecting fast vs small compressions.

[Ludovic Courtès]

Christopher Baines <mail@cbaines.net> skribis:

> Pulling the logic up to the script makes this code more portable and not
> reliant on setting a global variable.
>
> * guix/scripts/substitute.scm (%prefer-fast-decompression?): Rename to…
> (%default-prefer-fast-decompression?): this.
> (display-narinfo-data): Update accordingly.
> (download-nar): Add prefer-fast-decompression? as a keyword argument, remove
> code to set! it and return the cpu-usage recorded.
> (process-substitution, process-substitution/fallback): Accept and pass through
> prefer-fast-decompression? to download-nar.
> (guix-substitute): Move the prefer fast decompression switching logic here.
>
> Change-Id: I4e80b457b55bcda8c0ff4ee224dd94a55e1b24fb

[...]

> -(define %prefer-fast-decompression?
> -  ;; 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).
> -  #f)
> +(define %default-prefer-fast-decompression? #f)

I would either remove this variable or add a comment describing it (we
should do that for all top-level variables).

> @@ -604,7 +585,9 @@ (define* (download-nar narinfo destination
>              (format status-port "hash-mismatch ~a ~a ~a~%"
>                      (hash-algorithm-name algorithm)
>                      (bytevector->nix-base32-string expected)
> -                    (bytevector->nix-base32-string actual)))))))
> +                    (bytevector->nix-base32-string actual))))
> +
> +      cpu-usage)))

[...]

> +               (let ((cpu-usage
> +                      (process-substitution reply-port store-path destination
> +                                            #:cache-urls (substitute-urls)
> +                                            #:acl (current-acl)
> +                                            #:deduplicate? deduplicate?
> +                                            #:print-build-trace?
> +                                            print-build-trace?
> +                                            #: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?)))))))))


Instead of having ‘download-nar’ return its CPU usage, which is
surprising, maybe should wrap the ‘process-substitution’ call in
‘guix-substitute’ in ‘with-cpu-usage-monitoring’ and keep all the logic
in ‘guix-substitute’?

Ludo’.

[bug#69291] [PATCH 5/5] scripts: substitute: Extract script specific output from download-nar.

[Ludovic Courtès]

Christopher Baines <mail@cbaines.net> skribis:

> As this moves download-nar in a direction where it could be used outside the
> substitute script.
>
> * guix/scripts/substitute.scm (download-nar): Return more information and move
> status-port output to…
> (guix-substitute): here.
>
> Change-Id: Icbddb9a47620b3520cdd2e8095f37a99824c1ce0

LGTM.

Thanks for this series!

[bug#69291] [PATCH 2/5] scripts: substitute: Allow not using with-timeout in download-nar.

[Christopher Baines]

[-- Attachment #1: Type: text/plain, Size: 1178 bytes --]

Ludovic Courtès <ludo@gnu.org> writes:

> Christopher Baines <mail@cbaines.net> skribis:
>
>> I don't think the approach of using SIGALARM here for the timeout will work
>> well in all cases (e.g. when using Guile Fibers), so make it possible to avoid
>> this.
>>
>> * guix/scripts/substitute.scm (download-nar): Pass the fetch timeout in as an
>> option.
>>
>> Change-Id: I8cbe6cdfa10cdaa7d41974cbea56a95f5efecfe6
>
> The patch LGTM.
>
> That said, maybe we should just pass #:timeout to ‘http-fetch’?  It’s
> not strictly equivalent because it only controls the timeout on
> connection establishment, but in practice it should have the same
> effect.

I haven't done that yet, but longer term I do want to make more changes
here.

In particular, I think the way to go regarding timeouts is to use Guile
suspendable ports and have the read/write waiters handle the
timeout. The build coordinator does this [1], it's quite similar to what
is happening with the http-fetch timeout in connect*, but it's
compatible with fibers.

1: https://git.savannah.gnu.org/cgit/guix/build-coordinator.git/tree/guix-build-coordinator/utils/fibers.scm#n473

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 987 bytes --]

[bug#69291] [PATCH 4/5] scripts: substitute: Untangle selecting fast vs small compressions.

[Christopher Baines]

[-- Attachment #1: Type: text/plain, Size: 4219 bytes --]

Ludovic Courtès <ludo@gnu.org> writes:

> Christopher Baines <mail@cbaines.net> skribis:
>
>> Pulling the logic up to the script makes this code more portable and not
>> reliant on setting a global variable.
>>
>> * guix/scripts/substitute.scm (%prefer-fast-decompression?): Rename to…
>> (%default-prefer-fast-decompression?): this.
>> (display-narinfo-data): Update accordingly.
>> (download-nar): Add prefer-fast-decompression? as a keyword argument, remove
>> code to set! it and return the cpu-usage recorded.
>> (process-substitution, process-substitution/fallback): Accept and pass through
>> prefer-fast-decompression? to download-nar.
>> (guix-substitute): Move the prefer fast decompression switching logic here.
>>
>> Change-Id: I4e80b457b55bcda8c0ff4ee224dd94a55e1b24fb
>
> [...]
>
>> -(define %prefer-fast-decompression?
>> -  ;; 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).
>> -  #f)
>> +(define %default-prefer-fast-decompression? #f)
>
> I would either remove this variable or add a comment describing it (we
> should do that for all top-level variables).

I've added a comment now, and I'll sent an updated patch.

>> @@ -604,7 +585,9 @@ (define* (download-nar narinfo destination
>>              (format status-port "hash-mismatch ~a ~a ~a~%"
>>                      (hash-algorithm-name algorithm)
>>                      (bytevector->nix-base32-string expected)
>> -                    (bytevector->nix-base32-string actual)))))))
>> +                    (bytevector->nix-base32-string actual))))
>> +
>> +      cpu-usage)))
>
> [...]
>
>> +               (let ((cpu-usage
>> +                      (process-substitution reply-port store-path destination
>> +                                            #:cache-urls (substitute-urls)
>> +                                            #:acl (current-acl)
>> +                                            #:deduplicate? deduplicate?
>> +                                            #:print-build-trace?
>> +                                            print-build-trace?
>> +                                            #: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?)))))))))
>
>
> Instead of having ‘download-nar’ return its CPU usage, which is
> surprising, maybe should wrap the ‘process-substitution’ call in
> ‘guix-substitute’ in ‘with-cpu-usage-monitoring’ and keep all the logic
> in ‘guix-substitute’?

Yeah, that makes sense. I'll send an updated patch shortly.

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 987 bytes --]

[bug#69291] [PATCH 5/5] scripts: substitute: Extract script specific output from download-nar.

[Christopher Baines]

[-- Attachment #1: Type: text/plain, Size: 693 bytes --]

Ludovic Courtès <ludo@gnu.org> writes:

> Christopher Baines <mail@cbaines.net> skribis:
>
>> As this moves download-nar in a direction where it could be used outside the
>> substitute script.
>>
>> * guix/scripts/substitute.scm (download-nar): Return more information and move
>> status-port output to…
>> (guix-substitute): here.
>>
>> Change-Id: Icbddb9a47620b3520cdd2e8095f37a99824c1ce0
>
> LGTM.

Looking at this patch some more, I missed the failure case in
process-substitution/fallback, so I'll send an updated patch (for this
and the previous patch).

The other patches (1 to 3) have been pushed to master as
ecbab97f0732d6979642078a7164d4032b2102b8.

Chris

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 987 bytes --]

[bug#69291] [PATCH v2 1/2] scripts: substitute: Untangle selecting fast vs small compressions.

[Christopher Baines]

Pulling the logic up to the script makes this code more portable and not
reliant on setting a global variable.

* guix/scripts/substitute.scm (%prefer-fast-decompression?): Rename to…
(%default-prefer-fast-decompression?): this.
(call-with-cpu-usage-monitoring): Use multiple values to return the results
from the thunk as well as the cpu usage.
(display-narinfo-data): Update accordingly.
(download-nar): Add prefer-fast-decompression? as a keyword argument, remove
code to set! it and monitor the cpu-usage.
(process-substitution, process-substitution/fallback): Accept and pass through
prefer-fast-decompression? to download-nar.
(guix-substitute): Move the cpu usage monitoring and prefer fast decompression
switching logic here.

Change-Id: I4e80b457b55bcda8c0ff4ee224dd94a55e1b24fb
---
 guix/scripts/substitute.scm | 126 +++++++++++++++++++++---------------
 1 file changed, 73 insertions(+), 53 deletions(-)

diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm
index a7ad56dbcd..0d0fd0e73b 100755
--- a/guix/scripts/substitute.scm
+++ b/guix/scripts/substitute.scm
@@ -261,22 +261,24 @@ (define (show-help)
 ;;; Daemon/substituter protocol.
 ;;;
 
-(define %prefer-fast-decompression?
-  ;; 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).
-  #f)
-
-(define (call-with-cpu-usage-monitoring proc)
+;; Whether to initially prefer fast decompression or not
+(define %default-prefer-fast-decompression? #f)
+
+(define (call-with-cpu-usage-monitoring thunk)
   (let ((before (times)))
-    (proc)
-    (let ((after (times)))
-      (if (= (tms:clock after) (tms:clock before))
-          0
-          (/ (- (tms:utime after) (tms:utime before))
-             (- (tms:clock after) (tms:clock before))
-             1.)))))
+    (call-with-values thunk
+      (lambda vals
+        (let ((after (times)))
+          (apply
+           values
+           (append
+            (or vals '())
+            (list
+             (if (= (tms:clock after) (tms:clock before))
+                 0
+                 (/ (- (tms:utime after) (tms:utime before))
+                    (- (tms:clock after) (tms:clock before))
+                    1.))))))))))
 
 (define-syntax-rule (with-cpu-usage-monitoring exp ...)
   "Evaluate EXP...  Return its CPU usage as a fraction between 0 and 1."
@@ -297,7 +299,7 @@ (define (display-narinfo-data port narinfo)
   (let ((uri compression file-size
              (narinfo-best-uri narinfo
                                #:fast-decompression?
-                               %prefer-fast-decompression?)))
+                               %default-prefer-fast-decompression?)))
     (format port "~a\n~a\n"
             (or file-size 0)
             (or (narinfo-size narinfo) 0))))
@@ -453,7 +455,8 @@ (define-syntax-rule (catch-system-error exp)
 (define* (download-nar narinfo destination
                        #:key status-port
                        deduplicate? print-build-trace?
-                       (fetch-timeout %fetch-timeout))
+                       (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
@@ -527,7 +530,7 @@ (define* (download-nar narinfo destination
 
   (let ((choices (narinfo-preferred-uris narinfo
                                          #:fast-decompression?
-                                         %prefer-fast-decompression?)))
+                                         prefer-fast-decompression?)))
     ;; 'guix publish' without '--cache' doesn't specify a Content-Length, so
     ;; DOWNLOAD-SIZE is #f in this case.
     (let* ((raw uri compression download-size (try-fetch choices))
@@ -560,29 +563,13 @@ (define* (download-nar narinfo destination
            ;; 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.
-      (define cpu-usage
-        (with-cpu-usage-monitoring
-         (restore-file hashed destination
-                       #:dump-file (if (and destination-in-store?
-                                            deduplicate?)
-                                       dump-file/deduplicate*
-                                       dump-file))))
-
-      ;; 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
-      (when (> cpu-usage .8)
-        (set! %prefer-fast-decompression? #t))
-      (when (< cpu-usage .2)
-        (set! %prefer-fast-decompression? #f))
 
+      ;; Unpack the Nar at INPUT into DESTINATION.
+      (restore-file hashed destination
+                    #:dump-file (if (and destination-in-store?
+                                         deduplicate?)
+                                    dump-file/deduplicate*
+                                    dump-file))
       (close-port hashed)
       (close-port input)
 
@@ -630,7 +617,8 @@ (define network-error?
 
 (define* (process-substitution/fallback port narinfo destination
                                         #:key cache-urls acl
-                                        deduplicate? print-build-trace?)
+                                        deduplicate? print-build-trace?
+                                        prefer-fast-decompression?)
   "Attempt to substitute NARINFO, which is assumed to be authorized or
 equivalent, by trying to download its nar from each entry in CACHE-URLS.
 
@@ -664,14 +652,17 @@ (define* (process-substitution/fallback port narinfo destination
                 (download-nar alternate destination
                               #:status-port port
                               #:deduplicate? deduplicate?
-                              #:print-build-trace? print-build-trace?))
+                              #:print-build-trace? print-build-trace?
+                              #:prefer-fast-decompression?
+                              prefer-fast-decompression?))
               (loop rest)))
          (()
           (loop rest)))))))
 
 (define* (process-substitution port store-item destination
                                #:key cache-urls acl
-                               deduplicate? print-build-trace?)
+                               deduplicate? print-build-trace?
+                               prefer-fast-decompression?)
   "Substitute STORE-ITEM (a store file name) from CACHE-URLS, and write it to
 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
@@ -703,11 +694,14 @@ (define* (process-substitution port store-item destination
                                             #:acl acl
                                             #:deduplicate? deduplicate?
                                             #:print-build-trace?
-                                            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?)))
+                  #:print-build-trace? print-build-trace?
+                  #:prefer-fast-decompression? prefer-fast-decompression?)))
 
 \f
 ;;;
@@ -897,18 +891,44 @@ (define-command (guix-substitute . args)
         ;; Specify the number of columns of the terminal so the progress
         ;; report displays nicely.
         (parameterize ((current-terminal-columns (client-terminal-columns)))
-          (let loop ()
+          (let loop ((prefer-fast-decompression?
+                      %default-prefer-fast-decompression?))
             (match (read-line)
               ((? eof-object?)
                #t)
               ((= string-tokenize ("substitute" store-path destination))
-               (process-substitution reply-port store-path destination
-                                     #:cache-urls (substitute-urls)
-                                     #:acl (current-acl)
-                                     #:deduplicate? deduplicate?
-                                     #:print-build-trace?
-                                     print-build-trace?)
-               (loop))))))
+               (let ((cpu-usage
+                      (with-cpu-usage-monitoring
+                       (process-substitution
+                        reply-port store-path destination
+                        #:cache-urls (substitute-urls)
+                        #:acl (current-acl)
+                        #:deduplicate? deduplicate?
+                        #:print-build-trace?
+                        print-build-trace?
+                        #: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?)))))))))
        (opts
         (leave (G_ "~a: unrecognized options~%") opts))))))
 

base-commit: c9cd16c630ccba655b93ff32fd9a99570b4f5373
-- 
2.41.0

[bug#69291] [PATCH v2 2/2] scripts: substitute: Extract script specific output from download-nar.

[Christopher Baines]

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
---
 guix/scripts/substitute.scm | 162 ++++++++++++++++++++----------------
 1 file 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 @@ (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)))
 
 \f
 ;;;
@@ -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))))))
 
-- 
2.41.0

bug#69291: [PATCH 5/5] scripts: substitute: Extract script specific output from download-nar.

[Christopher Baines]

[-- Attachment #1: Type: text/plain, Size: 753 bytes --]

Christopher Baines <mail@cbaines.net> writes:

> Ludovic Courtès <ludo@gnu.org> writes:
>
>> Christopher Baines <mail@cbaines.net> skribis:
>>
>>> As this moves download-nar in a direction where it could be used outside the
>>> substitute script.
>>>
>>> * guix/scripts/substitute.scm (download-nar): Return more information and move
>>> status-port output to…
>>> (guix-substitute): here.
>>>
>>> Change-Id: Icbddb9a47620b3520cdd2e8095f37a99824c1ce0
>>
>> LGTM.
>
> Looking at this patch some more, I missed the failure case in
> process-substitution/fallback, so I'll send an updated patch (for this
> and the previous patch).

I've sent a couple of updated patches as part of the series to
https://issues.guix.gnu.org/70494

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 987 bytes --]