diff mbox series

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

Message ID c689a478b1b123eb607a89b2ec295b491d79f39f.1708458147.git.mail@cbaines.net
State New
Headers show
Series Start making substitute code less coupled | expand

Commit Message

Christopher Baines Feb. 20, 2024, 7:42 p.m. UTC 
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(-)


base-commit: 3d061d9677027be7651f8e5a3a02e19daacd9a85

Comments

Ludovic Courtès Feb. 23, 2024, 4:16 p.m. UTC | #1 
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.
diff mbox series

Patch

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)