[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
13/14: substitute: Remove fetch-narinfos use open-connection-for-uri/may
From: |
guix-commits |
Subject: |
13/14: substitute: Remove fetch-narinfos use open-connection-for-uri/maybe. |
Date: |
Mon, 22 Feb 2021 15:44:48 -0500 (EST) |
cbaines pushed a commit to branch master
in repository guix.
commit 187e97096825d2bcceb144cead6eccc27385acd7
Author: Christopher Baines <mail@cbaines.net>
AuthorDate: Thu Jan 7 21:00:23 2021 +0000
substitute: Remove fetch-narinfos use open-connection-for-uri/maybe.
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 717c232..fea2cec 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
- 01/14: substitute: Remove buffer handling from fetch., (continued)
- 01/14: substitute: Remove buffer handling from fetch., guix-commits, 2021/02/22
- 02/14: substitute: Remove connection handling from fetch., guix-commits, 2021/02/22
- 03/14: substitute: Remove redundant let block from fetch., guix-commits, 2021/02/22
- 04/14: guix: Move http-multiple-get to (guix http-client)., guix-commits, 2021/02/22
- 05/14: http-client: Add error handling to http-multiple-get., guix-commits, 2021/02/22
- 06/14: substitute: open-connection-for-uri/maybe add #:verify-certificate?., guix-commits, 2021/02/22
- 10/14: substitute: Remove now redundant connection caching helpers., guix-commits, 2021/02/22
- 08/14: http-client: Accept #:open-connection in http-fetch., guix-commits, 2021/02/22
- 07/14: substitute: Stop using call-with-cached-connection in fetch-narinfos., guix-commits, 2021/02/22
- 09/14: substitute: Change connection cache handling in process-substitution., guix-commits, 2021/02/22
- 13/14: substitute: Remove fetch-narinfos use open-connection-for-uri/maybe.,
guix-commits <=
- 11/14: substitute: Remove redundant fetch arguments., guix-commits, 2021/02/22
- 12/14: substitute: Inline fetch in to process-substitutes., guix-commits, 2021/02/22
- 14/14: substitute: Rework connection error handling., guix-commits, 2021/02/22