[gnunet-scheme] 38/324: scripts: publish-store: publish whole trees

[gnunet]

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.