summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorChristopher Baines <mail@cbaines.net>2024-04-21 10:42:36 +0100
committerGuix Patches Tester <>2024-04-21 11:53:22 +0200
commita0960a3403e3db5e593b357d610ae474b931b144 (patch)
tree75cfdd99b2de5219e7c42ac03c3d1a1283e907c8
parentb8b6e29cbe31a1330d39779c2f13ce2d63f123d1 (diff)
downloadguix-patches-a0960a3403e3db5e593b357d610ae474b931b144.tar
guix-patches-a0960a3403e3db5e593b357d610ae474b931b144.tar.gz
guix: http-client: Add network-error?.
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
-rw-r--r--guix/http-client.scm23
-rwxr-xr-xguix/scripts/substitute.scm26
2 files changed, 27 insertions, 22 deletions
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 @@
http-get-error-reason
http-get-error-headers
+ network-error?
+
http-fetch
http-multiple-get
@@ -75,6 +77,27 @@
(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 @@ if DESTINATION is in the store, deduplicate its files."
(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 @@ way to download the nar."
(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 @@ PORT."
(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))