[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
02/02: substitute-binary: Adjust to better deal with Nginx's behavior.
From: |
Ludovic Courtès |
Subject: |
02/02: substitute-binary: Adjust to better deal with Nginx's behavior. |
Date: |
Wed, 10 Dec 2014 12:45:21 +0000 |
civodul pushed a commit to branch wip-http-pipelining
in repository guix.
commit a851c620128a8c076bd258ed73838add82058c40
Author: Ludovic Courtès <address@hidden>
Date: Wed Dec 10 13:43:51 2014 +0100
substitute-binary: Adjust to better deal with Nginx's behavior.
* guix/scripts/substitute-binary.scm (eof-if-connection-reset): New
macro.
(read-response-and-body): New procedure.
(http-multiple-get): Use it. Handle RESP or BODY being EOF. Wrap
PROC call in 'eof-if-connection-reset'.
(fetch-narinfos)[handle-narinfo-response]: Call 'update-progress!'
after 'cache-narinfo!'.
---
guix/scripts/substitute-binary.scm | 62 +++++++++++++++++++++++++++++------
1 files changed, 51 insertions(+), 11 deletions(-)
diff --git a/guix/scripts/substitute-binary.scm
b/guix/scripts/substitute-binary.scm
index f470c5f..c24484d 100755
--- a/guix/scripts/substitute-binary.scm
+++ b/guix/scripts/substitute-binary.scm
@@ -440,6 +440,38 @@ be #f, in which case it indicates that PATH is unavailable
at CACHE."
".narinfo")))
(build-request (string->uri url) #:method 'GET)))
+
+(define-syntax eof-if-connection-reset
+ (syntax-rules ()
+ "Return the end-of-file object if the connection is reset while evaluating
+EXP."
+ ((_ (results ...) exp)
+ (catch 'bad-response
+ (lambda ()
+ (catch 'system-error
+ (lambda ()
+ exp)
+ (lambda args
+ (if (= ECONNRESET (system-error-errno args))
+ (let ((results (eof-object)) ...)
+ (values results ...))
+ (apply throw args)))))
+ (lambda args
+ ;; Sometimes Nginx hangs up in the middle of a response, which leads
+ ;; (web client) to throw 'bad-response, hence this handler.
+ (let ((results (eof-object)) ...)
+ (values results ...)))))
+ ((_ exp)
+ (eof-if-connection-reset (one-value) exp))))
+
+(define (read-response-and-body port)
+ "Read an HTTP response and its body from PORT, and return these two values.
+Return the end-of-file object if the connection is lost while reading."
+ (eof-if-connection-reset (resp body)
+ (let* ((resp (read-response port))
+ (body (response-body-port resp)))
+ (values resp body))))
+
(define (http-multiple-get base-url requests proc)
"Send all of REQUESTS to the server at BASE-URL. Call PROC for each
response, passing it the request object, the response, and a port from which
@@ -461,16 +493,23 @@ to read the response body. Return the list of results."
(()
(reverse result))
((head tail ...)
- (let* ((resp (read-response p))
- (body (response-body-port resp)))
+ (let-values (((resp body) (read-response-and-body p)))
;; The server can choose to stop responding at any time, in which
- ;; case we have to try again. Check whether that is the case.
- (match (assq 'connection (response-headers resp))
- (('connection 'close)
- (connect requests result)) ; try again
- (_
- (loop tail ; keep going
- (cons (proc head resp body) result)))))))))))
+ ;; case we have to try again. Nginx just closes the connection
+ ;; brutally, which is handled using 'eof-if-connection-reset'.
+ ;; Check whether that is the case.
+ (if (or (eof-object? resp) (eof-object? body))
+ (connect requests result)
+ (match (assq 'connection (response-headers resp))
+ (('connection 'close)
+ (connect requests result)) ;try again
+ (_
+ (let ((item (eof-if-connection-reset
+ (proc head resp body))))
+ (if (eof-object? item)
+ (connect requests result)
+ (loop tail ;keep going
+ (cons item result))))))))))))))
(define (read-to-eof port)
"Read from PORT until EOF is reached. The data are discarded."
@@ -504,11 +543,11 @@ if file doesn't exist, and the narinfo otherwise."
(set! done (+ 1 done)))))
(define (handle-narinfo-response request response port)
- (update-progress!)
(case (response-code response)
((200) ; hit
(let ((narinfo (read-narinfo port url)))
(cache-narinfo! cache (narinfo-path narinfo) narinfo)
+ (update-progress!)
narinfo))
((404) ; failure
(let* ((path (uri-path (request-uri request)))
@@ -516,7 +555,8 @@ if file doesn't exist, and the narinfo otherwise."
(read-to-eof port)
(cache-narinfo! cache
(find (cut string-contains <> hash-part) paths)
- #f))
+ #f)
+ (update-progress!))
#f)
(else ; transient failure
(read-to-eof port)