diff mbox series

[bug#70494,18/23] guix: http-client: Add network-error?.

Message ID c90b93b5526b390d97e0e28c3c348711dbc7474f.1713692561.git.mail@cbaines.net
State New
Headers show
Series Groundwork for the Guile guix-daemon | expand

Commit Message

Christopher Baines April 21, 2024, 9:42 a.m. UTC 
Plus remove http-get-error? from network-error? as a http-get-error? doesn't
indicate a network error.

* guix/scripts/substitute.scm (system-error?, network-error?): Move from here.
(process-substitution/fallback, process-substitution): Use http-get-error?
with network-error?.
* guix/http-client.scm: To here, and also don't use http-get-error?.

Change-Id: I61ee9e5fbf90ebb76a34aa8b9ec8f5d74f8a3c54
---
 guix/http-client.scm        | 23 +++++++++++++++++++++++
 guix/scripts/substitute.scm | 26 ++++----------------------
 2 files changed, 27 insertions(+), 22 deletions(-)
diff mbox series

Patch

diff --git a/guix/http-client.scm b/guix/http-client.scm
index 9138a627ac..024705e9ec 100644
--- a/guix/http-client.scm
+++ b/guix/http-client.scm
@@ -54,6 +54,8 @@  (define-module (guix http-client)
             http-get-error-reason
             http-get-error-headers
 
+            network-error?
+
             http-fetch
             http-multiple-get
 
@@ -75,6 +77,27 @@  (define-condition-type &http-get-error &error
   (reason   http-get-error-reason)                ;string
   (headers  http-get-error-headers))              ;alist
 
+(define kind-and-args-exception?
+  (exception-predicate &exception-with-kind-and-args))
+
+(define (system-error? exception)
+  "Return true if EXCEPTION is a Guile 'system-error exception."
+  (and (kind-and-args-exception? exception)
+       (eq? 'system-error (exception-kind exception))))
+
+(define network-error?
+  (let ((kind-and-args? (exception-predicate &exception-with-kind-and-args)))
+    (lambda (exception)
+      "Return true if EXCEPTION denotes a networking error."
+      (or (and (system-error? exception)
+               (let ((errno (system-error-errno
+                             (cons 'system-error (exception-args exception)))))
+                 (memv errno (list ECONNRESET ECONNABORTED ETIMEDOUT
+                                   ECONNREFUSED EHOSTUNREACH
+                                   ENOENT))))     ;for "file://"
+          (and (kind-and-args? exception)
+               (memq (exception-kind exception)
+                     '(gnutls-error getaddrinfo-error)))))))
 
 (define* (http-fetch uri #:key port (text? #f) (buffered? #t)
                      (open-connection guix:open-connection-for-uri)
diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm
index c2bc16085d..362d9fbe7a 100755
--- a/guix/scripts/substitute.scm
+++ b/guix/scripts/substitute.scm
@@ -577,26 +577,6 @@  (define* (download-nar narinfo destination
       (values expected
               (get-hash)))))
 
-(define (system-error? exception)
-  "Return true if EXCEPTION is a Guile 'system-error exception."
-  (and (kind-and-args-exception? exception)
-       (eq? 'system-error (exception-kind exception))))
-
-(define network-error?
-  (let ((kind-and-args? (exception-predicate &exception-with-kind-and-args)))
-    (lambda (exception)
-      "Return true if EXCEPTION denotes a networking error."
-      (or (and (system-error? exception)
-               (let ((errno (system-error-errno
-                             (cons 'system-error (exception-args exception)))))
-                 (memv errno (list ECONNRESET ECONNABORTED ETIMEDOUT
-                                   ECONNREFUSED EHOSTUNREACH
-                                   ENOENT))))     ;for "file://"
-          (and (kind-and-args? exception)
-               (memq (exception-kind exception)
-                     '(gnutls-error getaddrinfo-error)))
-          (http-get-error? exception)))))
-
 (define* (process-substitution/fallback narinfo destination
                                         #:key cache-urls acl
                                         deduplicate? print-build-trace?
@@ -623,7 +603,8 @@  (define* (process-substitution/fallback narinfo destination
           (if (or (equivalent-narinfo? narinfo alternate)
                   (valid-narinfo? alternate acl)
                   (%allow-unauthenticated-substitutes?))
-              (guard (c ((network-error? c)
+              (guard (c ((or (http-get-error? c)
+                             (network-error? c))
                          (when (http-get-error? c)
                            (warning (G_ "download from '~a' failed: ~a, ~s~%")
                                     (uri->string (http-get-error-uri c))
@@ -663,7 +644,8 @@  (define* (process-substitution store-item destination
   (let ((expected-hash
          actual-hash
          (guard
-             (c ((network-error? c)
+             (c ((or (http-get-error? c)
+                     (network-error? c))
                  (when (http-get-error? c)
                    (warning (G_ "download from '~a' failed: ~a, ~s~%")
                             (uri->string (http-get-error-uri c))