aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--guix/http-client.scm77
1 files changed, 43 insertions, 34 deletions
diff --git a/guix/http-client.scm b/guix/http-client.scm
index 4b4c14ed0b..adbfbc0d6e 100644
--- a/guix/http-client.scm
+++ b/guix/http-client.scm
@@ -219,42 +219,51 @@ returning."
(remainder
(connect p remainder result))))
((head tail ...)
- (catch #t
- (lambda ()
- (let* ((resp (read-response p))
- (body (response-body-port resp))
- (result (proc head resp body result)))
- ;; The server can choose to stop responding at any time,
- ;; in which case we have to try again. Check whether
- ;; that is the case. Note that even upon "Connection:
- ;; close", we can read from BODY.
- (match (assq 'connection (response-headers resp))
- (('connection 'close)
- (close-port p)
- (connect #f ;try again
- (drop requests (+ 1 processed))
- result))
- (_
- (loop tail (+ 1 processed) result))))) ;keep going
- (lambda (key . args)
- ;; If PORT was cached and the server closed the connection
- ;; in the meantime, we get EPIPE. In that case, open a
- ;; fresh connection and retry. We might also get
- ;; 'bad-response or a similar exception from (web response)
- ;; later on, once we've sent the request, or a
- ;; ERROR/INVALID-SESSION from GnuTLS.
- (if (or (and (eq? key 'system-error)
- (= EPIPE (system-error-errno `(,key ,@args))))
- (and (eq? key 'gnutls-error)
- (eq? (first args) error/invalid-session))
- (memq key
- '(bad-response bad-header bad-header-component)))
- (begin
- (close-port p)
- (connect #f ; try again
+ (match
+ (catch #t
+ (lambda ()
+ (let* ((resp (read-response p))
+ (body (response-body-port resp))
+ (result (proc head resp body result)))
+ ;; The server can choose to stop responding at any time,
+ ;; in which case we have to try again. Check whether
+ ;; that is the case. Note that even upon "Connection:
+ ;; close", we can read from BODY.
+ (match (assq 'connection (response-headers resp))
+ (('connection 'close)
+ (close-port p)
+ (list 'connect
+ #f
(drop requests (+ 1 processed))
result))
- (apply throw key args))))))))))
+ (_
+ (list 'loop tail (+ 1 processed) result)))))
+ (lambda (key . args)
+ ;; If PORT was cached and the server closed the connection
+ ;; in the meantime, we get EPIPE. In that case, open a
+ ;; fresh connection and retry. We might also get
+ ;; 'bad-response or a similar exception from (web response)
+ ;; later on, once we've sent the request, or a
+ ;; ERROR/INVALID-SESSION from GnuTLS.
+ (if (or (and (eq? key 'system-error)
+ (= EPIPE (system-error-errno `(,key ,@args))))
+ (and (eq? key 'gnutls-error)
+ (eq? (first args) error/invalid-session))
+ (memq key
+ '(bad-response
+ bad-header
+ bad-header-component)))
+ (begin
+ (close-port p)
+ (list 'connect
+ #f
+ (drop requests processed)
+ result))
+ (apply throw key args))))
+ (('connect . args)
+ (apply connect args))
+ (('loop . args)
+ (apply loop args)))))))))
;;;