[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[bug#45409] [PATCH v4 13/13] substitute: Remove fetch-narinfos use open-
From: |
Christopher Baines |
Subject: |
[bug#45409] [PATCH v4 13/13] substitute: Remove fetch-narinfos use open-connection-for-uri/maybe. |
Date: |
Sat, 16 Jan 2021 13:58:03 +0000 |
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
- [bug#45409] [PATCH v4 02/13] substitute: Remove connection handling from fetch., (continued)
- [bug#45409] [PATCH v4 02/13] substitute: Remove connection handling from fetch., Christopher Baines, 2021/01/16
- [bug#45409] [PATCH v4 04/13] guix: Move http-multiple-get to (guix http-client)., Christopher Baines, 2021/01/16
- [bug#45409] [PATCH v4 11/13] substitute: Remove redundant fetch arguments., Christopher Baines, 2021/01/16
- [bug#45409] [PATCH v4 05/13] http-client: Add error handling to http-multiple-get., Christopher Baines, 2021/01/16
- [bug#45409] [PATCH v4 06/13] substitute: open-connection-for-uri/maybe add #:verify-certificate?., Christopher Baines, 2021/01/16
- [bug#45409] [PATCH v4 07/13] substitute: Stop using call-with-cached-connection in fetch-narinfos., Christopher Baines, 2021/01/16
- [bug#45409] [PATCH v4 03/13] substitute: Remove redundant let block from fetch., Christopher Baines, 2021/01/16
- [bug#45409] [PATCH v4 10/13] substitute: Remove now redundant connection caching helpers., Christopher Baines, 2021/01/16
- [bug#45409] [PATCH v4 12/13] substitute: Inline fetch in to process-substitutes., Christopher Baines, 2021/01/16
- [bug#45409] [PATCH v4 08/13] http-client: Accept #:open-connection in http-fetch., Christopher Baines, 2021/01/16
- [bug#45409] [PATCH v4 13/13] substitute: Remove fetch-narinfos use open-connection-for-uri/maybe.,
Christopher Baines <=
- [bug#45409] [PATCH v4 09/13] substitute: Change connection cache handling in process-substitution., Christopher Baines, 2021/01/16