mirror of
https://git.savannah.gnu.org/git/guix.git
synced 2025-01-18 21:46:35 +01:00
publish: Add IPFS support.
* guix/scripts/publish.scm (show-help, %options): Add '--ipfs'. (narinfo-string): Add IPFS parameter and honor it. (render-narinfo/cached): Add #:ipfs? and honor it. (bake-narinfo+nar, make-request-handler, run-publish-server): Likewise. (guix-publish): Honor '--ipfs' and parameterize %IPFS-BASE-URL.
This commit is contained in:
Ludovic Courtès
parent
b900520019
commit
5fdb66f176
2 changed files with 80 additions and 20 deletions
|
|
@ -8470,6 +8470,15 @@ caching of the archives before they are sent to clients---see below for
|
|||
details. The @command{guix weather} command provides a handy way to
|
||||
check what a server provides (@pxref{Invoking guix weather}).
|
||||
|
||||
@cindex peer-to-peer, substitute distribution
|
||||
@cindex distributed storage, of substitutes
|
||||
@cindex IPFS, for substitutes
|
||||
It is also possible to publish substitutes over @uref{https://ipfs.io, IFPS},
|
||||
a distributed, peer-to-peer storage mechanism. To enable it, pass the
|
||||
@option{--ipfs} option alongside @option{--cache}, and make sure you're
|
||||
running @command{ipfs daemon}. Capable clients will then be able to choose
|
||||
whether to fetch substitutes over HTTP or over IPFS.
|
||||
|
||||
As a bonus, @command{guix publish} also serves as a content-addressed
|
||||
mirror for source files referenced in @code{origin} records
|
||||
(@pxref{origin Reference}). For instance, assuming @command{guix
|
||||
|
|
@ -8560,6 +8569,30 @@ thread per CPU core is created, but this can be customized. See
|
|||
When @option{--ttl} is used, cached entries are automatically deleted
|
||||
when they have expired.
|
||||
|
||||
@item --ifps[=@var{gateway}]
|
||||
When used in conjunction with @option{--cache}, instruct @command{guix
|
||||
publish} to publish substitutes over the @uref{https://ipfs.io, IPFS
|
||||
distributed data store} in addition to HTTP.
|
||||
|
||||
@quotation Note
|
||||
As of version @value{VERSION}, IPFS support is experimental. You're welcome
|
||||
to share your experience with the developers by emailing
|
||||
@email{guix-devel@@gnu.org}!
|
||||
@end quotation
|
||||
|
||||
The IPFS HTTP interface must be reachable at @var{gateway}, by default
|
||||
@code{localhost:5001}. To get it up and running, it is usually enough to
|
||||
install IPFS and start the IPFS daemon:
|
||||
|
||||
@example
|
||||
$ guix package -i go-ipfs
|
||||
$ ipfs init
|
||||
$ ipfs daemon
|
||||
@end example
|
||||
|
||||
For more information on how to get started with IPFS, please refer to the
|
||||
@uref{https://docs.ipfs.io/introduction/usage/, IPFS documentation}.
|
||||
|
||||
@item --workers=@var{N}
|
||||
When @option{--cache} is used, request the allocation of @var{N} worker
|
||||
threads to ``bake'' archives.
|
||||
|
|
|
|||
|
|
@ -59,6 +59,7 @@ (define-module (guix scripts publish)
|
|||
#:use-module ((guix build utils)
|
||||
#:select (dump-port mkdir-p find-files))
|
||||
#:use-module ((guix build syscalls) #:select (set-thread-name))
|
||||
#:use-module ((guix ipfs) #:prefix ipfs:)
|
||||
#:export (%public-key
|
||||
%private-key
|
||||
|
||||
|
|
@ -78,6 +79,8 @@ (define (show-help)
|
|||
compress archives at LEVEL"))
|
||||
(display (G_ "
|
||||
-c, --cache=DIRECTORY cache published items to DIRECTORY"))
|
||||
(display (G_ "
|
||||
--ipfs[=GATEWAY] publish items over IPFS via GATEWAY"))
|
||||
(display (G_ "
|
||||
--workers=N use N workers to bake items"))
|
||||
(display (G_ "
|
||||
|
|
@ -168,6 +171,10 @@ (define %options
|
|||
(option '(#\c "cache") #t #f
|
||||
(lambda (opt name arg result)
|
||||
(alist-cons 'cache arg result)))
|
||||
(option '("ipfs") #f #t
|
||||
(lambda (opt name arg result)
|
||||
(alist-cons 'ipfs (or arg (ipfs:%ipfs-base-url))
|
||||
result)))
|
||||
(option '("workers") #t #f
|
||||
(lambda (opt name arg result)
|
||||
(alist-cons 'workers (string->number* arg)
|
||||
|
|
@ -237,12 +244,15 @@ (define base64-encode-string
|
|||
|
||||
(define* (narinfo-string store store-path key
|
||||
#:key (compression %no-compression)
|
||||
(nar-path "nar") file-size)
|
||||
(nar-path "nar") file-size ipfs)
|
||||
"Generate a narinfo key/value string for STORE-PATH; an exception is raised
|
||||
if STORE-PATH is invalid. Produce a URL that corresponds to COMPRESSION. The
|
||||
narinfo is signed with KEY. NAR-PATH specifies the prefix for nar URLs.
|
||||
|
||||
Optionally, FILE-SIZE can specify the size in bytes of the compressed NAR; it
|
||||
informs the client of how much needs to be downloaded."
|
||||
informs the client of how much needs to be downloaded.
|
||||
|
||||
When IPFS is true, it is the IPFS object identifier for STORE-PATH."
|
||||
(let* ((path-info (query-path-info store store-path))
|
||||
(compression (actual-compression store-path compression))
|
||||
(url (encode-and-join-uri-path
|
||||
|
|
@ -295,7 +305,12 @@ (define* (narinfo-string store store-path key
|
|||
(apply throw args))))))
|
||||
(signature (base64-encode-string
|
||||
(canonical-sexp->string (signed-string info)))))
|
||||
(format #f "~aSignature: 1;~a;~a~%" info (gethostname) signature)))
|
||||
(format #f "~aSignature: 1;~a;~a~%~a" info (gethostname) signature
|
||||
|
||||
;; Append IPFS info below the signed part.
|
||||
(if ipfs
|
||||
(string-append "IPFS: " ipfs "\n")
|
||||
""))))
|
||||
|
||||
(define* (not-found request
|
||||
#:key (phrase "Resource not found")
|
||||
|
|
@ -406,10 +421,12 @@ (define (nar-expiration-time ttl)
|
|||
(define* (render-narinfo/cached store request hash
|
||||
#:key ttl (compression %no-compression)
|
||||
(nar-path "nar")
|
||||
cache pool)
|
||||
cache pool ipfs?)
|
||||
"Respond to the narinfo request for REQUEST. If the narinfo is available in
|
||||
CACHE, then send it; otherwise, return 404 and \"bake\" that nar and narinfo
|
||||
requested using POOL."
|
||||
requested using POOL.
|
||||
|
||||
When IPFS? is true, additionally publish binaries over IPFS."
|
||||
(define (delete-entry narinfo)
|
||||
;; Delete NARINFO and the corresponding nar from CACHE.
|
||||
(let ((nar (string-append (string-drop-right narinfo
|
||||
|
|
@ -447,7 +464,8 @@ (define (delete-entry narinfo)
|
|||
(bake-narinfo+nar cache item
|
||||
#:ttl ttl
|
||||
#:compression compression
|
||||
#:nar-path nar-path)))
|
||||
#:nar-path nar-path
|
||||
#:ipfs? ipfs?)))
|
||||
|
||||
(when ttl
|
||||
(single-baker 'cache-cleanup
|
||||
|
|
@ -465,7 +483,7 @@ (define (delete-entry narinfo)
|
|||
|
||||
(define* (bake-narinfo+nar cache item
|
||||
#:key ttl (compression %no-compression)
|
||||
(nar-path "/nar"))
|
||||
(nar-path "/nar") ipfs?)
|
||||
"Write the narinfo and nar for ITEM to CACHE."
|
||||
(let* ((compression (actual-compression item compression))
|
||||
(nar (nar-cache-file cache item
|
||||
|
|
@ -502,7 +520,11 @@ (define* (bake-narinfo+nar cache item
|
|||
#:nar-path nar-path
|
||||
#:compression compression
|
||||
#:file-size (and=> (stat nar #f)
|
||||
stat:size))
|
||||
stat:size)
|
||||
#:ipfs
|
||||
(and ipfs?
|
||||
(ipfs:content-name
|
||||
(ipfs:add-file-tree item))))
|
||||
port))))))
|
||||
|
||||
;; XXX: Declare the 'X-Nar-Compression' HTTP header, which is in fact for
|
||||
|
|
@ -766,7 +788,8 @@ (define* (make-request-handler store
|
|||
cache pool
|
||||
narinfo-ttl
|
||||
(nar-path "nar")
|
||||
(compression %no-compression))
|
||||
(compression %no-compression)
|
||||
ipfs?)
|
||||
(define nar-path?
|
||||
(let ((expected (split-and-decode-uri-path nar-path)))
|
||||
(cut equal? expected <>)))
|
||||
|
|
@ -793,7 +816,8 @@ (define nar-path?
|
|||
#:pool pool
|
||||
#:ttl narinfo-ttl
|
||||
#:nar-path nar-path
|
||||
#:compression compression)
|
||||
#:compression compression
|
||||
#:ipfs? ipfs?)
|
||||
(render-narinfo store request hash
|
||||
#:ttl narinfo-ttl
|
||||
#:nar-path nar-path
|
||||
|
|
@ -847,13 +871,14 @@ (define nar-path?
|
|||
(define* (run-publish-server socket store
|
||||
#:key (compression %no-compression)
|
||||
(nar-path "nar") narinfo-ttl
|
||||
cache pool)
|
||||
cache pool ipfs?)
|
||||
(run-server (make-request-handler store
|
||||
#:cache cache
|
||||
#:pool pool
|
||||
#:nar-path nar-path
|
||||
#:narinfo-ttl narinfo-ttl
|
||||
#:compression compression)
|
||||
#:compression compression
|
||||
#:ipfs? ipfs?)
|
||||
concurrent-http-server
|
||||
`(#:socket ,socket)))
|
||||
|
||||
|
|
@ -902,6 +927,7 @@ (define (guix-publish . args)
|
|||
(repl-port (assoc-ref opts 'repl))
|
||||
(cache (assoc-ref opts 'cache))
|
||||
(workers (assoc-ref opts 'workers))
|
||||
(ipfs (assoc-ref opts 'ipfs))
|
||||
|
||||
;; Read the key right away so that (1) we fail early on if we can't
|
||||
;; access them, and (2) we can then drop privileges.
|
||||
|
|
@ -930,14 +956,15 @@ (define (guix-publish . args)
|
|||
(set-thread-name "guix publish")
|
||||
|
||||
(with-store store
|
||||
(run-publish-server socket store
|
||||
#:cache cache
|
||||
#:pool (and cache (make-pool workers
|
||||
#:thread-name
|
||||
"publish worker"))
|
||||
#:nar-path nar-path
|
||||
#:compression compression
|
||||
#:narinfo-ttl ttl))))))
|
||||
(parameterize ((ipfs:%ipfs-base-url ipfs))
|
||||
(run-publish-server socket store
|
||||
#:cache cache
|
||||
#:pool (and cache (make-pool workers
|
||||
#:thread-name
|
||||
"publish worker"))
|
||||
#:nar-path nar-path
|
||||
#:compression compression
|
||||
#:narinfo-ttl ttl)))))))
|
||||
|
||||
;;; Local Variables:
|
||||
;;; eval: (put 'single-baker 'scheme-indent-function 1)
|
||||
|
|
|
|||
Loading…
Reference in a new issue