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(-)
@@ -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