guix_mirror_bot pushed a commit to branch master
in repository guix.
commit b354ef2df377143eeb8b323f50b6720055d4d0b4
Author: Christopher Baines <[email protected]>
AuthorDate: Tue Apr 9 12:41:12 2024 +0100
http-client: Add network-error? from the substitute script.
Plus remove http-get-error? from network-error? as http-get-error? doesn't
indicate a network error.
* guix/scripts/substitute.scm (process-substitution/fallback)
(process-substitution): Use http-get-error? with network-error?.
(system-error?, network-error?): Move from here…
* 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 --git a/guix/http-client.scm b/guix/http-client.scm
index 4622dbdcb6..28ace406b5 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 1fc66000c1..89038103bb 100755
--- a/guix/scripts/substitute.scm
+++ b/guix/scripts/substitute.scm
@@ -584,26 +584,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?
@@ -630,7 +610,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))
@@ -670,7 +651,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))
