[gnunet-scheme] 37/324: scripts: publish-store: publish individual files

[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 314b0962e97ed83b7f5887615920487cdc481e63
Author: Maxime Devos <maximedevos@telenet.be>
AuthorDate: Sat Jan 23 14:20:49 2021 +0100

    scripts: publish-store: publish individual files
    
    FIXME: respect anonymity, simulate, ...
    
    * gnu/gnunet/scripts/publish-sore.scm
      (sxml-data-files): new procedure, returning a list of file names.
      (publish-object): new procedure, publishing an object via GNUnet.
      (gnunet-publish): new procedure, calling the `gnunet-publish'
      binary appropriately.
      (extract-uri): new procedure, extracting the URI from `gnunet-publish'
      output.
      (gnunet-publish-uri-regexp): new variable
      (publish-nar): call publish-object on each regular file
---
 gnu/gnunet/scripts/publish-store.scm | 102 ++++++++++++++++++++++++++++++++---
 1 file changed, 96 insertions(+), 6 deletions(-)

diff --git a/gnu/gnunet/scripts/publish-store.scm 
b/gnu/gnunet/scripts/publish-store.scm
index a0aedd7..9059506 100644
--- a/gnu/gnunet/scripts/publish-store.scm
+++ b/gnu/gnunet/scripts/publish-store.scm
@@ -38,6 +38,13 @@
                stat:type
                stat:perms
                stat:size)
+         (guile)
+         (rnrs bytevectors)
+         (ice-9 binary-ports)
+         (ice-9 textual-ports)
+         (ice-9 regex)
+         (ice-9 popen)
+         (ice-9 rdelim)
          (sxml match)
          (only (ice-9 optargs)
                define*))
@@ -86,11 +93,85 @@ GNUnet options
                            #:config (option-ref options 'config #f)))
              (else ???))))
 
-    (define* (publish-nar #:key input simulate config)
-      ;; FIXME use this
-      (display (store-item->sxml input))
-      (newline)
-      ???)
+    (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
+       '???
+       ))
+
+    (define gnunet-publish-uri-regexp
+      (make-regexp "\\b(gnunet://fs/chk/([A-Z0-9]+).([A-Z0-9]+).[0-9]+)\\b"))
+    (define (extract-uri output)
+      (match:substring (regexp-exec gnunet-publish-uri-regexp output) 1))
+
+    (define* (gnunet-publish file
+                            #:key
+                            ;; FIXME this shouldn't matter
+                            input
+                            (config (string-append
+                                     (getenv "HOME")
+                                     "/.config/gnunet.conf"))
+                            (simulate #f)
+                            (anonymity 1)
+                            (priority 360)
+                            (replication 0)
+                            (noindex #f))
+      "Run the GNUnet publish binary, and return the computed hash
+as a string."
+      (setenv "LC_ALL" "C")
+      (let* ((*binary* "gnunet-publish")
+            (cmd `(,*binary*
+                   "--disable-extractor"
+                   "-a" ,(number->string anonymity)
+                   "-p" ,(number->string priority)
+                   "-r" ,(number->string replication)
+                   ,@(if config
+                         `("-c" ,config)
+                         '())
+                   ,@(if simulate
+                         '("-s")
+                         '("-s"))
+                   ,@(if noindex
+                         '("-n")
+                         '())
+                   "--"
+                   ,file))
+            (pipe (apply open-pipe* OPEN_READ cmd))
+            (text-0 (read-line pipe))
+            (text-1 (read-line pipe))
+            (ret  (close-pipe pipe)))
+       (unless (= ret 0)
+         ;; XXX
+         (throw 'gnunet-publish-eep 'gnunet-publish-???))
+       (extract-uri text-1)))
+
+    (define* (publish-object data
+                            #:key
+                            #:allow-other-keys
+                            #:rest r)
+      "Publish DATA, a bytevector or filename, and return
+the resulting GNUnet FS URI. If SIMULATE is #t, do not
+actually publish the file, only compute its hash."
+      (cond ((bytevector? data)
+            (call-with-temporary-output-file
+             (lambda (name port)
+               (put-bytevector port data)
+               (close-port port)
+               (apply gnunet-publish name
+                      #:no-index #t r))))
+           ((string? data)
+            (apply gnunet-publish data r))))
 
     (define (store-item->sxml filename)
       (let* ((name  (basename filename))
@@ -122,4 +203,13 @@ GNUnet options
        (map (lambda (name)
               (let ((file (string-append filename "/" name)))
                 (store-item->sxml file)))
-            names)))))
+            names)))
+
+    (define (sxml-data-files sxml)
+      (sxml-match sxml
+                 ((regular (@ (data-from-file ,filename)))
+                  (list filename))
+                 ((symlink) '())
+                 ((directory ,(entry) ...)
+                  (append entry ...))))))
+

-- 
To stop receiving notification emails like this one, please contact
gnunet@gnunet.org.