mirror/guix
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/guix.git synced 2025-01-31 06:46:50 +01:00
Code Issues Projects Releases Packages Wiki Activity Actions

DRAFT substitute: Add IPFS support.

Browse source 
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
1 changed files with 61 additions and 45 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

52
guix/scripts/substitute.scm
View file

@ -42,6 +42,7 @@ (define-module (guix scripts substitute)
#: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 @@ (define (read-cache-info port)
(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 @@ (define-record-type <narinfo>
(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 @@ (define (narinfo-maker str cache-url)
"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 @@ (define (narinfo-maker str cache-url)
((or #f "") #f)
(_ deriver))
system
ipfs
(false-if-exception
(and=> signature narinfo-signature->canonical-sexp))
str)))
@ -386,7 +389,7 @@ (define* (read-narinfo port #:optional url
(narinfo-maker str url)
'("StorePath" "URL" "Compression"
"FileHash" "FileSize" "NarHash" "NarSize"
"References" "Deriver" "System"
"References" "Deriver" "System" "IPFS"
"Signature"))))
(define (narinfo-sha256 narinfo)
@ -947,20 +950,8 @@ (define (valid? obj)
(wtf
(error "unknown `--query' command" wtf))))
(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)))
(unless uri
(leave (G_ "no valid substitute for '~a'~%")
store-item))
;; Tell the daemon what the expected hash of the Nar itself is.
(format #t "~a~%" (narinfo-hash narinfo))
(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)))
@ -1001,7 +992,32 @@ (define* (process-substitution store-item destination
;; Skip a line after what 'progress-reporter/file' printed, and another
;; one to visually separate substitutions.
(display "\n\n" (current-error-port)))))
(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))
(ipfs (and=> narinfo narinfo-ipfs)))
(unless uri
(leave (G_ "no valid substitute for '~a'~%")
store-item))
;; 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))
(process-substitution/http narinfo destination uri
#:print-build-trace?
print-build-trace?))))
;;;