[gnunet] 11/17: Add `close-filesharing-service` and dynamic allocation in `open-filesharing-handle`.

[Rémi Birot-Delrue]

remibd pushed a commit to branch master
in repository gnunet.

commit 5259c5c20af1fc96d12b3ecfd1b10ac51269f480
Author: Rémi Birot-Delrue <address@hidden>
Date:   Mon Aug 3 17:01:54 2015 +0200

    Add `close-filesharing-service` and dynamic allocation in 
`open-filesharing-handle`.
---
 examples/download.scm  |   66 ++++++++++++++++++++++-------------------------
 examples/publish.scm   |   15 +++--------
 examples/search-ns.scm |    7 +++-
 examples/search.scm    |   50 ++++++++++++++++++++----------------
 gnu/gnunet/fs.scm      |   61 +++++++++++++++++++++++++++++---------------
 5 files changed, 108 insertions(+), 91 deletions(-)

diff --git a/examples/download.scm b/examples/download.scm
index 0928306..6c7a283 100755
--- a/examples/download.scm
+++ b/examples/download.scm
@@ -28,27 +28,35 @@
   #:use-module (gnu gnunet scheduler)
   #:export     (main))
 
-(define config-file "~/.gnunet/gnunet.conf")
+(define *config-file* "~/.gnunet/gnunet.conf")
+(define *config*      (load-configuration *config-file*))
 
-(define *fs-handle* %null-pointer)
-(define *dl-handle* %null-pointer)
-(define *stderr* (current-error-port))
-(define *count* 1)
+(define *fs-handle* #f)
+(define *dl-handle* #f)
+(define *kill-task* #f)
 
 
-(define (shutdown-task _)
-  (simple-format *stderr* "scheduler run: timeout\n")
-  (force-output *stderr*)
-  (display "Shutdown\n")
-  (simple-format *stderr* "shutdown-task: stopping dl ~a\n" *dl-handle*)
-  (stop-download *dl-handle*)
-  (simple-format *stderr* "shutdown-task: stopped dl\n"))
+(define (main args)
+  "Entry point: simply run FIRST-TASK within GNUnet’s scheduler."
+  (call-with-scheduler *config* (first-task args)))
+
+(define (first-task args)
+  (lambda (_)
+    "Parse the arguments, connect to the filesharing system and launch
+the download."
+    (match args
+      ((binary-name output-filename uri-string)
+       (let ((uri (parse-uri uri-string)))
+        (set! *fs-handle* (open-filesharing-service *config* binary-name
+                                                    progress-cb))
+        (set! *dl-handle* (start-download *fs-handle* uri output-filename))
+        ;; add a timeout in 5 seconds
+        (set! *kill-task*
+          (add-task! (lambda (_)
+                       (stop-download *dl-handle*))
+                     #:delay (time-rel #:seconds 5))))))))
 
 (define (progress-cb %info)
-  (simple-format *stderr* "scheduler run: progress-cb ~a ~a\n"
-                *count* (progress-info-status %info))
-  (force-output *stderr*)
-  (set! *count* (1+ *count*))
   (let ((status (progress-info-status %info)))
     (cond ((equal? status '(#:download #:start))
           (match (parse-c-progress-info %info)
@@ -58,22 +66,10 @@
          ((equal? status '(#:download #:completed))
           (match (parse-c-progress-info %info)
             (((%context cctx pctx sctx %uri %filename . _) . _)
-             (simple-format #t "Downloading `~a' done.\n"
-                            (pointer->string %filename))))))))
-
-(define (main args)
-  (let ((config (load-configuration config-file)))
-    (define (first-task _)
-      (simple-format *stderr* "scheduler run: first-task\n")
-      (force-output *stderr*)
-      (match args
-       ((binary-name output-filename uri-string)
-        (set! *fs-handle* (open-filesharing-service config binary-name
-                                                    progress-cb))
-        (let ((uri (parse-uri uri-string)))
-          (set! *dl-handle* (start-download *fs-handle* uri output-filename))
-          ;; add a timeout in 5 seconds
-          (simple-format *stderr* "scheduler add: timeout\n")
-          (force-output *stderr*)
-          (add-task! shutdown-task #:delay (time-rel #:seconds 5))))))
-    (call-with-scheduler config first-task)))
+             (simple-format #t "Downloaded `~a'.\n"
+                            (pointer->string %filename))))
+          ;; the download is complete, we want to execute the kill-task now
+          (schedule-shutdown!))
+         ((equal? status '(#:download #:stopped))
+          (set-next-task! (lambda (_)
+                            (close-filesharing-service! *fs-handle*)))))))
diff --git a/examples/publish.scm b/examples/publish.scm
index 73d0e00..cea056e 100755
--- a/examples/publish.scm
+++ b/examples/publish.scm
@@ -88,7 +88,6 @@ demanded ego or call IDENTITY-CONTINUATION."
   "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
@@ -98,19 +97,16 @@ IDENTITY-CONTINUATION."
 (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*))
+                                    (stop-directory-scan *dir-scanner*)
+                                    (close-filesharing-service! *fs-handle*))
                                   #:delay (time-rel #:seconds 5))))
    (else
     (simple-format #t "Error: no ego named ~a has been found!\n"
@@ -122,7 +118,6 @@ scan on *FILENAME*."
   "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)
      (cancel-task! *kill-task*)
@@ -136,7 +131,6 @@ start the publication by calling DIRSCAN-CONTINUATION."
 
 (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*
@@ -151,7 +145,6 @@ start the publication by calling DIRSCAN-CONTINUATION."
   "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)
@@ -159,7 +152,6 @@ and when it’s complete print the published file’s URI and 
stop the publicati
         (((%context %file-info cctx pctx %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)) _ _)
@@ -175,4 +167,5 @@ and when it’s complete print the published file’s URI and 
stop the publicati
                           (stop-publish *publish-handle*)))))
       ((#:stopped)
        (display "Publication stopped\n")
-       (schedule-shutdown!)))))
+       (set-next-task! (lambda (_)
+                        (close-filesharing-service! *fs-handle*)))))))
diff --git a/examples/search-ns.scm b/examples/search-ns.scm
index 713c908..60efc83 100755
--- a/examples/search-ns.scm
+++ b/examples/search-ns.scm
@@ -67,7 +67,7 @@
 
 (define (ego-continuation)
   (cond
-   ((not *ns-ego*) (simple-format #t "Error: ego ~a not found\n" *ns-name*))
+   ((not *ns-ego*) (simple-format #t "Error: ego `~a' not found\n" *ns-name*))
    (else
     (set! *fs-handle*     (open-filesharing-service *config* *binary-name*
                                                    progress-callback))
@@ -101,4 +101,7 @@
                  (simple-format #t "gnunet-download ~a\n" result-uri))
                 (else
                  (simple-format #t "gnunet-download -o \"~a\" ~a\n"
-                                result-filename result-uri)))))))))
+                                result-filename result-uri)))))))
+    (when (equal? '(#:search #:stopped) status)
+      (set-next-task!
+       (lambda (_) (close-filesharing-service! *fs-handle*))))))
diff --git a/examples/search.scm b/examples/search.scm
index 3516939..ed3cbec 100755
--- a/examples/search.scm
+++ b/examples/search.scm
@@ -32,28 +32,34 @@
 
 
 (define (progress-cb %info)
-  (when (equal? '(#:search #:result) (progress-info-status %info))
-    (match (parse-c-progress-info %info)
-      (((context _ _ query duration anonymity
-                (%metadata %uri %result applicability-rank)) _ _)
-       (let* ((uri  (uri->string (wrap-uri %uri)))
-             (meta (wrap-metadata %metadata))
-             (result-directory? (is-directory? meta))
-             (result-filename (metadata-ref meta #:original-filename)))
-        (cond ((and result-directory?
-                    (string-null? result-filename))
-               (simple-format
-                #t "gnunet-download -o \"collection.gnd\" -R ~a\n" uri))
-              (result-directory?
-               (simple-format #t
-                              "gnunet-download -o \"~a.gnd\" -R ~a\n"
-                              result-filename uri))
-              ((string-null? result-filename)
-               (simple-format #t "gnunet-download ~a\n"
-                              uri))
-              (else
-               (simple-format #t "gnunet-download -o \"~a\" ~a\n"
-                              result-filename uri))))))))
+  (let ((status (progress-info-status %info)))
+    (when (equal? '(#:search #:result) status)
+      (match (parse-c-progress-info %info)
+       (((context _ _ query duration anonymity
+                  (%metadata %uri %result applicability-rank)) _ _)
+        (let* ((uri  (uri->string (wrap-uri %uri)))
+               (meta (wrap-metadata %metadata))
+               (result-directory? (is-directory? meta))
+               (result-filename (metadata-ref meta #:original-filename)))
+          (cond ((and result-directory?
+                      (string-null? result-filename))
+                 (simple-format
+                  #t "gnunet-download -o \"collection.gnd\" -R ~a\n" uri))
+                (result-directory?
+                 (simple-format #t
+                                "gnunet-download -o \"~a.gnd\" -R ~a\n"
+                                result-filename uri))
+                ((string-null? result-filename)
+                 (simple-format #t "gnunet-download ~a\n"
+                                uri))
+                (else
+                 (simple-format #t "gnunet-download -o \"~a\" ~a\n"
+                                result-filename uri)))))))
+    (when (equal? '(#:search #:stopped) status)
+      (match (parse-c-progress-info %info)
+       ((_ _ %handle)
+        (set-next-task! (lambda (_)
+                          (close-filesharing-service! %handle))))))))
 
 (define (main args)
   (let ((config (load-configuration config-file)))
diff --git a/gnu/gnunet/fs.scm b/gnu/gnunet/fs.scm
index 8cd3169..2715157 100644
--- a/gnu/gnunet/fs.scm
+++ b/gnu/gnunet/fs.scm
@@ -33,6 +33,7 @@
             unwrap-file-information
 
             open-filesharing-service
+            close-filesharing-service!
             start-search
             stop-search
             start-download
@@ -63,6 +64,9 @@
 (define default-max-parallel-requests (* 1024 10))
 
 
+(define-gnunet-fs %fs-stop
+  "GNUNET_FS_stop" : '(*) -> void)
+
 (define-gnunet-fs %file-information-create-from-file
   "GNUNET_FS_file_information_create_from_file" :
     (list '* '* '* '* '* int '*) -> '*)
@@ -242,27 +246,32 @@ callback."
 ;;+TODO: dynamically allocate the entire structure & client-name, so that we 
can
 ;;       call GNUNET_FS_stop on the returned handle.
 (define (%fs-start %config %client-name %progress-callback)
-  (make-c-struct struct-fs-handle
-                (list %config
-                      %client-name
-                      %progress-callback
-                      %null-pointer            ; progress-cb closure
-                      %null-pointer            ; top_head
-                      %null-pointer            ; top_tail
-                      %null-pointer            ; running_head
-                      %null-pointer            ; running_tail
-                      %null-pointer            ; pending_head
-                      %null-pointer            ; pending_tail
-                      %null-pointer            ; probes_head
-                      %null-pointer            ; probes_tail
-                      %null-pointer            ; queue_job
-                      %null-pointer            ; probe_ping_task
-                      (time-rel #:minutes 1)   ; avg_block_latency
-                      0                        ; active_downloads
-                      0                        ; active_blocks
-                      0                        ; flags
-                      default-max-parallel-downloads
-                      default-max-parallel-requests)))
+  (let* ((size           (sizeof struct-fs-handle))
+         (%handle        (%malloc size))
+         (bv             (pointer->bytevector %handle size))
+         (write-c-struct (@@ (system foreign) write-c-struct)))
+    (write-c-struct bv 0 struct-fs-handle
+                    (list %config
+                          %client-name
+                          %progress-callback
+                          %null-pointer          ; progress-cb closure
+                          %null-pointer          ; top_head
+                          %null-pointer          ; top_tail
+                          %null-pointer          ; running_head
+                          %null-pointer          ; running_tail
+                          %null-pointer          ; pending_head
+                          %null-pointer          ; pending_tail
+                          %null-pointer          ; probes_head
+                          %null-pointer          ; probes_tail
+                          %null-pointer          ; queue_job
+                          %null-pointer          ; probe_ping_task
+                          (time-rel #:minutes 1) ; avg_block_latency
+                          0                      ; active_downloads
+                          0                      ; active_blocks
+                          0                      ; flags
+                          default-max-parallel-downloads
+                          default-max-parallel-requests))
+    %handle))
 
 (define (open-filesharing-service config client-name progress-callback)
   "Set up and return a handle to the filesharing service. CONFIG must be a
@@ -278,6 +287,16 @@ filesharing service (a search is started, a download is 
completed, etc.)."
        (throw 'invalid-result "open-filesharing-service" "%fs-start"
               %null-pointer)))
 
+(define (close-filesharing-service! handle)
+  "Close our connection to the filesharing service. OPEN-FILESHARING-SERVICE’s
+callback will not be called anymore after this function returns.
+
+WARNING: this function must *not* be called from OPEN-FILESHARING-SERVICE’s
+callback (it frees the handle which is still used after the callback returns).
+
+WARNING: the handle will be unusable after this function returns."
+  (%fs-stop handle))
+
 (define (start-search filesharing-handle uri)
   (or% (%search-start filesharing-handle
                       (unwrap-uri uri)