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.
This commit is contained in:
Ludovic Courtès 2018-12-28 18:40:06 +01:00
parent 5fdb66f176
commit 79b0f72a9e
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5

View file

@ -42,6 +42,7 @@ (define-module (guix scripts substitute)
#:use-module (guix progress) #:use-module (guix progress)
#:use-module ((guix build syscalls) #:use-module ((guix build syscalls)
#:select (set-thread-name)) #:select (set-thread-name))
#:use-module ((guix ipfs) #:prefix ipfs:)
#:use-module (ice-9 rdelim) #:use-module (ice-9 rdelim)
#:use-module (ice-9 regex) #:use-module (ice-9 regex)
#:use-module (ice-9 match) #:use-module (ice-9 match)
@ -281,7 +282,7 @@ (define (read-cache-info port)
(define-record-type <narinfo> (define-record-type <narinfo>
(%make-narinfo path uri uri-base compression file-hash file-size nar-hash nar-size (%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? narinfo?
(path narinfo-path) (path narinfo-path)
(uri narinfo-uri) (uri narinfo-uri)
@ -294,6 +295,7 @@ (define-record-type <narinfo>
(references narinfo-references) (references narinfo-references)
(deriver narinfo-deriver) (deriver narinfo-deriver)
(system narinfo-system) (system narinfo-system)
(ipfs narinfo-ipfs)
(signature narinfo-signature) ; canonical sexp (signature narinfo-signature) ; canonical sexp
;; The original contents of a narinfo file. This field is needed because we ;; The original contents of a narinfo file. This field is needed because we
;; want to preserve the exact textual representation for verification purposes. ;; want to preserve the exact textual representation for verification purposes.
@ -335,7 +337,7 @@ (define (narinfo-maker str cache-url)
"Return a narinfo constructor for narinfos originating from CACHE-URL. STR "Return a narinfo constructor for narinfos originating from CACHE-URL. STR
must contain the original contents of a narinfo file." must contain the original contents of a narinfo file."
(lambda (path url compression file-hash file-size nar-hash nar-size (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." "Return a new <narinfo> object."
(%make-narinfo path (%make-narinfo path
;; Handle the case where URL is a relative URL. ;; Handle the case where URL is a relative URL.
@ -352,6 +354,7 @@ (define (narinfo-maker str cache-url)
((or #f "") #f) ((or #f "") #f)
(_ deriver)) (_ deriver))
system system
ipfs
(false-if-exception (false-if-exception
(and=> signature narinfo-signature->canonical-sexp)) (and=> signature narinfo-signature->canonical-sexp))
str))) str)))
@ -386,7 +389,7 @@ (define* (read-narinfo port #:optional url
(narinfo-maker str url) (narinfo-maker str url)
'("StorePath" "URL" "Compression" '("StorePath" "URL" "Compression"
"FileHash" "FileSize" "NarHash" "NarSize" "FileHash" "FileSize" "NarHash" "NarSize"
"References" "Deriver" "System" "References" "Deriver" "System" "IPFS"
"Signature")))) "Signature"))))
(define (narinfo-sha256 narinfo) (define (narinfo-sha256 narinfo)
@ -947,13 +950,58 @@ (define (valid? obj)
(wtf (wtf
(error "unknown `--query' command" 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 (define* (process-substitution store-item destination
#:key cache-urls acl print-build-trace?) #:key cache-urls acl print-build-trace?)
"Substitute STORE-ITEM (a store file name) from CACHE-URLS, and write it to "Substitute STORE-ITEM (a store file name) from CACHE-URLS, and write it to
DESTINATION as a nar file. Verify the substitute against ACL." DESTINATION as a nar file. Verify the substitute against ACL."
(let* ((narinfo (lookup-narinfo cache-urls store-item (let* ((narinfo (lookup-narinfo cache-urls store-item
(cut valid-narinfo? <> acl))) (cut valid-narinfo? <> acl)))
(uri (and=> narinfo narinfo-uri))) (uri (and=> narinfo narinfo-uri))
(ipfs (and=> narinfo narinfo-ipfs)))
(unless uri (unless uri
(leave (G_ "no valid substitute for '~a'~%") (leave (G_ "no valid substitute for '~a'~%")
store-item)) store-item))
@ -961,47 +1009,15 @@ (define* (process-substitution store-item destination
;; Tell the daemon what the expected hash of the Nar itself is. ;; Tell the daemon what the expected hash of the Nar itself is.
(format #t "~a~%" (narinfo-hash narinfo)) (format #t "~a~%" (narinfo-hash narinfo))
(unless print-build-trace? (if ipfs
(format (current-error-port) (begin
(G_ "Downloading ~a...~%") (uri->string uri))) (unless print-build-trace?
(format (current-error-port)
(let*-values (((raw download-size) (G_ "Downloading from IPFS ~s...~%") ipfs))
;; Note that Hydra currently generates Nars on the fly (ipfs:restore-file-tree ipfs destination))
;; and doesn't specify a Content-Length, so (process-substitution/http narinfo destination uri
;; DOWNLOAD-SIZE is #f in practice. #:print-build-trace?
(fetch uri #:buffered? #f #:timeout? #f)) print-build-trace?))))
((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)))))
;;; ;;;