[gnunet] 09/17: Rewrite of examples/publish.scm, small bug fixes and typos. * examples/publish.scm: rewritten to correctly handle namespaces. * gnu/gnunet/binding-utils.scm: add `or%`. * gnu/gnunet/fs.scm: bug fix: `start-*` function throw an error instead of returning %null-pointer. * gnu/gnunet/identity.scm: typo.

[R�mi Birot-Delrue]

remibd pushed a commit to branch master
in repository gnunet.

commit ff8e19b523de9514e48f9c1f136cd471660cad5d
Author: Rémi Birot-Delrue <address@hidden>
Date:   Mon Aug 3 12:38:31 2015 +0200

    Rewrite of examples/publish.scm, small bug fixes and typos.
    * examples/publish.scm: rewritten to correctly handle namespaces.
    * gnu/gnunet/binding-utils.scm: add `or%`.
    * gnu/gnunet/fs.scm: bug fix: `start-*` function throw an error instead of
                        returning %null-pointer.
    * gnu/gnunet/identity.scm: typo.
---
 examples/publish.scm         |  189 +++++++++++++++++++++++------------------
 gnu/gnunet/binding-utils.scm |   18 ++++-
 gnu/gnunet/fs.scm            |   37 +++++---
 gnu/gnunet/identity.scm      |    2 +-
 4 files changed, 147 insertions(+), 99 deletions(-)

diff --git a/examples/publish.scm b/examples/publish.scm
index 1dd2192..7ff1e0a 100755
--- a/examples/publish.scm
+++ b/examples/publish.scm
@@ -28,119 +28,139 @@
   #:use-module (gnu gnunet identity)
   #:export     (main))
 
-(define config-file "~/.gnunet/gnunet.conf")
+(define *index?*      #t)
+(define *simulate?*   #f)
 
-(define-syntax-rule (define-parameter name)
-  (define name (make-parameter #f)))
+(define *config-file* "~/.gnunet/gnunet.conf")
+(define *config*          #f)
 
-(define *index?* #t)
-(define *simulate?* #t)
+(define *binary-name*     #f)
+(define *filename*        #f)
 
+;;+TODO: add kill tasks everywhere!
+;;+TODO: each continuation shalt check its indirect arguments.
 ;; The kill task is the task that will end the program, either because it has
 ;; reached a timeout or because it has come to a normal or abnormal ending.
-(define-parameter kill-task)
+(define *kill-task*       #f)
 
-(define-parameter binary-name)
-(define-parameter file-name)
-(define-parameter namespace-name)
-(define-parameter namespace-ego)
-(define-parameter file-identifier)
+(define *namespace-name*  #f)
+(define *namespace-ego*   #f)
+
+(define *file-identifier* #f)
+
+(define *fs-handle*       #f)
+(define *identity-handle* #f)
+(define *publish-handle*  #f)
+(define *dir-scanner*     #f)
 
-(define-parameter config-handle)
-(define-parameter fs-handle)
-(define-parameter publish-handle)
-(define-parameter dir-scanner)
 
 (define (main args)
   "Entry point of the program."
-  (config-handle (load-configuration config-file))
-  (call-with-scheduler (config-handle) (first-task args)))
+  (set! *config* (load-configuration *config-file*))
+  (call-with-scheduler *config* (first-task args)))
 
 (define (first-task args)
-  "The initial task: parse the command line and call START-PUBLISH-FILE."
+  "The initial task: parse the command line and either find the
+demanded ego or call IDENTITY-CONTINUATION."
   (lambda (_)
     (match args
-      ((binary file namespace identifier)
-       (binary-name binary)
-       (file-name file)
-       (namespace-name namespace)
-       (file-identifier identifier)
-       (start-ego-lookup (config-handle) (namespace-name) ego-lookup-callback))
-      ((binary file)
-       (binary-name binary)
-       (file-name file)
-       (set-next-task! start-publish-file))
+      ((binary filename namespace identifier)
+       (set! *binary-name*     binary)
+       (set! *filename*        filename)
+       (set! *namespace-name*  namespace)
+       (set! *file-identifier* identifier)
+       (set! *identity-handle*
+        (open-identity-service *config* identity-callback))
+       (set! *kill-task*
+        (add-task! (lambda (_)
+                     (close-identity-service *identity-handle*))
+                   #:delay (* 5 1000 1000))))
+      ((binary file-name)
+       (set! *binary-name* binary)
+       (set! *filename*    file-name)
+       (identity-continuation))
       ((binary . _)
        (simple-format #t "Usage: ~a filename [namespace identifier]\n"
-                     binary)))))
+                     binary)
+       (schedule-shutdown!)))))
 
-(define (ego-lookup-callback ego)
-  "The first callback, called once by the ego lookup tasks. Set NAMESPACE-EGO 
to
-the right ego, then continue with START-PUBLISH-FILE."
-  (cond (ego (namespace-ego ego)
-            (set-next-task! start-publish-file))
-       (else (simple-format #t "Error: no ego named ~a has been found!\n"
-                            (namespace-name)))))
+(define (identity-callback ego name)
+  "The first callback, called repeatedly by the identity service. Set
+NAMESPACE-EGO to the right ego, then continue with
+IDENTITY-CONTINUATION."
+  (display "IDENTITY-CALLBACK\n")
+  (cond ((and ego name (string= *namespace-name* name))
+        (set! *namespace-ego* ego))
+       ((and (not ego) (not name)) ; last call
+        (cancel-task! *kill-task*)
+        (identity-continuation))))
 
-(define (start-publish-file _)
-  "The second task: open the filesharing service and start a directory scan on
-FILENAME."
-  (fs-handle   (open-filesharing-service (config-handle) (binary-name)
-                                        progress-callback))
-  (dir-scanner (start-directory-scan (file-name) scan-progress-callback))
-  ;; We started a directory scan, need to add a timeout just in case.
-  (kill-task   (add-task! (lambda (_)
-                         (stop-directory-scan (dir-scanner))
-                         (simple-format #t "Stopped directory scanner.\n"))
-                       #:delay (* 5 1000 1000))))
+(define (identity-continuation)
+  "The second task: open the filesharing service and start a directory
+scan on *FILENAME*."
+  (display "IDENTITY-CONTINUATION\n")
+  (cond
+   ((or (and *namespace-name* *namespace-ego*)
+       (and (not *namespace-name*) (not *namespace-ego*)))
+    (if *namespace-name*
+       (simple-format #t " -> FILENAME ~a\tNAMESPACE ~a\n" *filename* 
*namespace-name*)
+       (display " -> FILENAME ~a\n"))
+    (set! *fs-handle*   (open-filesharing-service *config* *binary-name*
+                                                 progress-callback))
+    (set! *dir-scanner* (start-directory-scan *filename* dirscan-callback))
+    (set! *kill-task*   (add-task! (lambda (_)
+                                    (display "Stopping directory scan 
(unexpected)\n")
+                                    (stop-directory-scan *dir-scanner*))
+                                  #:delay (* 5 1000 1000))))
+   (else
+    (simple-format #t "Error: no ego named ~a has been found!\n"
+                  *namespace-name*)
+    ;; there’s an error, we must execute the killing task right now
+    (schedule-shutdown!))))
 
-(define (scan-progress-callback filename directory? reason)
-  "The second callback, called repeatedly by the directory scanning tasks: wait
-until the scan is finished, interpret its results and start the publication."
+(define (dirscan-callback filename directory? reason)
+  "The second callback, called repeatedly by the directory scanning
+tasks: wait until the scan is finished, interpret its results and
+start the publication by calling DIRSCAN-CONTINUATION."
+  (simple-format #t "DIRSCAN-CALLBACK(~a ~a ~a)\n" filename directory? reason)
   (case reason
     ((#:finished)
-     (let* ((%share-tree (directory-scanner-result (fs-handle) (dir-scanner)))
-           (file-info   (share-tree->file-information (fs-handle) %share-tree
+     (cancel-task! *kill-task*)
+     (let* ((%share-tree (directory-scanner-result *fs-handle* *dir-scanner*))
+           (file-info   (share-tree->file-information *fs-handle* %share-tree
                                                       *index?*)))
-
-       (publish-handle
-       (if (and (namespace-name) (namespace-ego))
-           (start-publish (fs-handle)
-                          (unwrap-file-information file-info)
-                          #:simulate?  *simulate?*
-                          #:namespace  (namespace-ego)
-                          #:identifier (file-identifier))
-           (start-publish (fs-handle)
-                          (unwrap-file-information file-info)
-                          #:simulate? *simulate?*)))
-
-       ;; now that the scan is finished, we can cancel the previous timeout and
-       ;; set a new one that will end the publication
-       (cancel-task! (kill-task))
-       (kill-task (add-task! (lambda (_)
-                              (stop-publish (publish-handle))
-                              (display "Stopped publication.\n"))
-                            #:delay (* 5 1000 1000)))))
+       (dirscan-continuation file-info)))
     ((#:internal-error)
-     (display "scan-progress-callback: internal error.\n")
-     ;; there’s an error, we must execute the killing task right now
-     (cancel-task! (kill-task))
-     (kill-task (set-next-task! (lambda (_)
-                                 (stop-directory-scan (dir-scanner))
-                                 (display "Stopped directory scanner.\n")))))))
+     (display "dirscan-callback: internal error.\n")
+     (schedule-shutdown!))))
+
+(define (dirscan-continuation file-info)
+  "Start the publication of FILE-INFO."
+  (display "DIRSCAN-CONTINUATION\n")
+  (set! *publish-handle*
+    (start-publish *fs-handle* file-info
+                  #:namespace *namespace-ego*
+                  #:identifier *file-identifier*
+                  #:simulate? *simulate?*))
+  (set! *kill-task* (add-task! (lambda (_)
+                                (display "Stopping publication (unexpected)\n")
+                                (stop-publish *publish-handle*))
+                              #:delay (* 5 1000 1000))))
 
 (define (progress-callback %info)
   "The third callback, called repeteadly by the publishing tasks once the
 publication is engaged: when the publication starts, print a little something,
 and when it’s complete print the published file’s URI and stop the 
publication."
+  (display "PROGRESS-CALLBACK\n")
   (let ((status (progress-info-status %info)))
     (case (cadr status) ; status is of the form (#:publish <something>)
       ((#:start)
        (match (parse-c-progress-info %info)
         (((%context %file-info cctx pctx %filename . _) _ _)
-         (simple-format #t "Publishing `~a'.\n"
-                        (pointer->string %filename)))))
+         (simple-format #t "Publishing `~a'.\n" (pointer->string %filename)))))
       ((#:completed)
+       (display "3\n")
+       (cancel-task! *kill-task*)
        (match (parse-c-progress-info %info)
         (((%context %file-info cctx pctx %filename _ _ _ _ _ (%chk-uri)) _ _)
          (simple-format #t "Published `~a'.\n~a\n" (pointer->string %filename)
@@ -149,7 +169,10 @@ and when it’s complete print the published file’s URI and 
stop the publicati
        ;; it frees the publish-handle that might still be used just after this
        ;; call to progress-callback ends. Therefore, we continue with a new 
kill
        ;; task.
-       (cancel-task! (kill-task))
-       (kill-task (set-next-task! (lambda (_) (stop-publish 
(publish-handle))))))
-      (else
-       (simple-format #t "Got status ~a\n" status)))))
+       (set! *kill-task*
+        (set-next-task! (lambda (_)
+                          (display "Stopping publication\n")
+                          (stop-publish *publish-handle*)))))
+      ((#:stopped)
+       (display "Publication stopped\n")
+       (schedule-shutdown!)))))
diff --git a/gnu/gnunet/binding-utils.scm b/gnu/gnunet/binding-utils.scm
index f82b328..0ab899f 100644
--- a/gnu/gnunet/binding-utils.scm
+++ b/gnu/gnunet/binding-utils.scm
@@ -32,7 +32,8 @@
 
             string->pointer*
             pointer->string*
-            make-c-struct*))
+            make-c-struct*
+            or%))
 
 (define (getf plist value)
   (let ((entry (member value plist)))
@@ -77,3 +78,18 @@ if STRING is empty (\"\")."
 
 (define (pointer->string* ptr)
   (if (eq? %null-pointer ptr) #f (pointer->string ptr)))
+
+;; a variant of OR for foreign pointers.
+;; ex:                       (or% 'a 'b) → A
+;;                (or% %null-pointer 'b) → B
+;;     (or% %null-pointer %null-pointer) → #f
+(define-syntax or%
+  (syntax-rules ()
+    ((_ x)       (let ((x* x))
+                   (if (eq? %null-pointer x*)
+                       #f
+                       x*)))
+    ((_ x y ...) (let ((x* x))
+                   (if (eq? %null-pointer x*)
+                       (or% y ...)
+                       x*)))))
diff --git a/gnu/gnunet/fs.scm b/gnu/gnunet/fs.scm
index 517b554..d32ef09 100644
--- a/gnu/gnunet/fs.scm
+++ b/gnu/gnunet/fs.scm
@@ -216,8 +216,10 @@ PROGRESS-CB must be a procedure of three arguments:
   (let ((%filename           (string->pointer filename))
         (%disable-extractor? (if disable-extractor? gnunet-yes gnunet-no))
         (%callback           (scan-progress-callback->pointer progress-cb)))
-    (%directory-scan-start %filename %disable-extractor? %null-pointer
-                           %callback %null-pointer)))
+    (or% (%directory-scan-start %filename %disable-extractor? %null-pointer
+                                %callback %null-pointer)
+         (throw 'invalid-result "start-directory-scan" "%directory-scan-start"
+                %null-pointer))))
 
 (define (stop-directory-scan scanner)
   "Abort a scan.
@@ -238,7 +240,7 @@ callback."
 ;; is variadic and, hence, not currently handlable by Guile’s Dynamic FFI.
 ;;
 ;;+TODO: dynamically allocate the entire structure & client-name, so that we 
can
-;;      call GNUNET_FS_stop on the returned handle.
+;;       call GNUNET_FS_stop on the returned handle.
 ;;
 ;;+TODO: replace value for avg_block_latency with a call to a function
 ;;       akin `(time-relative #:minutes 1)`
@@ -273,22 +275,27 @@ GNUNET_FS_ProgressInfo`) that will be called every time 
something happens in the
 filesharing service (a search is started, a download is completed, etc.)."
   (when (null? client-name)
     (throw 'invalid-arg "open-filesharing-service" client-name))
-  (%fs-start (unwrap-configuration config)
-             (string->pointer client-name)
-             (progress-callback->pointer progress-callback)))
+  (or% (%fs-start (unwrap-configuration config)
+                  (string->pointer client-name)
+                  (progress-callback->pointer progress-callback))
+       (throw 'invalid-result "open-filesharing-service" "%fs-start"
+              %null-pointer)))
 
 (define (start-search filesharing-handle uri)
-  (%search-start filesharing-handle
-                 (unwrap-uri uri)
-                 0 0 %null-pointer))
+  (or% (%search-start filesharing-handle
+                      (unwrap-uri uri)
+                      0 0 %null-pointer)
+       (throw 'invalid-result "start-search" "%search-start" %null-pointer)))
 
 (define (stop-search search-handle)
   (%search-stop search-handle))
 
 (define (start-download filesharing-handle uri filename)
-  (%download-start filesharing-handle (unwrap-uri uri) %null-pointer
-                   (string->pointer filename) %null-pointer 0
-                   (uri-file-size uri) 0 0 %null-pointer %null-pointer))
+  (or% (%download-start filesharing-handle (unwrap-uri uri) %null-pointer
+                        (string->pointer filename) %null-pointer 0
+                        (uri-file-size uri) 0 0 %null-pointer %null-pointer)
+       (throw 'invalid-result "start-download" "%download-start"
+              %null-pointer)))
 
 (define* (stop-download download-handle #:key delete-incomplete?)
   (%download-stop download-handle (if delete-incomplete? gnunet-yes 
gnunet-no)))
@@ -315,8 +322,10 @@ identify the publication in place of the extracted 
keywords)."
         (%update-id  (if update-identifier (string->pointer update-identifier)
                          %null-pointer))
         (%simulate?  (if simulate?  gnunet-yes gnunet-no)))
-    (%publish-start filesharing-handle file-information %priv %identifier
-                    %update-id %simulate?)))
+    (or% (%publish-start filesharing-handle (unwrap-file-information
+                                             file-information) %priv 
%identifier
+                                             %update-id %simulate?)
+         (throw 'invalid-arg "start-publish" "%publish-start" %null-pointer))))
 
 (define (stop-publish publish-handle)
   "Stops a publication.
diff --git a/gnu/gnunet/identity.scm b/gnu/gnunet/identity.scm
index d453e2a..06cfe8c 100644
--- a/gnu/gnunet/identity.scm
+++ b/gnu/gnunet/identity.scm
@@ -116,7 +116,7 @@ IDENTITY-CALLBACK will also be called.
 Returns a handle to the “ego retrieving operation” that can be used to
 cancel it (see CANCEL-OPERATION!)."
   (when (string-null? service)
-    (throw 'invalid-arg "open-identity-service" service))
+    (throw 'invalid-arg "get-default-ego" service))
   (%identity-get identity-handle (string->pointer service)
                 (identity-callback->pointer identity-callback) %null-pointer))