* [bug#46214] [PATCH] DRAFT: narinfo hooks for ‘guix publish’
@ 2021-01-31 11:11 Maxime Devos
2021-02-01 20:17 ` Maxime Devos
2021-02-01 22:22 ` Jonathan Brielmaier
0 siblings, 2 replies; 4+ messages in thread
From: Maxime Devos @ 2021-01-31 11:11 UTC (permalink / raw)
To: 46214
[-- Attachment #1.1: Type: text/plain, Size: 2195 bytes --]
Hello Guix!
I've a proposal to make ‘guix publish’ somewhat extensible.
The draft patch allows for passing a list of ‘hooks’ to guix
publish, with "guix publish --hooks=FILE-WITH-HOOKS.scm
--hooks=MORE-HOOKS.go". "guix publish" then will consult
this list of hooks at some points.
I've defined a ‘narinfo-hook’, which allows adding extra
key value pairs to the generated narinfos. See the last
patch that adds a ‘hook.scm’ file for a silly example
that includes a random number and some arbitrary strings.
A TODO for a future revision of the patch, is modifying
‘guix-publish-service-type’ to allow passing a list of
hooks (as gexps).
The use case I had in mind: this could be used for Guix+IPFS
and Guix+GNUnet integration (at least on the "guix publish"
side), by implementing a hook that inserts the store item
into IPFS and GNUnet respectively, and add an appropriate
IPFS and GNUnet URI.
(I'll look into appropriate "guix substitute" hooks
later.)
Guix+IPFS and Guix+GNUnet integrations could of course
use a forked guix (until the integration is merged
upstream when it is in a good state), but a hook system
seems more practical for experimentation to me.
(Also, if hypothetically, in the future "guix publish" supports,
say, IPFS, GNUnet, BitTorrent and Dat, then using the approach
of wip-ipfs-substitutes, there would be four keyword
arguments that need to be passed everywhere. This patch
only passes a single #:hooks argument.)
Also a question for guix-devel: the wip-ipfs-substitutes
patch adds the "IPFS: etcetera" line *after* the signed
part, while this patch only allows for addings key-value
pairs that will be signed. Would it be problematic for
the "IPFS: etcetera" or "GNUnet: etcetera" line to be
signed?
If this proposal seems OK to guix-devel, I'll write up
some documentation, tests and changes to
guix-publish-service-type.
(Patch can also be found as signed tag wip-publish-narinfo-hook0
at https://notabug.org/mdevos/guix-gnunet.)
Greetings,
Maxime
--
Maxime Devos <maximedevos@telenet.be>
PGP Key: C1F3 3EE2 0C52 8FDB 7DD7 011F 49E3 EE22 1917 25EE
Freenode handle: mdevos
[-- Attachment #1.2: 0001-DRAFT-Support-hooks-for-adding-extra-entries-to-the-.patch --]
[-- Type: text/x-patch, Size: 14068 bytes --]
From 9ada791f1eecb68a850d5526ca511b1ad0c20e87 Mon Sep 17 00:00:00 2001
From: Maxime Devos <maximedevos@telenet.be>
Date: Sun, 31 Jan 2021 10:57:23 +0100
Subject: [PATCH 1/2] DRAFT: Support hooks for adding extra entries to the
narinfo
TODO: documentation, perhaps a news channel entry,
a service extension for guix-publish and tests.
* guix/scripts/publish.scm
(show-help, %options): Add '--hooks' option.
(narinfo-string, render-narinfo, make-request-handler)
(render-narinfo/cached, bake-narinfo+nar)
(run-publish-server): Add '#:hooks' argument.
(render-narinfo): Ask 'hooks-info' for extra narinfo
key-value pairs.
(guix-publish): Loading narinfo hooks with 'load-hooks'.
(<narinfo-hook>): New record type for narinfo hooks.
(load-hooks): New procedure loading hooks from source,
or from compiled .go.
(hooks-info): New procedure, asking each hook for extra
key-vaue pairs.
---
guix/scripts/publish.scm | 106 ++++++++++++++++++++++++++++++++++-----
1 file changed, 94 insertions(+), 12 deletions(-)
diff --git a/guix/scripts/publish.scm b/guix/scripts/publish.scm
index fa85088ed0..a9018d3fde 100644
--- a/guix/scripts/publish.scm
+++ b/guix/scripts/publish.scm
@@ -3,6 +3,7 @@
;;; Copyright © 2020 by Amar M. Singh <nly@disroot.org>
;;; Copyright © 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2020 Maxim Cournoyer <maxim.cournoyer@gmail.com>
+;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -47,6 +48,7 @@
#:use-module (guix base64)
#:use-module (guix config)
#:use-module (guix derivations)
+ #:use-module (guix records)
#:use-module (gcrypt hash)
#:use-module (guix pki)
#:use-module (gcrypt pk-crypto)
@@ -75,7 +77,11 @@
open-server-socket
publish-service-type
run-publish-server
- guix-publish))
+ guix-publish
+
+ narinfo-hook
+ narinfo-hook?
+ narinfo-hook-extra-info))
(define (show-help)
(format #t (G_ "Usage: guix publish [OPTION]...
@@ -108,6 +114,8 @@ Publish ~a over HTTP.\n") %store-directory)
--private-key=FILE use FILE as the private key for signatures"))
(display (G_ "
-r, --repl[=PORT] spawn REPL server on PORT"))
+ (display (G_"
+ --hooks=FILE.go load hooks from FILE.go"))
(newline)
(display (G_ "
-h, --help display this help and exit"))
@@ -236,7 +244,10 @@ usage."
(lambda (opt name arg result)
;; If port unspecified, use default Guile REPL port.
(let ((port (and arg (string->number* arg))))
- (alist-cons 'repl (or port 37146) result))))))
+ (alist-cons 'repl (or port 37146) result))))
+ (option '("hooks") #f #t
+ (lambda (opt name arg result)
+ (alist-cons 'hook arg result)))))
(define %default-options
`((port . 8080)
@@ -309,7 +320,9 @@ with COMPRESSION, starting at NAR-PATH."
url (compression-type compression) file-size)))
(define* (narinfo-string store store-path key
- #:key (compressions (list %no-compression))
+ #:key
+ (hooks '())
+ (compressions (list %no-compression))
(nar-path "nar") (file-sizes '()))
"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
@@ -317,7 +330,10 @@ narinfo is signed with KEY. NAR-PATH specifies the prefix for nar URLs.
Optionally, FILE-SIZES is a list of compression/integer pairs, where the
integer is size in bytes of the compressed NAR; it informs the client of how
-much needs to be downloaded."
+much needs to be downloaded.
+
+If present, each narinfo hooks in HOOKS is called and the resulting
+key/value pairs are added to the narinfo."
(let* ((path-info (query-path-info store store-path))
(compressions (actual-compressions store-path compressions))
(hash (bytevector->nix-base32-string
@@ -346,22 +362,24 @@ References: ~a~%"
compression)))
compressions)
hash size references))
+ (extra-info (hooks-info hooks path-info))
;; Do not render a "Deriver" or "System" line if we are rendering
;; info for a derivation.
(info (if (not deriver)
- base-info
+ (format #f "~a~a" base-info extra-info)
(catch 'system-error
(lambda ()
(let ((drv (read-derivation-from-file deriver)))
- (format #f "~aSystem: ~a~%Deriver: ~a~%"
- base-info (derivation-system drv)
+ (format #f "~a~aSystem: ~a~%Deriver: ~a~%"
+ base-info extra-info
+ (derivation-system drv)
(basename deriver))))
(lambda args
;; DERIVER might be missing, but that's fine:
;; it's only used for <substitutable> where it's
;; optional. 'System' is currently unused.
(if (= ENOENT (system-error-errno args))
- base-info
+ (format #f "~a~a" base-info extra-info)
(apply throw args))))))
(signature (base64-encode-string
(canonical-sexp->string (signed-string info)))))
@@ -388,7 +406,9 @@ References: ~a~%"
%nix-cache-info))))
(define* (render-narinfo store request hash
- #:key ttl (compressions (list %no-compression))
+ #:key
+ (hooks '())
+ ttl (compressions (list %no-compression))
(nar-path "nar"))
"Render metadata for the store path corresponding to HASH. If TTL is true,
advertise it as the maximum validity period (in seconds) via the
@@ -403,6 +423,7 @@ appropriate duration. NAR-PATH specifies the prefix for nar URLs."
'()))
(cut display
(narinfo-string store store-path (%private-key)
+ #:hooks hooks
#:nar-path nar-path
#:compressions compressions)
<>)))))
@@ -510,7 +531,9 @@ interpreted as the basename of a store item."
(cache-bypass-threshold))))
(define* (render-narinfo/cached store request hash
- #:key ttl (compressions (list %no-compression))
+ #:key
+ (hooks '())
+ ttl (compressions (list %no-compression))
(nar-path "nar")
cache pool)
"Respond to the narinfo request for REQUEST. If the narinfo is available in
@@ -556,6 +579,7 @@ requested using POOL."
(unless (file-exists? cached)
;; (format #t "baking ~s~%" item)
(bake-narinfo+nar cache item
+ #:hooks hooks
#:ttl ttl
#:compressions compressions
#:nar-path nar-path)))
@@ -576,6 +600,7 @@ requested using POOL."
;; client asks for it.
(if (bypass-cache? store item)
(render-narinfo store request hash
+ #:hooks hooks
#:ttl 300 ;temporary
#:nar-path nar-path
#:compressions compressions)
@@ -617,7 +642,9 @@ requested using POOL."
(chmod port (logand #o644 (lognot (umask)))))))))
(define* (bake-narinfo+nar cache item
- #:key ttl (compressions (list %no-compression))
+ #:key
+ (hooks '())
+ ttl (compressions (list %no-compression))
(nar-path "/nar"))
"Write the narinfo and nar for ITEM to CACHE."
(define (compressed-nar-size compression)
@@ -643,6 +670,7 @@ requested using POOL."
(let ((sizes (filter-map compressed-nar-size compression)))
(display (narinfo-string store item
(%private-key)
+ #:hooks hooks
#:nar-path nar-path
#:compressions compressions
#:file-sizes sizes)
@@ -972,6 +1000,7 @@ methods, return the applicable compression."
(define* (make-request-handler store
#:key
+ (hooks '())
cache pool
narinfo-ttl
(nar-path "nar")
@@ -1002,12 +1031,14 @@ methods, return the applicable compression."
(((= extract-narinfo-hash (? string? hash)))
(if cache
(render-narinfo/cached store request hash
+ #:hooks hooks
#:cache cache
#:pool pool
#:ttl narinfo-ttl
#:nar-path nar-path
#:compressions compressions)
(render-narinfo store request hash
+ #:hooks hooks
#:ttl narinfo-ttl
#:nar-path nar-path
#:compressions compressions)))
@@ -1065,6 +1096,7 @@ methods, return the applicable compression."
(define* (run-publish-server socket store
#:key
+ (hooks '())
advertise? port
(compressions (list %no-compression))
(nar-path "nar") narinfo-ttl
@@ -1079,6 +1111,7 @@ methods, return the applicable compression."
#:port port)))
(run-server (make-request-handler store
+ #:hooks hooks
#:cache cache
#:pool pool
#:nar-path nar-path
@@ -1106,6 +1139,49 @@ methods, return the applicable compression."
(lambda (key proc message args . rest)
(leave (G_ "user '~a' not found: ~a~%")
user (apply format #f message args)))))
+\f
+;;;
+;;; Hooks.
+;;;
+
+;; Hook for adding extra key-value pairs to
+;; the generated narinfo.
+(define-record-type <narinfo-hook>
+ (narinfo-hook extra-info)
+ narinfo-hook?
+ ;; pathinfo -> alist. Should accept
+ ;; rest arguments for future extensibility.
+ (extra-info narinfo-hook-extra-info))
+
+(define (load-hooks hook-file)
+ "Load hooks from HOOK-FILE. The code in HOOK-FILE
+must evaluate to a list of hooks."
+ (let ((hooks
+ (cond ((string-suffix? ".go" hook-file) ; compiled
+ (load-compiled hook-file))
+ ((string-suffix? ".scm" hook-file) ; source code
+ (load hook-file))
+ (#t (leave (G_ "file '~a' is not a Scheme file~%")
+ hook-file)))))
+ ;; Validate whether @var{hooks} are, in fact, hooks.
+ (for-each (lambda (hook)
+ (unless (narinfo-hook? hook)
+ (leave (G_ "'~a' is not a hook~%")
+ hook)))
+ hooks)
+ hooks))
+
+(define (hooks-info hooks pathinfo)
+ "Ask HOOKS for extra narinfo key/value pairs."
+ (let ((alist
+ (append-map (lambda (hook) ((narinfo-hook-extra-info hook) pathinfo))
+ hooks)))
+ (call-with-output-string
+ (lambda (port)
+ (for-each (lambda (key+value)
+ (format port "~a: ~a~%"
+ (car key+value) (cdr key+value)))
+ alist)))))
\f
;;;
@@ -1149,8 +1225,13 @@ methods, return the applicable compression."
;; 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.
(public-key (read-file-sexp (assoc-ref opts 'public-key-file)))
- (private-key (read-file-sexp (assoc-ref opts 'private-key-file))))
+ (private-key (read-file-sexp (assoc-ref opts 'private-key-file)))
+ (hooks (concatenate (filter-map (match-lambda
+ (('hook . hook-file)
+ (load-hooks hook-file))
+ (_ #f))
+ opts))))
(when user
;; Now that we've read the key material and opened the socket, we can
;; drop privileges.
@@ -1185,6 +1266,7 @@ consider using the '--user' option!~%")))
(with-store store
(run-publish-server socket store
#:advertise? advertise?
+ #:hooks hooks
#:port port
#:cache cache
#:pool (and cache (make-pool workers
--
2.30.0
[-- Attachment #1.3: 0002-DRAFT-add-hook-example.patch --]
[-- Type: text/x-patch, Size: 1562 bytes --]
From 61c681cbe0b29b31587e71a905f34f0f12757a13 Mon Sep 17 00:00:00 2001
From: Maxime Devos <maximedevos@telenet.be>
Date: Sun, 31 Jan 2021 11:06:46 +0100
Subject: [PATCH 2/2] DRAFT: add hook example
TODO: should be located elsewere.
---
hook.scm | 27 +++++++++++++++++++++++++++
1 file changed, 27 insertions(+)
create mode 100644 hook.scm
diff --git a/hook.scm b/hook.scm
new file mode 100644
index 0000000000..7b81c8d761
--- /dev/null
+++ b/hook.scm
@@ -0,0 +1,27 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
+(use-modules (guix scripts publish))
+
+(list
+ (narinfo-hook
+ (lambda (pathinfo . rest)
+ `(("LuckyNumber" . ,(random 1000))
+ ("Stuff" . ,(object->string pathinfo)))))
+ (narinfo-hook
+ (lambda (pathinfo . rest)
+ `(("Cool" . "Beans")))))
--
2.30.0
[-- Attachment #2: This is a digitally signed message part --]
[-- Type: application/pgp-signature, Size: 260 bytes --]
^ permalink raw reply related [flat|nested] 4+ messages in thread
* [bug#46214] [PATCH] DRAFT: narinfo hooks for ‘guix publish’
2021-01-31 11:11 [bug#46214] [PATCH] DRAFT: narinfo hooks for ‘guix publish’ Maxime Devos
@ 2021-02-01 20:17 ` Maxime Devos
2021-02-01 22:22 ` Jonathan Brielmaier
1 sibling, 0 replies; 4+ messages in thread
From: Maxime Devos @ 2021-02-01 20:17 UTC (permalink / raw)
To: 46214
[-- Attachment #1: Type: text/plain, Size: 174 bytes --]
I've began writing tests, will post all patches here
(hook code, tests, service-extension code for
guix-publish-service-type and system tests) once
they are completed.
[-- Attachment #2: This is a digitally signed message part --]
[-- Type: application/pgp-signature, Size: 260 bytes --]
^ permalink raw reply [flat|nested] 4+ messages in thread
* [bug#46214] [PATCH] DRAFT: narinfo hooks for ‘guix publish’
2021-01-31 11:11 [bug#46214] [PATCH] DRAFT: narinfo hooks for ‘guix publish’ Maxime Devos
2021-02-01 20:17 ` Maxime Devos
@ 2021-02-01 22:22 ` Jonathan Brielmaier
2021-02-16 19:26 ` Maxime Devos
1 sibling, 1 reply; 4+ messages in thread
From: Jonathan Brielmaier @ 2021-02-01 22:22 UTC (permalink / raw)
To: 46214
On 31.01.21 12:11, Maxime Devos wrote:
> Hello Guix!
>
> I've a proposal to make ‘guix publish’ somewhat extensible.
> The draft patch allows for passing a list of ‘hooks’ to guix
> publish, with "guix publish --hooks=FILE-WITH-HOOKS.scm
> --hooks=MORE-HOOKS.go". "guix publish" then will consult
> this list of hooks at some points.
>
> I've defined a ‘narinfo-hook’, which allows adding extra
> key value pairs to the generated narinfos. See the last
> patch that adds a ‘hook.scm’ file for a silly example
> that includes a random number and some arbitrary strings.
I didn't looked really into the code, but would this also allow hooks
like baking the nar-file and write it into the cache? Or is it only for
the narinfos?
^ permalink raw reply [flat|nested] 4+ messages in thread
* [bug#46214] [PATCH] DRAFT: narinfo hooks for ‘guix publish’
2021-02-01 22:22 ` Jonathan Brielmaier
@ 2021-02-16 19:26 ` Maxime Devos
0 siblings, 0 replies; 4+ messages in thread
From: Maxime Devos @ 2021-02-16 19:26 UTC (permalink / raw)
To: Jonathan Brielmaier; +Cc: 46214
[-- Attachment #1: Type: text/plain, Size: 1207 bytes --]
Sorry for the late response, for some reason your mail didn't end
up in my inbox. A reminder for what my goal is: I am attempting
to serve substitutes via a P2P system. Ludovic has a patch
for substitutes over IPFS, myself I'm planning to write a patch
for substitutes over GNUnet. This patch aims to define a
simple ‘hook’ into ‘guix publish’ for adding the IPFS or GNUnet
URI.
On Mon, 2021-02-01 at 23:22 +0100, Jonathan Brielmaier wrote:
>
> On 31.01.21 12:11, Maxime Devos wrote:
> > [...]
> > I've defined a ‘narinfo-hook’, which allows adding extra
> > key value pairs to the generated narinfos. [...]
> I didn't looked really into the code, but would this also allow hooks
> like baking the nar-file and write it into the cache? Or is it only for
> the narinfos?
This patch is only for the generation of the narinfos.
(I would like to eventually write a hook that publishes
the store item via GNUnet and embeds the URI in the narinfo,
but there isn't yet a corresponding hook mechanism on
the substituter side.)
That said, other hook types could be defined with additional
patches, though I don't know what use that would serve.
Greetings,
Maxime.
[-- Attachment #2: This is a digitally signed message part --]
[-- Type: application/pgp-signature, Size: 260 bytes --]
^ permalink raw reply [flat|nested] 4+ messages in thread
end of thread, other threads:[~2021-02-16 19:27 UTC | newest]
Thread overview: 4+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2021-01-31 11:11 [bug#46214] [PATCH] DRAFT: narinfo hooks for ‘guix publish’ Maxime Devos
2021-02-01 20:17 ` Maxime Devos
2021-02-01 22:22 ` Jonathan Brielmaier
2021-02-16 19:26 ` Maxime Devos
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/guix.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).