[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[gnunet-scheme] 38/324: scripts: publish-store: publish whole trees
From: |
gnunet |
Subject: |
[gnunet-scheme] 38/324: scripts: publish-store: publish whole trees |
Date: |
Tue, 21 Sep 2021 13:21:18 +0200 |
This is an automated email from the git hooks/post-receive script.
maxime-devos pushed a commit to branch master
in repository gnunet-scheme.
commit e8d5af2b214c819ee57d395d231e351a684b46f1
Author: Maxime Devos <maximedevos@telenet.be>
AuthorDate: Sat Jan 23 17:39:24 2021 +0100
scripts: publish-store: publish whole trees
(Unverified) Collect all hashes of the regular files
in a JSON file, then publish the JSON. Much simpler
than using GNUnet's directory format, at cost of
not being able directly download via gnunet-download -r.
(Using gnunet-download -r seems problematic if the original
directory structure for publishing has a .gnd file)
This format is called ‘gnunet-nix-archive-json/0’.
* gnu/gnunet/scripts/publish-store.scm
(%help): correct format name
(main): likewise, and print a nice output message
(gnunet-publish): rename ‘noindex’ to ‘no-index’
(publish-sxml->json): new procedure, for publishing
a tree and returning the resulting JSON
(publish-nar): use publish-sxml->json
(sxml-data-files): remove obsolete procedure
---
gnu/gnunet/scripts/publish-store.scm | 84 +++++++++++++++++++++++++-----------
1 file changed, 58 insertions(+), 26 deletions(-)
diff --git a/gnu/gnunet/scripts/publish-store.scm
b/gnu/gnunet/scripts/publish-store.scm
index 9059506..656db13 100644
--- a/gnu/gnunet/scripts/publish-store.scm
+++ b/gnu/gnunet/scripts/publish-store.scm
@@ -28,6 +28,7 @@
(import (rnrs base)
(rnrs io simple)
(ice-9 getopt-long)
+ (gnu gnunet scripts guix-stuff)
(only (ice-9 ftw) scandir)
(only (srfi srfi-1) member)
(only (guile)
@@ -39,12 +40,15 @@
stat:perms
stat:size)
(guile)
+ (only (srfi srfi-1)
+ concatenate)
(rnrs bytevectors)
(ice-9 binary-ports)
(ice-9 textual-ports)
(ice-9 regex)
(ice-9 popen)
(ice-9 rdelim)
+ (json)
(sxml match)
(only (ice-9 optargs)
define*))
@@ -68,8 +72,8 @@ Publish a (GNU Guix, or Nix) store item INPUT into GNUnet.
-h, --help Print this message
-s, --simulate Do not actually publish INPUT, only print the
computed URI
- -f, --format Format for representing a store item, gnunet-nar
- by default
+ -f, --format Format for representing a store item,
+ currently gnunet-nix-archive-json/0
-i, --input Store item to publish
GNUnet options
@@ -87,28 +91,26 @@ GNUnet options
((option-ref options 'help #f)
(display %help (current-output-port))
(newline (current-output-port)))
- ((equal? (option-ref options '--format "gnunet-nar") "gnunet-nar")
- (publish-nar #:input (option-ref options 'input #f)
- #:simulate (option-ref options 'simulate #f)
- #:config (option-ref options 'config #f)))
+ ((equal? (option-ref options 'format "gnunet-nix-archive-json/0")
+ "gnunet-nix-archive-json/0")
+ (let ((result
+ (publish-nar #:input (option-ref options 'input #f)
+ #:simulate (option-ref options 'simulate #f)
+ #:config (option-ref options 'config #f))))
+ (format (current-output-port)
+ "Published at ~a in ~a format~%"
+ result "gnunet-nix-archive-json/0")))
(else ???))))
(define* (publish-nar #:key input
#:allow-other-keys
#:rest r)
(let* ((sxml (store-item->sxml input))
- (data-files (sxml-data-files sxml))
(publish-object
(lambda (object)
(apply publish-object object r))))
- ;; Insert each regular file
- (for-each (lambda (a)
- (display (publish-object a))
- (newline))
- data-files)
- ;; FIXME also write directories
- '???
- ))
+ (publish-object
+ (string->utf8 (apply publish-sxml->json sxml r)))))
(define gnunet-publish-uri-regexp
(make-regexp "\\b(gnunet://fs/chk/([A-Z0-9]+).([A-Z0-9]+).[0-9]+)\\b"))
@@ -126,7 +128,7 @@ GNUnet options
(anonymity 1)
(priority 360)
(replication 0)
- (noindex #f))
+ (no-index #f))
"Run the GNUnet publish binary, and return the computed hash
as a string."
(setenv "LC_ALL" "C")
@@ -142,7 +144,7 @@ as a string."
,@(if simulate
'("-s")
'("-s"))
- ,@(if noindex
+ ,@(if no-index
'("-n")
'())
"--"
@@ -156,6 +158,44 @@ as a string."
(throw 'gnunet-publish-eep 'gnunet-publish-???))
(extract-uri text-1)))
+ (define* (publish-sxml->json sxml
+ #:key
+ #:allow-other-keys
+ #:rest r)
+ "Publish SXML, an SXML as returned by store-item->sxml,
+and return a JSON string representing it, with individual files
+referred to by their hash."
+ (define (flatten-sxml prefix sxml)
+ (sxml-match sxml
+ ((regular (@ (name ,name)
+ (executable? ,executable?)
+ (data-from-file ,filename)))
+ `(((name . ,(string-append prefix name))
+ (type . ,(if executable?
+ "executable"
+ "regular"))
+ (hash . ,(apply publish-object filename r)))))
+ ((symlink (@ (name ,name)
+ (target ,target)))
+ `(((name . ,(string-append prefix name))
+ (type . "symlink")
+ (target . ,target))))
+ ((directory (@ (name ,name))
+ . ,rest)
+ `(((name . ,(string-append prefix name))
+ (type . "directory"))
+ . ,(concatenate
+ (map (let ((prefix (string-append prefix "/" name)))
+ (lambda (e)
+ (flatten-sxml prefix e)))
+ rest))))))
+ (let* ((flattened (flatten-sxml "" sxml))
+ (flattened/vector (list->vector flattened))
+ (wrapped `((version . "gnunet-nix-archive-json/0")
+ (entries . ,flattened/vector)))
+ (wrapped/string (scm->json-string wrapped)))
+ wrapped/string))
+
(define* (publish-object data
#:key
#:allow-other-keys
@@ -203,13 +243,5 @@ actually publish the file, only compute its hash."
(map (lambda (name)
(let ((file (string-append filename "/" name)))
(store-item->sxml file)))
- names)))
-
- (define (sxml-data-files sxml)
- (sxml-match sxml
- ((regular (@ (data-from-file ,filename)))
- (list filename))
- ((symlink) '())
- ((directory ,(entry) ...)
- (append entry ...))))))
+ names)))))
--
To stop receiving notification emails like this one, please contact
gnunet@gnunet.org.
- [gnunet-scheme] 30/324: Correct maximum in metaformats.scm and metatypes.scm, (continued)
- [gnunet-scheme] 30/324: Correct maximum in metaformats.scm and metatypes.scm, gnunet, 2021/09/21
- [gnunet-scheme] 26/324: Port meta-data-serialize/uncached, gnunet, 2021/09/21
- [gnunet-scheme] 29/324: Define meta data structures systematically, gnunet, 2021/09/21
- [gnunet-scheme] 31/324: fix netstruct, and implement wrap-reader-setter, gnunet, 2021/09/21
- [gnunet-scheme] 28/324: Define library for structures, gnunet, 2021/09/21
- [gnunet-scheme] 34/324: scripts: add incomplete script for publishing a store item, gnunet, 2021/09/21
- [gnunet-scheme] 33/324: include some notes on reverse-engineering GNUdirs, gnunet, 2021/09/21
- [gnunet-scheme] 36/324: scripts: publish-store: eliminate add-name, gnunet, 2021/09/21
- [gnunet-scheme] 32/324: remove some uses of old accessors, gnunet, 2021/09/21
- [gnunet-scheme] 41/324: scripts: publish-store: fix predicate of --format option, gnunet, 2021/09/21
- [gnunet-scheme] 38/324: scripts: publish-store: publish whole trees,
gnunet <=
- [gnunet-scheme] 37/324: scripts: publish-store: publish individual files, gnunet, 2021/09/21
- [gnunet-scheme] 40/324: scripts: publish-store: allow setting all options, gnunet, 2021/09/21
- [gnunet-scheme] 39/324: guix: suggest a package definition, gnunet, 2021/09/21
- [gnunet-scheme] 35/324: scripts: publish-store: compute file tree, gnunet, 2021/09/21
- [gnunet-scheme] 43/324: scripts: publish-store: exit after main function, gnunet, 2021/09/21
- [gnunet-scheme] 48/324: scripts: download-store: download json container, gnunet, 2021/09/21
- [gnunet-scheme] 45/324: scripts: publish-store: fix '--config' option parsing, gnunet, 2021/09/21
- [gnunet-scheme] 46/324: scripts: download-store: parse input arguments, gnunet, 2021/09/21
- [gnunet-scheme] 42/324: scripts: publish-store: export some procedures, gnunet, 2021/09/21
- [gnunet-scheme] 44/324: doc: document publish-store.scm, gnunet, 2021/09/21