guix/guix
3
4
Fork 0
mirror of git://git.savannah.gnu.org/guix.git synced 2023-12-14 03:33:07 +01:00
Code Issues Releases Wiki Activity

http-client: Add error handling to http-multiple-get.

Browse source 
Making sure to close the port if it looks to be unusable. This closing of the
port will allow for caching connections, without caching broken connections,
as the cache can avoid handing out closed ports.

* guix/http-client.scm (http-multiple-get): Try to catch exceptions that
happen if the port is unusable, this is a adaptation of code within the (guix
scripts substitute) module.
This commit is contained in:
Christopher Baines 2021-01-07 19:40:43 +00:00
parent e2e853ddb0
commit 205833b72c
No known key found for this signature in database
GPG key ID: 5E28A33B0B84F577
1 changed files with 56 additions and 18 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

74
guix/http-client.scm
View file

@ -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))))))))))
;;;