From patchwork Sun Apr 21 09:42:39 2024 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Christopher Baines X-Patchwork-Id: 63263 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 507F127BBE2; Sun, 21 Apr 2024 10:45:53 +0100 (BST) X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) 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,URIBL_BLOCKED autolearn=unavailable autolearn_force=no version=3.4.6 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTPS id 149DF27BBE9 for ; Sun, 21 Apr 2024 10:45:52 +0100 (BST) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1ryTk0-0005cq-HF; Sun, 21 Apr 2024 05:44:08 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1ryTjp-0005U2-Qv for guix-patches@gnu.org; Sun, 21 Apr 2024 05:43:59 -0400 Received: from debbugs.gnu.org ([2001:470:142:5::43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1ryTjp-0002qw-Hp; Sun, 21 Apr 2024 05:43:57 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1ryTk3-0006Wi-EY; Sun, 21 Apr 2024 05:44:11 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#70494] [PATCH 21/23] scripts: substitute: Don't enforce cached connections in download-nar. Resent-From: Christopher Baines Original-Sender: "Debbugs-submit" Resent-CC: guix@cbaines.net, dev@jpoiret.xyz, ludo@gnu.org, othacehe@gnu.org, rekado@elephly.net, zimon.toutoune@gmail.com, me@tobias.gr, guix-patches@gnu.org Resent-Date: Sun, 21 Apr 2024 09:44:11 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 70494 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 70494@debbugs.gnu.org Cc: Christopher Baines , Josselin Poiret , Ludovic =?utf-8?q?Court=C3=A8s?= , Mathieu Othacehe , Ricardo Wurmus , Simon Tournier , Tobias Geerinckx-Rice X-Debbugs-Original-Xcc: Christopher Baines , Josselin Poiret , Ludovic =?utf-8?q?Court=C3=A8s?= , Mathieu Othacehe , Ricardo Wurmus , Simon Tournier , Tobias Geerinckx-Rice Received: via spool by 70494-submit@debbugs.gnu.org id=B70494.171369263924828 (code B ref 70494); Sun, 21 Apr 2024 09:44:11 +0000 Received: (at 70494) by debbugs.gnu.org; 21 Apr 2024 09:43:59 +0000 Received: from localhost ([127.0.0.1]:41795 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1ryTjp-0006S6-BM for submit@debbugs.gnu.org; Sun, 21 Apr 2024 05:43:59 -0400 Received: from mira.cbaines.net ([212.71.252.8]:43374) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1ryTj0-0006Id-BX for 70494@debbugs.gnu.org; Sun, 21 Apr 2024 05:43:10 -0400 Received: from localhost (unknown [212.132.255.10]) by mira.cbaines.net (Postfix) with ESMTPSA id 9DAC427BBEE for <70494@debbugs.gnu.org>; Sun, 21 Apr 2024 10:42:49 +0100 (BST) Received: from localhost (localhost [local]) by localhost (OpenSMTPD) with ESMTPA id 53ec2ce3 for <70494@debbugs.gnu.org>; Sun, 21 Apr 2024 09:42:48 +0000 (UTC) From: Christopher Baines Date: Sun, 21 Apr 2024 10:42:39 +0100 Message-ID: X-Mailer: git-send-email 2.41.0 In-Reply-To: <87bk632h36.fsf@cbaines.net> References: <87bk632h36.fsf@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-bounces+patchwork=mira.cbaines.net@gnu.org X-getmail-retrieved-from-mailbox: Patches This is in preparation for moving the download-nar procedure out of the script. As well as calling open-connection-for-uri/cached, with-cached-connection adds a single retry to the expression passed in, in the case of a exception that suggests there's a problem with the cached connection. This is important because download-nar/http-fetch doesn't check if a connection used for multiple requests should be closed (because the servers set the relevant response header). To make download-nar more generic, have it take open-connection-for-uri as a keyword argument, and replicate the with-cached-connection single retry by closing the port in the case of a network error, and recalling open-connection-for-uri. This will work fine in the case when connection caching is not in use, as well as when open-connection-for-uri/cached is used, since open-connection-for-uri/cached will open a new connection if the cached port is closed. * guix/scripts/substitute.scm (kind-and-args-exception?): Remove and inline where necessary. (call-with-cached-connection): Remove procedure. (with-cached-connection): Remove syntax rule. (http-response-error?): New procedure. (download-nar): Add new #:open-connection-for-uri keyword argument and use it, also replace with-cached-connection. (process-substitution/fallback,process-substitution): Pass #:open-connection-for-uri open-connection-for-uri/cached to download-nar. Change-Id: I277b1d8dfef79aa1711755b10b9944da7c19157c --- guix/scripts/substitute.scm | 84 +++++++++++++++---------------------- 1 file changed, 33 insertions(+), 51 deletions(-) diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm index b4bb9d51ff..38975ec366 100755 --- a/guix/scripts/substitute.scm +++ b/guix/scripts/substitute.scm @@ -410,55 +410,25 @@ (define open-connection-for-uri/cached (drain-input socket) socket)))))))) -(define kind-and-args-exception? - (exception-predicate &exception-with-kind-and-args)) - -(define (call-with-cached-connection uri proc) - (let ((port (open-connection-for-uri/cached uri - #:verify-certificate? #f))) - (guard (c ((kind-and-args-exception? c) - (let ((key (exception-kind c)) - (args (exception-args c))) - ;; 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) - (memq (first args) - (list error/invalid-session - - ;; XXX: These two are not properly handled in - ;; GnuTLS < 3.7.3, in - ;; 'write_to_session_record_port'; see - ;; . - error/again error/interrupted))) - (memq key '(bad-response bad-header bad-header-component))) - (proc (open-connection-for-uri/cached uri - #:verify-certificate? #f - #:fresh? #t)) - (raise c)))) - (#t - ;; An exception that's not handled here, such as - ;; '&http-get-error'. Re-raise it. - (raise c))) - (proc port)))) - -(define-syntax-rule (with-cached-connection uri port exp ...) - "Bind PORT with EXP... to a socket connected to URI." - (call-with-cached-connection uri (lambda (port) exp ...))) - (define-syntax-rule (catch-system-error exp) (catch 'system-error (lambda () exp) (const #f))) +(define http-response-error? + (let ((kind-and-args-exception? + (exception-predicate &exception-with-kind-and-args))) + (lambda (exception) + "Return true if EXCEPTION denotes an error with the http response" + (->bool + (memq (exception-kind exception) + '(bad-response bad-header bad-header-component)))))) + (define* (download-nar narinfo destination #:key deduplicate? print-build-trace? (fetch-timeout %fetch-timeout) - prefer-fast-decompression?) + prefer-fast-decompression? + (open-connection-for-uri guix:open-connection-for-uri)) "Download the nar prescribed in NARINFO, which is assumed to be authentic and authorized, and write it to DESTINATION. When DEDUPLICATE? is true, and if DESTINATION is in the store, deduplicate its files." @@ -487,11 +457,22 @@ (define* (download-nar narinfo destination (warning (G_ "while fetching ~a: server is somewhat slow~%") (uri->string uri)) (warning (G_ "try `--no-substitutes' if the problem persists~%"))) - (with-cached-connection uri port - (http-fetch uri #:text? #f - #:port port - #:keep-alive? #t - #:buffered? #f)))) + (let loop ((port (open-connection-for-uri uri)) + (attempt 0)) + (guard (c ((or (network-error? c) + (http-response-error? c)) + (close-port port) + + ;; Perform a single retry in the case of an error, + ;; mostly to mimic the behaviour of + ;; with-cached-connection + (if (= attempt 0) + (loop (open-connection-for-uri uri) 1) + (raise c)))) + (http-fetch uri #:text? #f + #:port port + #:keep-alive? #t + #:buffered? #f))))) (else (raise (formatted-message @@ -612,7 +593,9 @@ (define* (process-substitution/fallback narinfo destination #:deduplicate? deduplicate? #:print-build-trace? print-build-trace? #:prefer-fast-decompression? - prefer-fast-decompression?)) + prefer-fast-decompression? + #:open-connection-for-uri + open-connection-for-uri/cached)) (loop rest))) (() (loop rest))))))) @@ -663,7 +646,9 @@ (define* (process-substitution store-item destination (download-nar narinfo destination #:deduplicate? deduplicate? #:print-build-trace? print-build-trace? - #:prefer-fast-decompression? prefer-fast-decompression?)))) + #:prefer-fast-decompression? prefer-fast-decompression? + #:open-connection-for-uri + open-connection-for-uri/cached)))) (values narinfo expected-hash actual-hash))) @@ -930,10 +915,7 @@ (define-command (guix-substitute . args) (leave (G_ "~a: unrecognized options~%") opts)))))) ;;; Local Variables: -;;; eval: (put 'with-timeout 'scheme-indent-function 1) ;;; eval: (put 'with-redirected-error-port 'scheme-indent-function 0) -;;; eval: (put 'with-cached-connection 'scheme-indent-function 2) -;;; eval: (put 'call-with-cached-connection 'scheme-indent-function 1) ;;; End: ;;; substitute.scm ends here