From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mp2 ([2001:41d0:8:6d80::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by ms11 with LMTPS id IFJ0MvrYJ2AoYAAA0tVLHw (envelope-from ) for ; Sat, 13 Feb 2021 13:49:46 +0000 Received: from aspmx1.migadu.com ([2001:41d0:8:6d80::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by mp2 with LMTPS id UB8rLvrYJ2BeVAAAB5/wlQ (envelope-from ) for ; Sat, 13 Feb 2021 13:49:46 +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 8435328173 for ; Sat, 13 Feb 2021 14:49:46 +0100 (CET) Received: from localhost ([::1]:48474 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1lAvIv-0004If-ND for larch@yhetil.org; Sat, 13 Feb 2021 08:49:45 -0500 Received: from eggs.gnu.org ([2001:470:142:3::10]:55204) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1lAvHV-0002kp-6v for guix-patches@gnu.org; Sat, 13 Feb 2021 08:48:17 -0500 Received: from debbugs.gnu.org ([209.51.188.43]:50520) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1lAvHP-00079Y-Bi for guix-patches@gnu.org; Sat, 13 Feb 2021 08:48:13 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1lAvHO-0002y6-8w for guix-patches@gnu.org; Sat, 13 Feb 2021 08:48:10 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#45409] [PATCH v5 13/14] 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, 13 Feb 2021 13:48:10 +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.161322405111260 (code B ref 45409); Sat, 13 Feb 2021 13:48:10 +0000 Received: (at 45409) by debbugs.gnu.org; 13 Feb 2021 13:47:31 +0000 Received: from localhost ([127.0.0.1]:33813 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1lAvGk-0002vR-H7 for submit@debbugs.gnu.org; Sat, 13 Feb 2021 08:47:30 -0500 Received: from mira.cbaines.net ([212.71.252.8]:48208) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1lAvGd-0002tL-3O for 45409@debbugs.gnu.org; Sat, 13 Feb 2021 08:47:24 -0500 Received: from localhost (unknown [IPv6:2a02:8010:68c1:0:8ac0:b4c7:f5c8:7caa]) by mira.cbaines.net (Postfix) with ESMTPSA id 49CC527BC4F for <45409@debbugs.gnu.org>; Sat, 13 Feb 2021 13:47:21 +0000 (GMT) Received: from localhost (localhost [local]) by localhost (OpenSMTPD) with ESMTPA id 050eadf2 for <45409@debbugs.gnu.org>; Sat, 13 Feb 2021 13:47:19 +0000 (UTC) From: Christopher Baines Date: Sat, 13 Feb 2021 13:47:18 +0000 Message-Id: <20210213134719.19625-13-mail@cbaines.net> X-Mailer: git-send-email 2.30.0 In-Reply-To: <20210213134719.19625-1-mail@cbaines.net> References: <20210213134719.19625-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.64 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: 8435328173 X-Spam-Score: 2.64 X-Migadu-Scanner: scn0.migadu.com X-TUID: otDBj7TCmWoG 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 717c232633..fea2cecef0 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)))) (newline (current-error-port)) result)) @@ -396,7 +396,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) @@ -413,10 +414,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. @@ -448,7 +452,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 @@ -588,14 +593,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