diff options
| -rw-r--r-- | guix/http-client.scm | 77 |
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))))))))) ;;; |