GNU bug report logs - #69291
[PATCH 0/5] Start making substitute code less coupled

Previous Next

To add a comment to this bug, you must first unarchive it, by sending
a message to control AT debbugs.gnu.org, with unarchive 69291 in the body.
You can then email your comments to 69291 AT debbugs.gnu.org in the normal way.

Toggle the display of automated, internal messages from the tracker.

Message #5 received at submit <at> debbugs.gnu.org (full text, mbox):

From: Christopher Baines <mail <at> cbaines.net>
To: guix-patches <at> gnu.org
Subject: [PATCH 0/5] Start making substitute code less coupled
Date: Tue, 20 Feb 2024 19:05:07 +0000

[Message part 1 (text/plain, inline)]

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

[signature.asc (application/pgp-signature, inline)]

Message #8 received at 69291 <at> debbugs.gnu.org (full text, mbox):

From: Christopher Baines <mail <at> cbaines.net>
To: 69291 <at> debbugs.gnu.org
Subject: [PATCH 2/5] scripts: substitute: Allow not using with-timeout in
 download-nar.
Date: Tue, 20 Feb 2024 19:42:24 +0000

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

Message #11 received at 69291 <at> debbugs.gnu.org (full text, mbox):

From: Christopher Baines <mail <at> cbaines.net>
To: 69291 <at> debbugs.gnu.org
Subject: [PATCH 1/5] scripts: substitute: Remove side effect warning from
 network-error?.
Date: Tue, 20 Feb 2024 19:42:23 +0000

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

Message #14 received at 69291 <at> debbugs.gnu.org (full text, mbox):

From: Christopher Baines <mail <at> cbaines.net>
To: 69291 <at> debbugs.gnu.org
Subject: [PATCH 3/5] scripts: substitute: Replace some leave calls with raise.
Date: Tue, 20 Feb 2024 19:42:25 +0000

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

Message #17 received at 69291 <at> debbugs.gnu.org (full text, mbox):

From: Christopher Baines <mail <at> cbaines.net>
To: 69291 <at> debbugs.gnu.org
Subject: [PATCH 4/5] scripts: substitute: Untangle selecting fast vs small
 compressions.
Date: Tue, 20 Feb 2024 19:42:26 +0000

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?)))
 
 
 ;;;
@@ -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

Message #20 received at 69291 <at> debbugs.gnu.org (full text, mbox):

From: Christopher Baines <mail <at> cbaines.net>
To: 69291 <at> debbugs.gnu.org
Subject: [PATCH 5/5] scripts: substitute: Extract script specific output from
 download-nar.
Date: Tue, 20 Feb 2024 19:42:27 +0000

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

Message #23 received at 69291 <at> debbugs.gnu.org (full text, mbox):

From: Ludovic Courtès <ludo <at> gnu.org>
To: Christopher Baines <mail <at> cbaines.net>
Cc: Josselin Poiret <dev <at> jpoiret.xyz>,
 Simon Tournier <zimon.toutoune <at> gmail.com>, Mathieu Othacehe <othacehe <at> gnu.org>,
 Tobias Geerinckx-Rice <me <at> tobias.gr>, 69291 <at> debbugs.gnu.org,
 Ricardo Wurmus <rekado <at> elephly.net>, Christopher Baines <guix <at> cbaines.net>
Subject: Re: [bug#69291] [PATCH 1/5] scripts: substitute: Remove side effect
 warning from network-error?.
Date: Fri, 23 Feb 2024 17:16:00 +0100

Christopher Baines <mail <at> 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.

Message #26 received at 69291 <at> debbugs.gnu.org (full text, mbox):

From: Ludovic Courtès <ludo <at> gnu.org>
To: Christopher Baines <mail <at> cbaines.net>
Cc: Josselin Poiret <dev <at> jpoiret.xyz>,
 Simon Tournier <zimon.toutoune <at> gmail.com>, Mathieu Othacehe <othacehe <at> gnu.org>,
 Tobias Geerinckx-Rice <me <at> tobias.gr>, 69291 <at> debbugs.gnu.org,
 Ricardo Wurmus <rekado <at> elephly.net>, Christopher Baines <guix <at> cbaines.net>
Subject: Re: [bug#69291] [PATCH 2/5] scripts: substitute: Allow not using
 with-timeout in download-nar.
Date: Fri, 23 Feb 2024 17:19:46 +0100

Christopher Baines <mail <at> 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’.

Message #29 received at 69291 <at> debbugs.gnu.org (full text, mbox):

From: Ludovic Courtès <ludo <at> gnu.org>
To: Christopher Baines <mail <at> cbaines.net>
Cc: Josselin Poiret <dev <at> jpoiret.xyz>,
 Simon Tournier <zimon.toutoune <at> gmail.com>, Mathieu Othacehe <othacehe <at> gnu.org>,
 Tobias Geerinckx-Rice <me <at> tobias.gr>, 69291 <at> debbugs.gnu.org,
 Ricardo Wurmus <rekado <at> elephly.net>, Christopher Baines <guix <at> cbaines.net>
Subject: Re: [bug#69291] [PATCH 5/5] scripts: substitute: Extract script
 specific output from download-nar.
Date: Fri, 23 Feb 2024 17:27:36 +0100

Christopher Baines <mail <at> 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!

Message #32 received at 69291 <at> debbugs.gnu.org (full text, mbox):

From: Ludovic Courtès <ludo <at> gnu.org>
To: Christopher Baines <mail <at> cbaines.net>
Cc: Josselin Poiret <dev <at> jpoiret.xyz>,
 Simon Tournier <zimon.toutoune <at> gmail.com>, Mathieu Othacehe <othacehe <at> gnu.org>,
 Tobias Geerinckx-Rice <me <at> tobias.gr>, 69291 <at> debbugs.gnu.org,
 Ricardo Wurmus <rekado <at> elephly.net>, Christopher Baines <guix <at> cbaines.net>
Subject: Re: [bug#69291] [PATCH 4/5] scripts: substitute: Untangle selecting
 fast vs small compressions.
Date: Fri, 23 Feb 2024 17:26:43 +0100

Christopher Baines <mail <at> 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’.

Message #35 received at 69291 <at> debbugs.gnu.org (full text, mbox):

From: Ludovic Courtès <ludo <at> gnu.org>
To: Christopher Baines <mail <at> cbaines.net>
Cc: Josselin Poiret <dev <at> jpoiret.xyz>,
 Simon Tournier <zimon.toutoune <at> gmail.com>, Mathieu Othacehe <othacehe <at> gnu.org>,
 Tobias Geerinckx-Rice <me <at> tobias.gr>, 69291 <at> debbugs.gnu.org,
 Ricardo Wurmus <rekado <at> elephly.net>, Christopher Baines <guix <at> cbaines.net>
Subject: Re: [bug#69291] [PATCH 3/5] scripts: substitute: Replace some leave
 calls with raise.
Date: Fri, 23 Feb 2024 17:20:07 +0100

Christopher Baines <mail <at> 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.

Message #38 received at 69291 <at> debbugs.gnu.org (full text, mbox):

From: Christopher Baines <mail <at> cbaines.net>
To: Ludovic Courtès <ludo <at> gnu.org>
Cc: 69291 <at> debbugs.gnu.org
Subject: Re: [bug#69291] [PATCH 2/5] scripts: substitute: Allow not using
 with-timeout in download-nar.
Date: Wed, 03 Apr 2024 18:26:08 +0100

[Message part 1 (text/plain, inline)]

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

> Christopher Baines <mail <at> 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

[signature.asc (application/pgp-signature, inline)]

Message #41 received at 69291 <at> debbugs.gnu.org (full text, mbox):

From: Christopher Baines <mail <at> cbaines.net>
To: Ludovic Courtès <ludo <at> gnu.org>
Cc: 69291 <at> debbugs.gnu.org
Subject: Re: [bug#69291] [PATCH 4/5] scripts: substitute: Untangle selecting
 fast vs small compressions.
Date: Wed, 03 Apr 2024 18:28:15 +0100

[Message part 1 (text/plain, inline)]

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

> Christopher Baines <mail <at> 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.

[signature.asc (application/pgp-signature, inline)]

Message #44 received at 69291 <at> debbugs.gnu.org (full text, mbox):

From: Christopher Baines <mail <at> cbaines.net>
To: Ludovic Courtès <ludo <at> gnu.org>
Cc: 69291 <at> debbugs.gnu.org
Subject: Re: [bug#69291] [PATCH 5/5] scripts: substitute: Extract script
 specific output from download-nar.
Date: Wed, 03 Apr 2024 18:30:37 +0100

[Message part 1 (text/plain, inline)]

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

> Christopher Baines <mail <at> 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

[signature.asc (application/pgp-signature, inline)]

Message #47 received at 69291 <at> debbugs.gnu.org (full text, mbox):

From: Christopher Baines <mail <at> cbaines.net>
To: 69291 <at> debbugs.gnu.org
Subject: [PATCH v2 1/2] scripts: substitute: Untangle selecting fast vs small
 compressions.
Date: Thu,  4 Apr 2024 15:06:28 +0100

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?)))
 
 
 ;;;
@@ -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

Message #50 received at 69291 <at> debbugs.gnu.org (full text, mbox):

From: Christopher Baines <mail <at> cbaines.net>
To: 69291 <at> debbugs.gnu.org
Subject: [PATCH v2 2/2] scripts: substitute: Extract script specific output
 from download-nar.
Date: Thu,  4 Apr 2024 15:06:29 +0100

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)))
 
 
 ;;;
@@ -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

Message #55 received at 69291-done <at> debbugs.gnu.org (full text, mbox):

From: Christopher Baines <mail <at> cbaines.net>
To: 69291-done <at> debbugs.gnu.org
Subject: Re: [bug#69291] [PATCH 5/5] scripts: substitute: Extract script
 specific output from download-nar.
Date: Sun, 21 Apr 2024 12:24:56 +0100

[Message part 1 (text/plain, inline)]

Christopher Baines <mail <at> cbaines.net> writes:

> Ludovic Courtès <ludo <at> gnu.org> writes:
>
>> Christopher Baines <mail <at> 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

[signature.asc (application/pgp-signature, inline)]

Previous Next

GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.