wip keywords publish

2 files changed, 84 insertions, 27 deletions

diff --git a/gnunet-guile b/gnunet-guile
index d1566c6..e806f8d 100755
--- a/gnunet-guile
+++ b/gnunet-guile
@@ -90,20 +90,41 @@ Download the URI to FILENAME using CONFIGURATION.
 ;; directory-scan callback aka. publish/task/directory-scan
 (define %directory-scanner #f)
 
-(define (publish/progress info)
-  (let ((status (fs-progress-info-status info)))
-    (cond
-     ((eq? status %fs-status-publish-start)
-      (format #t "* Publishing started!\n"))
-     ((eq? status %fs-status-publish-progress)
-      (format #t "* Publishing in progress...\n"))
-     ((eq? status %fs-status-publish-error)
-      (format #t "* Error publishing: ~a!\n" (fs-progress-info-publish-error info))
-      (scheduler-shutdown))
-     ((eq? status %fs-status-publish-completed)
-      (format #t "* Publishing '~a' done.\n" (fs-progress-info-publish-filename info))
-      (format #t "* URI is '~a'\n" (fs-progress-info-publish-chk-uri info))
-      (scheduler-shutdown)))))
+(define (publish/keywords-callback uri error)
+  (if error
+      (format #t "* Error while publishing keywords: ~a\n" error)
+      (format #t "* Keywords published\n"))
+  (scheduler-shutdown))
+
+(define (publish/keywords fs keywords uri)
+  (fs-publish-ksk fs
+                  (apply fs-uri-ksk-create keywords)
+                  uri
+                  (fs-block-options)
+                  %fs-publish-option-none
+                  publish/keywords-callback))
+
+(define (publish/progress keywords)
+  (lambda (info)
+    (let ((status (fs-progress-info-status info)))
+      (cond
+       ((eq? status %fs-status-publish-start)
+        (format #t "* Publishing started!\n"))
+       ((eq? status %fs-status-publish-progress)
+        (format #t "* Publishing in progress...\n"))
+       ((eq? status %fs-status-publish-error)
+        (format #t "* Error publishing: ~a!\n" (fs-progress-info-publish-error info))
+        (scheduler-shutdown))
+       ((eq? status %fs-status-publish-completed)
+        (format #t "* Publishing '~a' done.\n" (fs-progress-info-publish-filename info))
+        (format #t
+                "* URI is '~a'\n"
+                (uri->string (fs-progress-info-publish-chk-uri info)))
+        (if (null? keywords)
+            (scheduler-shutdown)
+            (publish/keywords (fs-progress-info-fs info)
+                              keywords
+                              (fs-progress-info-publish-chk-uri info))))))))
 
 (define (publish/task/shutdown publish-context)
   (lambda ()
@@ -125,7 +146,8 @@ Download the URI to FILENAME using CONFIGURATION.
         (let ((fi (fs-file-information-create-from-file
                    fs
                    (fs-share-tree-item-filename share-tree)
-                   (fs-share-tree-item-ksk-uri share-tree)
+                   ;; XXX: force keyword to be 'jjj'
+                   (fs-uri-ksk-create "jjj") ;; (fs-share-tree-item-ksk-uri share-tree)
                    (fs-share-tree-item-meta share-tree)
                    %gnunet-yes
                    (fs-block-options))))
@@ -136,35 +158,35 @@ Download the URI to FILENAME using CONFIGURATION.
       (scheduler-shutdown))
      (else (error "should not happen")))))
 
-(define (publish/task configuration filename)
+(define (publish/task configuration filename keywords)
   (lambda ()
-    (let ((fs (fs-start configuration "gnunet-guile" publish/progress)))
+    (let ((fs (fs-start configuration "gnunet-guile" (publish/progress keywords))))
       (set! %directory-scanner
         (fs-directory-scan-start filename
                                  #t
                                  (publish/task/directory-scan fs))))))
 
-(define (publish-exec configuration filename)
+(define (publish-exec configuration filename keywords)
   (let ((configuration* (configuration-create)))
     (configuration-load! configuration* configuration)
-    (scheduler-run (publish/task configuration* filename))))
+    (scheduler-run (publish/task configuration* filename keywords))))
 
 (define %publish-options
   '((help (single-char #\h) (value #f))))
 
 (define (publish args)
-  "gnunet-guile publish CONFIGURATION FILE
+  "gnunet-guile publish CONFIGURATION FILE [KEYWORDS...]
 
-Publish on gnunet FILE using CONFIGURATION
+Publish on gnunet FILE using CONFIGURATION using KEYWORDS
 "
   (let ((options (getopt-long (cons "gnunet-guile publish" args)
                               %download-options
                               #:stop-at-first-non-option #f)))
     (if (option-ref options 'help #f)
-        (display (procedure-documentation download))
+        (display (procedure-documentation publish))
         (match args
-          ((configuration file)
-           (publish-exec configuration file))))))
+          ((configuration file keywords ...)
+           (publish-exec configuration file keywords))))))
 
 ;;; cli
 
diff --git a/gnunet.scm b/gnunet.scm
index e59e959..c688026 100644
--- a/gnunet.scm
+++ b/gnunet.scm
@@ -16,6 +16,7 @@
 ;;;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
 (define-module (gnunet))
 
+(use-modules ((web uri)))
 (use-modules ((ice-9 iconv)))
 (use-modules ((rnrs bytevectors)))
 (use-modules ((system foreign) #:prefix ffi:))
@@ -107,6 +108,13 @@ defaults."
       (check (func configuration (ffi:string->pointer filename))
              (format #f "Impossible to load configuration at ~a" filename)))))
 
+;; container, gnunet_container_lib.h
+
+(define-public container-meta-data-create
+  (let ((func (util '* "GNUNET_CONTAINER_meta_data_create")))
+    (lambda ()
+      (func))))
+
 ;; crypto, gnunet_crypto_lib.h
 
 (define %crypto-hash-code (bs:struct `((bits ,(bs:vector 16 uint32)))))
@@ -519,9 +527,8 @@ Return unique task identifier for the job, valid until THUNK is started."
     (bytestructure-ref info 'value 'publish 'filename))))
 
 (define-public (fs-progress-info-publish-chk-uri info)
-  (uri->string
-   (ffi:make-pointer
-    (bytestructure-ref info 'value 'publish 'specifics 'completed 'chk-uri))))
+  (ffi:make-pointer
+   (bytestructure-ref info 'value 'publish 'specifics 'completed 'chk-uri)))
 
 (define (progress-callback-wrapper callback)
   (lambda (_ info)
@@ -755,6 +762,34 @@ fs-directory-scan-start"
             do-index
             (bytestructure->pointer options)))))
 
+(define (callback->publish-continuation callback)
+  (ffi:procedure->pointer ffi:void
+                          (lambda (_ uri error)
+                            (callback uri
+                                      (if (eq? ffi:%null-pointer)
+                                          #f
+                                          (ffi:pointer->string error))))
+                          '(* * *)))
+
+(define-public fs-publish-ksk
+  (let ((func (fs '* "GNUNET_FS_publish_ksk" '* '* '* '* '* ffi:int '* '*)))
+    (lambda (fs ksk-uri uri block-options publish-options callback)
+      "Publish a KBlock on GNUnet."
+      (func fs
+            ksk-uri
+            (container-meta-data-create) ;; ffi:%null-pointer ;; meta
+            uri
+            (bytestructure->pointer block-options)
+            publish-options
+            (callback->publish-continuation callback)
+            ffi:%null-pointer))))
+
+(define-public (fs-uri-ksk-create keyword . keywords)
+  "Build a KSK uri from KEYWORD and KEYWORDS. Prefix the keyword
+with + if it must be mandatory"
+  (let ((keywords (cons keyword keywords)))
+    (let ((path (string-join (map uri-encode keywords) "+")))
+      (string->uri (string-append "gnunet://fs/ksk/" path)))))
 
 ;; gnunet-identity bindings