From: "Ludovic Courtès" <ludo@gnu.org>
To: 33899@debbugs.gnu.org
Subject: [bug#33899] [PATCH 5/5] DRAFT substitute: Add IPFS support.
Date: Sat, 29 Dec 2018 00:15:54 +0100 [thread overview]
Message-ID: <20181228231554.8220-5-ludo@gnu.org> (raw)
In-Reply-To: <20181228231554.8220-1-ludo@gnu.org>
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 | 106 +++++++++++++++++++++---------------
1 file changed, 61 insertions(+), 45 deletions(-)
diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm
index 53b1777241..8be15e4f13 100755
--- a/guix/scripts/substitute.scm
+++ b/guix/scripts/substitute.scm
@@ -42,6 +42,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)
@@ -281,7 +282,7 @@ failure, return #f and #f."
\f
(define-record-type <narinfo>
(%make-narinfo path uri uri-base compression file-hash file-size nar-hash nar-size
- references deriver system signature contents)
+ references deriver system ipfs signature contents)
narinfo?
(path narinfo-path)
(uri narinfo-uri)
@@ -294,6 +295,7 @@ failure, return #f and #f."
(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.
@@ -335,7 +337,7 @@ s-expression: ~s~%")
"Return a narinfo constructor for narinfos originating from CACHE-URL. STR
must contain the original contents of a narinfo file."
(lambda (path url compression file-hash file-size nar-hash nar-size
- references deriver system signature)
+ references deriver system ipfs signature)
"Return a new <narinfo> object."
(%make-narinfo path
;; Handle the case where URL is a relative URL.
@@ -352,6 +354,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)))
@@ -386,7 +389,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"))))
(define (narinfo-sha256 narinfo)
@@ -947,13 +950,58 @@ authorized substitutes."
(wtf
(error "unknown `--query' command" wtf))))
+(define* (process-substitution/http narinfo destination uri
+ #: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* ((comp (narinfo-compression narinfo))
+ (dl-size (or download-size
+ (and (equal? comp "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 (and=> (narinfo-compression narinfo)
+ string->symbol)
+ 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
DESTINATION as a nar file. Verify the substitute against ACL."
(let* ((narinfo (lookup-narinfo cache-urls store-item
(cut valid-narinfo? <> acl)))
- (uri (and=> narinfo narinfo-uri)))
+ (uri (and=> narinfo narinfo-uri))
+ (ipfs (and=> narinfo narinfo-ipfs)))
(unless uri
(leave (G_ "no valid substitute for '~a'~%")
store-item))
@@ -961,47 +1009,15 @@ DESTINATION as a nar file. Verify the substitute against ACL."
;; 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* ((comp (narinfo-compression narinfo))
- (dl-size (or download-size
- (and (equal? comp "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 (and=> (narinfo-compression narinfo)
- string->symbol)
- 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)))))
+ (if ipfs
+ (begin
+ (unless print-build-trace?
+ (format (current-error-port)
+ (G_ "Downloading from IPFS ~s...~%") ipfs))
+ (ipfs:restore-file-tree ipfs destination))
+ (process-substitution/http narinfo destination uri
+ #:print-build-trace?
+ print-build-trace?))))
\f
;;;
--
2.20.1
next prev parent reply other threads:[~2018-12-28 23:34 UTC|newest]
Thread overview: 23+ messages / expand[flat|nested] mbox.gz Atom feed top
2018-12-28 23:12 [bug#33899] [PATCH 0/5] Distributing substitutes over IPFS Ludovic Courtès
2018-12-28 23:15 ` [bug#33899] [PATCH 1/5] Add (guix json) Ludovic Courtès
2018-12-28 23:15 ` [bug#33899] [PATCH 2/5] tests: 'file=?' now recurses on directories Ludovic Courtès
2018-12-28 23:15 ` [bug#33899] [PATCH 3/5] Add (guix ipfs) Ludovic Courtès
2018-12-28 23:15 ` [bug#33899] [PATCH 4/5] publish: Add IPFS support Ludovic Courtès
2018-12-28 23:15 ` Ludovic Courtès [this message]
2019-01-07 14:43 ` [bug#33899] [PATCH 0/5] Distributing substitutes over IPFS Hector Sanjuan
2019-01-14 13:17 ` Ludovic Courtès
2019-01-18 9:08 ` Hector Sanjuan
2019-01-18 9:52 ` Ludovic Courtès
2019-01-18 11:26 ` Hector Sanjuan
2019-07-01 21:36 ` Pierre Neidhardt
2019-07-06 8:44 ` Pierre Neidhardt
2019-07-12 20:02 ` Molly Mackinlay
2019-07-15 9:20 ` Alex Potsides
2019-07-12 20:15 ` Ludovic Courtès
2019-07-14 22:31 ` Hector Sanjuan
2019-07-15 9:24 ` Ludovic Courtès
2019-07-15 10:10 ` Pierre Neidhardt
2019-07-15 10:21 ` Hector Sanjuan
2019-05-13 18:51 ` Alex Griffin
2020-12-29 9:59 ` [bug#33899] Ludo's patch rebased on master Maxime Devos
2021-06-06 17:54 ` [bug#33899] [PATCH 0/5] Distributing substitutes over IPFS Tony Olagbaiye
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=20181228231554.8220-5-ludo@gnu.org \
--to=ludo@gnu.org \
--cc=33899@debbugs.gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/guix.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.