diff options
Diffstat (limited to 'guix/http-client.scm')
| -rw-r--r-- | guix/http-client.scm | 74 |
1 files changed, 56 insertions, 18 deletions
diff --git a/guix/http-client.scm b/guix/http-client.scm index 7ead493633..3aba3b28c1 100644 --- a/guix/http-client.scm +++ b/guix/http-client.scm @@ -38,6 +38,7 @@ #:use-module (guix utils) #:use-module (guix base64) #:autoload (gcrypt hash) (sha256) + #:autoload (gnutls) (error/invalid-session) #:use-module ((guix build utils) #:select (mkdir-p dump-port)) #:use-module ((guix build download) @@ -180,10 +181,25 @@ returning." ;; Inherit the HTTP proxying property from P. (set-http-proxy-port?! buffer (http-proxy-port? p)) - (for-each (cut write-request <> buffer) - batch) - (put-bytevector p (get)) - (force-output p)) + (catch #t + (lambda () + (for-each (cut write-request <> buffer) + batch) + (put-bytevector p (get)) + (force-output p)) + (lambda (key . args) + ;; If PORT becomes unusable, open a fresh connection and + ;; retry. + (if (or (and (eq? key 'system-error) + (= EPIPE (system-error-errno `(,key ,@args)))) + (and (eq? key 'gnutls-error) + (eq? (first args) error/invalid-session))) + (begin + (close-port p) ; close the broken port + (connect #f + requests + result)) + (apply throw key args))))) ;; Now start processing responses. (let loop ((sent batch) @@ -199,20 +215,42 @@ returning." (remainder (connect p remainder result)))) ((head tail ...) - (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 + (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 + (drop requests (+ 1 processed)) + result)) + (apply throw key args)))))))))) ;;; |