GNU bug report logs - #45409
[PATCH 0/3] Move some (guix scripts substitute) code to two new modules

Previous Next

Full log

Message #146 received at 45409 <at> debbugs.gnu.org (full text, mbox):

From: Christopher Baines <mail <at> cbaines.net>
To: 45409 <at> debbugs.gnu.org
Subject: [PATCH v5 13/14] substitute: Remove fetch-narinfos use
 open-connection-for-uri/maybe.
Date: Sat, 13 Feb 2021 13:47:18 +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 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

Previous Next

GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.