Package: guix-patches;
Reported by: pukkamustard <pukkamustard <at> posteo.net>
Date: Thu, 16 Dec 2021 16:18:02 UTC
Severity: important
Tags: patch
View this message in rfc822 format
From: pukkamustard <pukkamustard <at> posteo.net> To: 52555 <at> debbugs.gnu.org Cc: pukkamustard <pukkamustard <at> posteo.net>, ~pukkamustard/eris <at> lists.sr.ht Subject: [bug#52555] [RFC PATCH 3/3] publish: Add IPFS support. Date: Thu, 16 Dec 2021 16:20:36 +0000
* guix/scripts/publish.scm: (show-help, %options): Add '--ipfs'.
(render-narinfo/cached, bake-narinfo+nar, make-request-handler, run-publish-server): Add #:ipfs? and honor it.
(guix-publish): Honor '--ipfs' and parameterize %ipfs-base-url.
---
guix/scripts/publish.scm | 52 +++++++++++++++++++++++++++++++---------
1 file changed, 41 insertions(+), 11 deletions(-)
diff --git a/guix/scripts/publish.scm b/guix/scripts/publish.scm
index 8e4b90789b..8e7fb47b9e 100644
--- a/guix/scripts/publish.scm
+++ b/guix/scripts/publish.scm
@@ -41,6 +41,8 @@ (define-module (guix scripts publish)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-37)
+ #:use-module (srfi srfi-71)
+ #:use-module (srfi srfi-171)
#:use-module (web http)
#:use-module (web request)
#:use-module (web response)
@@ -52,6 +54,7 @@ (define-module (guix scripts publish)
#:use-module (guix base64)
#:use-module (guix config)
#:use-module (guix derivations)
+ #:use-module ((guix ipfs) #:prefix ipfs:)
#:use-module (gcrypt hash)
#:use-module (guix pki)
#:use-module (gcrypt pk-crypto)
@@ -59,6 +62,8 @@ (define-module (guix scripts publish)
#:use-module (guix store)
#:use-module ((guix serialization) #:select (write-file))
#:use-module (eris)
+ #:use-module (eris read-capability)
+ #:use-module (eris blocks ipfs)
#:use-module (zlib)
#:autoload (lzlib) (call-with-lzip-output-port
make-lzip-output-port)
@@ -83,6 +88,7 @@ (define-module (guix scripts publish)
run-publish-server
guix-publish))
+
(define (show-help)
(format #t (G_ "Usage: guix publish [OPTION]...
Publish ~a over HTTP.\n") %store-directory)
@@ -102,6 +108,8 @@ (define (show-help)
(display (G_ "
--cache-bypass-threshold=SIZE
serve store items below SIZE even when not cached"))
+ (display (G_ "
+ --ipfs[=GATEWAY] publish items over IPFS via GATEWAY"))
(display (G_ "
--workers=N use N workers to bake items"))
(display (G_ "
@@ -220,6 +228,10 @@ (define %options
(lambda (opt name arg result)
(alist-cons 'cache-bypass-threshold (size->number 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)
@@ -526,7 +538,7 @@ (define (bypass-cache? store item)
(define* (render-narinfo/cached store request hash
#:key ttl (compressions (list %no-compression))
(nar-path "nar") negative-ttl
- 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."
@@ -571,7 +583,8 @@ (define (delete-entry narinfo)
(bake-narinfo+nar cache item
#:ttl ttl
#:compressions compressions
- #:nar-path nar-path)))
+ #:nar-path nar-path
+ #:ipfs? ipfs?)))
(when ttl
(single-baker 'cache-cleanup
@@ -631,7 +644,7 @@ (define (write-compressed-file call-with-compressed-output-port)
(define* (bake-narinfo+nar cache item
#:key ttl (compressions (list %no-compression))
- (nar-path "/nar"))
+ (nar-path "/nar") ipfs?)
"Write the narinfo and nar for ITEM to CACHE."
(define (compressed-nar-size compression)
(let* ((nar (nar-cache-file cache item #:compression compression))
@@ -641,9 +654,19 @@ (define (compressed-nar-size compression)
(define (compressed-eris-urn compression)
(let* ((nar (nar-cache-file cache item #:compression compression))
- (stat (stat nar #f)))
+ (stat (stat nar #f))
+ (block-reducer (if ipfs?
+ (eris-blocks-ipfs-reducer
+ #:ipfs-base-url (ipfs:%ipfs-base-url))
+ rcount)))
(and stat
- (cons compression (call-with-input-file nar eris-encode->urn)))))
+ (cons compression
+ (call-with-input-file nar
+ (lambda (port)
+ (let ((read-cap _
+ (eris-encode port #:block-reducer
+ block-reducer)))
+ (read-capability->string read-cap))))))))
(let ((compression (actual-compressions item compressions)))
@@ -1115,7 +1138,8 @@ (define* (make-request-handler store
cache pool
narinfo-ttl narinfo-negative-ttl
(nar-path "nar")
- (compressions (list %no-compression)))
+ (compressions (list %no-compression))
+ ipfs?)
(define compression-type?
string->compression-type)
@@ -1147,7 +1171,8 @@ (define (handle request body)
#:ttl narinfo-ttl
#:negative-ttl narinfo-negative-ttl
#:nar-path nar-path
- #:compressions compressions)
+ #:compressions compressions
+ #:ipfs? ipfs?)
(render-narinfo store request hash
#:ttl narinfo-ttl
#:negative-ttl narinfo-negative-ttl
@@ -1218,7 +1243,7 @@ (define* (run-publish-server socket store
advertise? port
(compressions (list %no-compression))
(nar-path "nar") narinfo-ttl narinfo-negative-ttl
- cache pool)
+ cache pool ipfs?)
(when advertise?
(let ((name (service-name)))
;; XXX: Use a callback from Guile-Avahi here, as Avahi can pick a
@@ -1234,7 +1259,8 @@ (define* (run-publish-server socket store
#:nar-path nar-path
#:narinfo-ttl narinfo-ttl
#:narinfo-negative-ttl narinfo-negative-ttl
- #:compressions compressions)
+ #:compressions compressions
+ #:ipfs? ipfs?)
concurrent-http-server
`(#:socket ,socket)))
@@ -1296,6 +1322,8 @@ (define-command (guix-publish . args)
(repl-port (assoc-ref opts 'repl))
(cache (assoc-ref opts 'cache))
(workers (assoc-ref opts 'workers))
+ (ipfs (assoc-ref opts 'ipfs))
+ (ipfs? (if ipfs #t #f))
;; 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.
@@ -1315,7 +1343,8 @@ (define-command (guix-publish . args)
(%private-key private-key)
(cache-bypass-threshold
(or (assoc-ref opts 'cache-bypass-threshold)
- (cache-bypass-threshold))))
+ (cache-bypass-threshold)))
+ (ipfs:%ipfs-base-url ipfs))
(info (G_ "publishing ~a on ~a, port ~d~%")
%store-directory
(inet-ntop (sockaddr:fam address) (sockaddr:addr address))
@@ -1344,7 +1373,8 @@ (define-command (guix-publish . args)
#:nar-path nar-path
#:compressions compressions
#:narinfo-negative-ttl negative-ttl
- #:narinfo-ttl ttl))))))
+ #:narinfo-ttl ttl
+ #:ipfs? ipfs?))))))
;;; Local Variables:
;;; eval: (put 'single-baker 'scheme-indent-function 1)
--
2.34.0
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.