guix-patches
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[bug#52555] [PATCH v3 4/8] WIP: substitute: Fetch substitutes using ERIS


From: pukkamustard
Subject: [bug#52555] [PATCH v3 4/8] WIP: substitute: Fetch substitutes using ERIS.
Date: Thu, 29 Dec 2022 18:13:23 +0000

* guix/scripts/substitute.scm (process-substitution): Fetch substitutes using 
ERIS.
* guix/eris.scm (call-with-eris-block-ref): New procedure.

TODO:

- When to set prefer-eris? in scripts/substitute.scm?
---
 guix/eris.scm               |  7 +++++++
 guix/scripts/substitute.scm | 42 +++++++++++++++++++++++++++++--------
 2 files changed, 40 insertions(+), 9 deletions(-)

diff --git a/guix/eris.scm b/guix/eris.scm
index 29d5e7b1db..d9a0914b67 100644
--- a/guix/eris.scm
+++ b/guix/eris.scm
@@ -23,6 +23,7 @@ (define-module (guix eris)
   #:use-module (guix eris fs-store)
 
   #:export (guix-eris-block-reducer
+            call-with-eris-block-ref
 
             %eris-block-store-directory))
 
@@ -34,3 +35,9 @@ (define %eris-block-store-directory
 (define (guix-eris-block-reducer)
   "Returns a block reducer that stores blocks of ERIS encoded content."
   (eris-fs-store-reducer (%eris-block-store-directory)))
+
+(define (call-with-eris-block-ref f)
+  (let ((fs-store-block-ref
+         (eris-fs-store-ref
+          (%eris-block-store-directory))))
+    (f fs-store-block-ref)))
diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm
index 0efa61b0d7..8cf011d7e6 100755
--- a/guix/scripts/substitute.scm
+++ b/guix/scripts/substitute.scm
@@ -55,12 +55,16 @@ (define-module (guix scripts substitute)
   #:use-module (ice-9 ftw)
   #:use-module (rnrs bytevectors)
   #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-2)
   #:use-module (srfi srfi-19)
   #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-34)
   #:use-module (srfi srfi-35)
   #:use-module (srfi srfi-71)
   #:use-module (web uri)
+  #:use-module (eris)
+  #:use-module (eris read-capability)
+  #:use-module (guix eris)
   #:use-module (guix http-client)
   #:export (%allow-unauthenticated-substitutes?
             %reply-file-descriptor
@@ -439,11 +443,12 @@ (define-syntax-rule (with-cached-connection uri port exp 
...)
 
 (define* (download-nar narinfo destination
                        #:key status-port
-                       deduplicate? print-build-trace?)
+                       deduplicate? print-build-trace?
+                       prefer-eris?)
   "Download the nar prescribed in NARINFO, which is assumed to be authentic
 and authorized, and write it to DESTINATION.  When DEDUPLICATE? is true, and
-if DESTINATION is in the store, deduplicate its files.  Print a status line to
-STATUS-PORT."
+if DESTINATION is in the store, deduplicate its files.  When PREFER-ERIS? is
+true, attempt to ERIS to get the nar. Print a status line to STATUS-PORT."
   (define destination-in-store?
     (string-prefix? (string-append (%store-prefix) "/")
                     destination))
@@ -474,14 +479,29 @@ (define (fetch uri)
                        #:port port
                        #:keep-alive? #t
                        #:buffered? #f))))
+      ((urn)
+       (let ((read-capability (->eris-read-capability uri)))
+         (if (eris-read-capability? read-capability)
+             (call-with-eris-block-ref
+              (lambda (block-ref)
+                (values (open-eris-input-port
+                         read-capability
+                         #:block-ref block-ref)
+                        #f)))
+             (leave (G_ "unsupported substitute URI scheme: ~a~%")
+                    (uri->string uri)))))
       (else
        (leave (G_ "unsupported substitute URI scheme: ~a~%")
               (uri->string uri)))))
 
   (let ((uri compression file-size
-             (narinfo-best-uri narinfo
-                               #:fast-decompression?
-                               %prefer-fast-decompression?)))
+             (if (and prefer-eris? (narinfo-eris-urn narinfo))
+                 (values (narinfo-eris-urn narinfo) "zstd" #f)
+                 (narinfo-best-uri narinfo
+                                   #:fast-decompression?
+                                   %prefer-fast-decompression?))))
+
+
     (unless print-build-trace?
       (format (current-error-port)
               (G_ "Downloading ~a...~%") (uri->string uri)))
@@ -631,7 +651,8 @@ (define* (process-substitution/fallback port narinfo 
destination
 
 (define* (process-substitution port store-item destination
                                #:key cache-urls acl
-                               deduplicate? print-build-trace?)
+                               deduplicate? print-build-trace?
+                               prefer-eris?)
   "Substitute STORE-ITEM (a store file name) from CACHE-URLS, and write it to
 DESTINATION as a nar file.  Verify the substitute against ACL, and verify its
 hash against what appears in the narinfo.  When DEDUPLICATE? is true, and if
@@ -660,7 +681,8 @@ (define narinfo
     (download-nar narinfo destination
                   #:status-port port
                   #:deduplicate? deduplicate?
-                  #:print-build-trace? print-build-trace?)))
+                  #:print-build-trace? print-build-trace?
+                  #:prefer-eris? prefer-eris?)))
 
 
 ;;;
@@ -858,7 +880,9 @@ (define reply-port
                                      #:acl (current-acl)
                                      #:deduplicate? deduplicate?
                                      #:print-build-trace?
-                                     print-build-trace?)
+                                     print-build-trace?
+                                     ;; TODO when to prefer ERIS?
+                                     #:prefer-eris? #t)
                (loop))))))
        (opts
         (leave (G_ "~a: unrecognized options~%") opts))))))
-- 
2.38.1






reply via email to

[Prev in Thread] Current Thread [Next in Thread]