From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mp1 ([2001:41d0:2:4a6f::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by ms11 with LMTPS id QLV7EenxAmAOMQAA0tVLHw (envelope-from ) for ; Sat, 16 Jan 2021 14:02:17 +0000 Received: from aspmx1.migadu.com ([2001:41d0:2:4a6f::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by mp1 with LMTPS id ANA2DenxAmAFKAAAbx9fmQ (envelope-from ) for ; Sat, 16 Jan 2021 14:02:17 +0000 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by aspmx1.migadu.com (Postfix) with ESMTPS id AF91A940503 for ; Sat, 16 Jan 2021 14:02:16 +0000 (UTC) Received: from localhost ([::1]:35866 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1l0m9f-0000TA-M3 for larch@yhetil.org; Sat, 16 Jan 2021 09:02:15 -0500 Received: from eggs.gnu.org ([2001:470:142:3::10]:60166) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1l0m6e-0007D2-8I for guix-patches@gnu.org; Sat, 16 Jan 2021 08:59:08 -0500 Received: from debbugs.gnu.org ([209.51.188.43]:59308) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1l0m6d-0004w6-5u for guix-patches@gnu.org; Sat, 16 Jan 2021 08:59:07 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1l0m6d-0005xi-5T for guix-patches@gnu.org; Sat, 16 Jan 2021 08:59:07 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#45409] [PATCH v4 13/13] substitute: Remove fetch-narinfos use open-connection-for-uri/maybe. Resent-From: Christopher Baines Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Sat, 16 Jan 2021 13:59:07 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 45409 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 45409@debbugs.gnu.org Received: via spool by 45409-submit@debbugs.gnu.org id=B45409.161080550422779 (code B ref 45409); Sat, 16 Jan 2021 13:59:07 +0000 Received: (at 45409) by debbugs.gnu.org; 16 Jan 2021 13:58:24 +0000 Received: from localhost ([127.0.0.1]:42609 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1l0m5w-0005vG-Gj for submit@debbugs.gnu.org; Sat, 16 Jan 2021 08:58:24 -0500 Received: from mira.cbaines.net ([212.71.252.8]:49440) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1l0m5i-0005sx-8O for 45409@debbugs.gnu.org; Sat, 16 Jan 2021 08:58:12 -0500 Received: from localhost (188.29.101.63.threembb.co.uk [188.29.101.63]) by mira.cbaines.net (Postfix) with ESMTPSA id 20F5C27BC1F for <45409@debbugs.gnu.org>; Sat, 16 Jan 2021 13:58:08 +0000 (GMT) Received: from localhost (localhost [local]) by localhost (OpenSMTPD) with ESMTPA id c1fc769d for <45409@debbugs.gnu.org>; Sat, 16 Jan 2021 13:58:03 +0000 (UTC) From: Christopher Baines Date: Sat, 16 Jan 2021 13:58:03 +0000 Message-Id: <20210116135803.21955-13-mail@cbaines.net> X-Mailer: git-send-email 2.30.0 In-Reply-To: <20210116135803.21955-1-mail@cbaines.net> References: <20210116135803.21955-1-mail@cbaines.net> MIME-Version: 1.0 Content-Transfer-Encoding: 8bit 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+larch=yhetil.org@gnu.org Sender: "Guix-patches" X-Migadu-Flow: FLOW_IN X-Migadu-Spam-Score: 2.65 Authentication-Results: aspmx1.migadu.com; dkim=none; dmarc=none; spf=pass (aspmx1.migadu.com: domain of guix-patches-bounces@gnu.org designates 209.51.188.17 as permitted sender) smtp.mailfrom=guix-patches-bounces@gnu.org X-Migadu-Queue-Id: AF91A940503 X-Spam-Score: 2.65 X-Migadu-Scanner: scn0.migadu.com X-TUID: akujKE7brTuy At least by default. Instead, make the open-connection procedure a parameter, and make the default guix:open-connection-for-uri. Do so similarly for lookup-narinfos and lookup-narinfos/diverse which work towards calling fetch-narinfos. This means this code can be moved to a different module, without having use/move the connection caching code. * guix/scripts/substitute.scm (fetch-narinfos): Add #:open-connection argument, and call http-multiple-get with it. (lookup-narinfos) Add #:open-connection argument, and call fetch-narinfos with it. (lookup-narinfos/diverse): Add #:open-connection argument, and call lookup-narinfos with it. (process-query): Call lookup-narinfos/diverse with #:open-connection open-connection-for-uri/maybe. --- guix/scripts/substitute.scm | 27 ++++++++++++++++++--------- 1 file changed, 18 insertions(+), 9 deletions(-) diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm index 858ce1dcc4..c2a8dd419f 100755 --- a/guix/scripts/substitute.scm +++ b/guix/scripts/substitute.scm @@ -314,7 +314,8 @@ port to it, or, if connection failed, print a warning and return #f. Pass (args (apply throw args))))) -(define (fetch-narinfos url paths) +(define* (fetch-narinfos url paths + #:key (open-connection guix:open-connection-for-uri)) "Retrieve all the narinfos for PATHS from the cache at URL and return them." (define update-progress! (let ((done 0) @@ -379,8 +380,7 @@ port to it, or, if connection failed, print a warning and return #f. Pass (http-multiple-get uri handle-narinfo-response '() requests - #:open-connection - open-connection-for-uri/maybe + #:open-connection open-connection #:verify-certificate? #f)))) result)) ((file #f) @@ -395,7 +395,8 @@ port to it, or, if connection failed, print a warning and return #f. Pass (do-fetch (string->uri url))) -(define (lookup-narinfos cache paths) +(define* (lookup-narinfos cache paths + #:key (open-connection guix:open-connection-for-uri)) "Return the narinfos for PATHS, invoking the server at CACHE when no information is available locally." (let-values (((cached missing) @@ -412,10 +413,13 @@ information is available locally." paths))) (if (null? missing) cached - (let ((missing (fetch-narinfos cache missing))) + (let ((missing (fetch-narinfos cache missing + #:open-connection open-connection))) (append cached (or missing '())))))) -(define (lookup-narinfos/diverse caches paths authorized?) +(define* (lookup-narinfos/diverse caches paths authorized? + #:key (open-connection + guix:open-connection-for-uri)) "Look up narinfos for PATHS on all of CACHES, a list of URLS, in that order. That is, when a cache lacks an AUTHORIZED? narinfo, look it up in the next cache, and so on. @@ -447,7 +451,8 @@ AUTHORIZED? narinfo." (_ (match caches ((cache rest ...) - (let* ((narinfos (lookup-narinfos cache paths)) + (let* ((narinfos (lookup-narinfos cache paths + #:open-connection open-connection)) (definite (map narinfo-path (filter authorized? narinfos))) (missing (lset-difference string=? paths definite))) ;XXX: perf (loop rest missing @@ -587,14 +592,18 @@ authorized substitutes." (match (string-tokenize command) (("have" paths ..1) ;; Return the subset of PATHS available in CACHE-URLS. - (let ((substitutable (lookup-narinfos/diverse cache-urls paths valid?))) + (let ((substitutable (lookup-narinfos/diverse + cache-urls paths valid? + #:open-connection open-connection-for-uri/maybe))) (for-each (lambda (narinfo) (format #t "~a~%" (narinfo-path narinfo))) substitutable) (newline))) (("info" paths ..1) ;; Reply info about PATHS if it's in CACHE-URLS. - (let ((substitutable (lookup-narinfos/diverse cache-urls paths valid?))) + (let ((substitutable (lookup-narinfos/diverse + cache-urls paths valid? + #:open-connection open-connection-for-uri/maybe))) (for-each display-narinfo-data substitutable) (newline))) (wtf -- 2.30.0