diff mbox series

[bug#33899] Ludo's patch rebased on master

Message ID a694a7a065e16ed303b5452df6c1c66309b6b219.camel@telenet.be
State New
Headers show
Series [bug#33899] Ludo's patch rebased on master | expand

Checks

Context Check Description
cbaines/applying patch fail View Laminar job
cbaines/issue success View issue

Commit Message

Maxime Devos Dec. 29, 2020, 9:59 a.m. UTC
Hi Guix,

I've rebased Ludovic's patch on master
(08d8c2d3c08e4f35325553e75abc76da40630334),
resolving merge conflicts.

Make and make check succeed, except for
tests/cve.scm and tests/swh.scm. For completeness,
I've attached the logs of the failing tests.
I don't think they rare related to the changes
in the patch, though.

I most likely won't have time to test and complete
this patch in the near future.

On an unrelated note, I've changed e-mail addresses
due to excessive spam-filtering
diff mbox series

Patch

From d300bd6b37680f26fbc9b339264476fcc35e1787 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Fri, 28 Dec 2018 18:40:06 +0100
Subject: [PATCH 5/5] DRAFT substitute: Add IPFS support.

Missing:

  - documentation
  - command-line options
  - progress report when downloading over IPFS
  - fallback when we fail to fetch from IPFS

* guix/scripts/substitute.scm (<narinfo>)[ipfs]: New field.
(read-narinfo): Read "IPFS".
(process-substitution/http): New procedure, with code formerly in
'process-substitution'.
(process-substitution): Check for IPFS and call 'ipfs:restore-file-tree'
when IPFS is true.
---
 guix/scripts/substitute.scm | 112 ++++++++++++++++++++----------------
 1 file changed, 63 insertions(+), 49 deletions(-)

diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm
index feae2df9cb..8a888c5e01 100755
--- a/guix/scripts/substitute.scm
+++ b/guix/scripts/substitute.scm
@@ -43,6 +43,7 @@ 
   #:use-module (guix progress)
   #:use-module ((guix build syscalls)
                 #:select (set-thread-name))
+  #:use-module ((guix ipfs) #:prefix ipfs:)
   #:use-module (ice-9 rdelim)
   #:use-module (ice-9 regex)
   #:use-module (ice-9 match)
@@ -233,7 +234,7 @@  provide."
 (define-record-type <narinfo>
   (%make-narinfo path uri-base uris compressions file-sizes file-hashes
                  nar-hash nar-size references deriver system
-                 signature contents)
+                 ipfs signature contents)
   narinfo?
   (path         narinfo-path)
   (uri-base     narinfo-uri-base)        ;URI of the cache it originates from
@@ -246,6 +247,7 @@  provide."
   (references   narinfo-references)
   (deriver      narinfo-deriver)
   (system       narinfo-system)
+  (ipfs         narinfo-ipfs)
   (signature    narinfo-signature)      ; canonical sexp
   ;; The original contents of a narinfo file.  This field is needed because we
   ;; want to preserve the exact textual representation for verification purposes.
@@ -288,7 +290,7 @@  s-expression: ~s~%")
 must contain the original contents of a narinfo file."
   (lambda (path urls compressions file-hashes file-sizes
                 nar-hash nar-size references deriver system
-                signature)
+                ipfs signature)
     "Return a new <narinfo> object."
     (define len (length urls))
     (%make-narinfo path cache-url
@@ -312,6 +314,7 @@  must contain the original contents of a narinfo file."
                      ((or #f "") #f)
                      (_ deriver))
                    system
+                   ipfs
                    (false-if-exception
                     (and=> signature narinfo-signature->canonical-sexp))
                    str)))
@@ -330,7 +333,7 @@  No authentication and authorization checks are performed here!"
                    (narinfo-maker str url)
                    '("StorePath" "URL" "Compression"
                      "FileHash" "FileSize" "NarHash" "NarSize"
-                     "References" "Deriver" "System"
+                     "References" "Deriver" "System" "IPFS"
                      "Signature")
                    '("URL" "Compression" "FileSize" "FileHash"))))
 
@@ -962,6 +965,48 @@  the URI, its compression method (a string), and the compressed file size."
     (((uri compression file-size) _ ...)
      (values uri compression file-size))))
 
+(define* (process-substitution/http narinfo destination uri
+                                    compression
+                                    #:key print-build-trace?)
+  (unless print-build-trace?
+    (format (current-error-port)
+            (G_ "Downloading ~a...~%") (uri->string uri)))
+  (let*-values (((raw download-size)
+                 ;; Note that Hydra currently generates Nars on the fly
+                 ;; and doesn't specify a Content-Length, so
+                 ;; DOWNLOAD-SIZE is #f in practice.
+                 (fetch uri #:buffered? #f #:timeout? #f))
+                ((progress)
+                 (let* ((dl-size  (or download-size
+                                      (and (equal? compression "none")
+                                           (narinfo-size narinfo))))
+                        (reporter (if print-build-trace?
+                                      (progress-reporter/trace
+                                       destination
+                                       (uri->string uri) dl-size
+                                       (current-error-port))
+                                      (progress-reporter/file
+                                       (uri->string uri) dl-size
+                                       (current-error-port)
+                                       #:abbreviation nar-uri-abbreviation))))
+                   (progress-report-port reporter raw)))
+                ((input pids)
+                 ;; NOTE: This 'progress' port of current process will be
+                 ;; closed here, while the child process doing the
+                 ;; reporting will close it upon exit.
+                 (decompressed-port (string->symbol compression)
+                                    progress)))
+    ;; Unpack the Nar at INPUT into DESTINATION.
+    (restore-file input destination)
+    (close-port input)
+
+    ;; Wait for the reporter to finish.
+    (every (compose zero? cdr waitpid) pids)
+
+    ;; Skip a line after what 'progress-reporter/file' printed, and another
+    ;; one to visually separate substitutions.
+    (display "\n\n" (current-error-port))))
+
 (define* (process-substitution store-item destination
                                #:key cache-urls acl print-build-trace?)
   "Substitute STORE-ITEM (a store file name) from CACHE-URLS, and write it to
@@ -969,55 +1014,24 @@  DESTINATION as a nar file.  Verify the substitute against ACL."
   (define narinfo
     (lookup-narinfo cache-urls store-item
                     (cut valid-narinfo? <> acl)))
-
+  (define ipfs (and=> narinfo narinfo-ipfs))
   (unless narinfo
     (leave (G_ "no valid substitute for '~a'~%")
            store-item))
-
-  (let-values (((uri compression file-size)
-                (narinfo-best-uri narinfo)))
-    ;; Tell the daemon what the expected hash of the Nar itself is.
-    (format #t "~a~%" (narinfo-hash narinfo))
-
-    (unless print-build-trace?
-      (format (current-error-port)
-              (G_ "Downloading ~a...~%") (uri->string uri)))
-
-    (let*-values (((raw download-size)
-                   ;; Note that Hydra currently generates Nars on the fly
-                   ;; and doesn't specify a Content-Length, so
-                   ;; DOWNLOAD-SIZE is #f in practice.
-                   (fetch uri #:buffered? #f #:timeout? #f))
-                  ((progress)
-                   (let* ((dl-size  (or download-size
-                                        (and (equal? compression "none")
-                                             (narinfo-size narinfo))))
-                          (reporter (if print-build-trace?
-                                        (progress-reporter/trace
-                                         destination
-                                         (uri->string uri) dl-size
-                                         (current-error-port))
-                                        (progress-reporter/file
-                                         (uri->string uri) dl-size
-                                         (current-error-port)
-                                         #:abbreviation nar-uri-abbreviation))))
-                     (progress-report-port reporter raw)))
-                  ((input pids)
-                   ;; NOTE: This 'progress' port of current process will be
-                   ;; closed here, while the child process doing the
-                   ;; reporting will close it upon exit.
-                   (decompressed-port (string->symbol compression)
-                                      progress)))
-      ;; Unpack the Nar at INPUT into DESTINATION.
-      (restore-file input destination)
-      (close-port input)
-
-      ;; Wait for the reporter to finish.
-      (every (compose zero? cdr waitpid) pids)
-
-      ;; Skip a line after what 'progress-reporter/file' printed, and another
-      ;; one to visually separate substitutions.
-      (display "\n\n" (current-error-port)))))
+  ;; Tell the daemon what the expected hash of the Nar itself is.
+  (format #t "~a~%" (narinfo-hash narinfo))
+  (if ipfs
+      (begin
+        (unless print-build-trace?
+          (format (current-error-port)
+                  (G_ "Downloading from IPFS ~s...~%") ipfs))
+        (ipfs:restore-file-tree ipfs destination))
+      (let-values (((uri compression file-size)
+                    (narinfo-best-uri narinfo)))
+        (process-substitution/http narinfo destination uri
+                                   compression
+                                   #:print-build-trace?
+                                   print-build-trace?))))
 
 
 ;;;
-- 
2.29.2