From patchwork Thu Mar 25 11:03:15 2021 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Christopher Baines X-Patchwork-Id: 28104 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id 08B5927BC5D; Thu, 25 Mar 2021 11:04:40 +0000 (GMT) X-Spam-Checker-Version: SpamAssassin 3.4.2 (2018-09-13) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-2.9 required=5.0 tests=BAYES_00,MAILING_LIST_MULTI, SPF_HELO_PASS,UNPARSEABLE_RELAY autolearn=unavailable autolearn_force=no version=3.4.2 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTPS id 76BCF27BC5C for ; Thu, 25 Mar 2021 11:04:39 +0000 (GMT) Received: from localhost ([::1]:55382 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1lPNn4-0005D5-M3 for patchwork@mira.cbaines.net; Thu, 25 Mar 2021 07:04:38 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:56470) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1lPNmU-0004kQ-Uj for guix-patches@gnu.org; Thu, 25 Mar 2021 07:04:02 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:54015) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1lPNmU-0007vs-Lc for guix-patches@gnu.org; Thu, 25 Mar 2021 07:04:02 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1lPNmU-0001Vf-Hj for guix-patches@gnu.org; Thu, 25 Mar 2021 07:04:02 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#47288] [PATCH v3 1/2] guix: http-client: Tweak http-multiple-get error handling. References: <20210321004338.31867-1-mail@cbaines.net> In-Reply-To: <20210321004338.31867-1-mail@cbaines.net> Resent-From: Christopher Baines Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Thu, 25 Mar 2021 11:04:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 47288 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 47288@debbugs.gnu.org Received: via spool by 47288-submit@debbugs.gnu.org id=B47288.16166701995738 (code B ref 47288); Thu, 25 Mar 2021 11:04:02 +0000 Received: (at 47288) by debbugs.gnu.org; 25 Mar 2021 11:03:19 +0000 Received: from localhost ([127.0.0.1]:37326 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1lPNln-0001UT-7o for submit@debbugs.gnu.org; Thu, 25 Mar 2021 07:03:19 -0400 Received: from mira.cbaines.net ([212.71.252.8]:50966) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1lPNll-0001UF-Ox for 47288@debbugs.gnu.org; Thu, 25 Mar 2021 07:03:18 -0400 Received: from localhost (unknown [IPv6:2a02:8010:68c1:0:8ac0:b4c7:f5c8:7caa]) by mira.cbaines.net (Postfix) with ESMTPSA id CA5CD27BC5C for <47288@debbugs.gnu.org>; Thu, 25 Mar 2021 11:03:16 +0000 (GMT) Received: from localhost (localhost [local]) by localhost (OpenSMTPD) with ESMTPA id 8a272564 for <47288@debbugs.gnu.org>; Thu, 25 Mar 2021 11:03:16 +0000 (UTC) From: Christopher Baines Date: Thu, 25 Mar 2021 11:03:15 +0000 Message-Id: <20210325110316.862-1-mail@cbaines.net> X-Mailer: git-send-email 2.30.1 MIME-Version: 1.0 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: "Guix-patches" X-getmail-retrieved-from-mailbox: Patches This isn't meant to change the way errors are handled, and arguably makes the code harder to read, but it's a uninformed attempt to improve the performance (following on from a performance regression in 205833b72c5517915a47a50dbe28e7024dc74e57). I'm guessing something about Guile internals makes calling (loop ...) within the catch bit less performant than avoiding this and calling (loop ...) after the catch bit has finished. Since this happens lots, this seems to be sufficient to make guix weather a lot slower than it was before. Anecdotal testing of guix weather suggests this change might work. * guix/http-client.scm (http-multiple-get): Tweak how the second catch statement works. --- guix/http-client.scm | 77 +++++++++++++++++++++++++------------------- 1 file 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))))))))) ;;; From patchwork Thu Mar 25 11:03:16 2021 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Christopher Baines X-Patchwork-Id: 28103 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id EC93E27BC5C; Thu, 25 Mar 2021 11:04:13 +0000 (GMT) X-Spam-Checker-Version: SpamAssassin 3.4.2 (2018-09-13) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-2.9 required=5.0 tests=BAYES_00,MAILING_LIST_MULTI, SPF_HELO_PASS,UNPARSEABLE_RELAY,URIBL_BLOCKED autolearn=unavailable autolearn_force=no version=3.4.2 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTPS id 7A41527BC5E for ; Thu, 25 Mar 2021 11:04:12 +0000 (GMT) Received: from localhost ([::1]:54386 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1lPNmd-0004na-KR for patchwork@mira.cbaines.net; Thu, 25 Mar 2021 07:04:11 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:56472) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1lPNmV-0004kw-Ad for guix-patches@gnu.org; Thu, 25 Mar 2021 07:04:03 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:54016) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1lPNmV-0007wF-2v for guix-patches@gnu.org; Thu, 25 Mar 2021 07:04:03 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1lPNmU-0001Vm-Uv for guix-patches@gnu.org; Thu, 25 Mar 2021 07:04:02 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#47288] [PATCH v3 2/2] guix: http-client: Refactor http-multiple-get. Resent-From: Christopher Baines Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Thu, 25 Mar 2021 11:04:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 47288 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 47288@debbugs.gnu.org Received: via spool by 47288-submit@debbugs.gnu.org id=B47288.16166702005745 (code B ref 47288); Thu, 25 Mar 2021 11:04:02 +0000 Received: (at 47288) by debbugs.gnu.org; 25 Mar 2021 11:03:20 +0000 Received: from localhost ([127.0.0.1]:37328 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1lPNln-0001UV-J9 for submit@debbugs.gnu.org; Thu, 25 Mar 2021 07:03:20 -0400 Received: from mira.cbaines.net ([212.71.252.8]:50968) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1lPNll-0001UG-RJ for 47288@debbugs.gnu.org; Thu, 25 Mar 2021 07:03:18 -0400 Received: from localhost (unknown [IPv6:2a02:8010:68c1:0:8ac0:b4c7:f5c8:7caa]) by mira.cbaines.net (Postfix) with ESMTPSA id D2A8F27BC5D for <47288@debbugs.gnu.org>; Thu, 25 Mar 2021 11:03:16 +0000 (GMT) Received: from localhost (localhost [local]) by localhost (OpenSMTPD) with ESMTPA id 551b1553 for <47288@debbugs.gnu.org>; Thu, 25 Mar 2021 11:03:16 +0000 (UTC) From: Christopher Baines Date: Thu, 25 Mar 2021 11:03:16 +0000 Message-Id: <20210325110316.862-2-mail@cbaines.net> X-Mailer: git-send-email 2.30.1 In-Reply-To: <20210325110316.862-1-mail@cbaines.net> References: <20210325110316.862-1-mail@cbaines.net> MIME-Version: 1.0 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: "Guix-patches" X-getmail-retrieved-from-mailbox: Patches Split the procedure in to three smaller procedures, rather than using two longer let statements. This might make it easier to read. * guix/http-client.scm (http-multiple-get): Refactor. --- guix/http-client.scm | 195 ++++++++++++++++++++++--------------------- 1 file changed, 101 insertions(+), 94 deletions(-) diff --git a/guix/http-client.scm b/guix/http-client.scm index adbfbc0d6e..b584feba5d 100644 --- a/guix/http-client.scm +++ b/guix/http-client.scm @@ -147,7 +147,7 @@ Raise an '&http-get-error' condition if downloading fails." (uri->string uri) code (response-reason-phrase resp)))))))))))) -(define* (http-multiple-get base-uri proc seed requests +(define* (http-multiple-get base-uri proc seed all-requests #:key port (verify-certificate? #t) (open-connection guix:open-connection-for-uri) (keep-alive? #t) @@ -161,16 +161,90 @@ When PORT is specified, use it as the initial connection on which HTTP requests are sent; otherwise call OPEN-CONNECTION to open a new connection for a URI. When KEEP-ALIVE? is false, close the connection port before returning." - (let connect ((port port) - (requests requests) - (result seed)) + (define (send-batch-of-requests p batch) + ;; Send BATCH in a row. + ;; XXX: Do our own caching to work around inefficiencies when + ;; communicating over TLS: . + (let-values (((buffer get) (open-bytevector-output-port))) + ;; 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))) + + (define (process-batch-of-responses p + all-remaining-requests + batch-remaining-requests + processed + result) + (if (null? batch-remaining-requests) + (match (drop all-remaining-requests processed) + (() + (unless keep-alive? + (close-port p)) + (reverse result)) + (remainder + (connect-and-make-requests p remainder result))) + (match + (catch #t + (lambda () + (let* ((request (car batch-remaining-requests)) + (resp (read-response p)) + (body (response-body-port resp)) + (result (proc request 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-and-make-requests + #f + (drop all-remaining-requests (+ 1 processed)) + result)) + (_ + (list 'process-batch-of-responses + p + all-remaining-requests + (cdr batch-remaining-requests) + (+ 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-and-make-requests + #f + (drop all-remaining-requests processed) + result)) + (apply throw key args)))) + + (('connect-and-make-requests . args) + (apply connect-and-make-requests args)) + (('process-batch-of-responses . args) + (apply process-batch-of-responses args))))) + + (define (connect-and-make-requests port remaining-requests result) (define batch - (if (>= batch-size (length requests)) - requests - (take requests batch-size))) + (if (>= batch-size (length remaining-requests)) + remaining-requests + (take remaining-requests batch-size))) - ;; (format (current-error-port) "connecting (~a requests left)..." - ;; (length requests)) (let ((p (or port (open-connection base-uri #:verify-certificate? verify-certificate?)))) @@ -178,92 +252,25 @@ returning." (when (file-port? p) (setvbuf p 'block (expt 2 16))) - ;; Send BATCH in a row. - ;; XXX: Do our own caching to work around inefficiencies when - ;; communicating over TLS: . - (let-values (((buffer get) (open-bytevector-output-port))) - ;; Inherit the HTTP proxying property from P. - (set-http-proxy-port?! buffer (http-proxy-port? 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))))) + (catch #t + (lambda () + (send-batch-of-requests p batch)) + (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-and-make-requests #f + remaining-requests + result)) + (apply throw key args)))) - ;; Now start processing responses. - (let loop ((sent batch) - (processed 0) - (result result)) - (match sent - (() - (match (drop requests processed) - (() - (unless keep-alive? - (close-port p)) - (reverse result)) - (remainder - (connect p remainder result)))) - ((head tail ...) - (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)) - (_ - (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))))))))) + (process-batch-of-responses p remaining-requests batch 0 result))) + + (connect-and-make-requests port all-requests seed)) ;;;