[gnunet-scheme] branch master updated (d6c0a8b -> e690ca1)

[gnunet]

This is an automated email from the git hooks/post-receive script.

maxime-devos pushed a change to branch master
in repository gnunet-scheme.

    from d6c0a8b  cadet/client: Handle acknowledgements.
     new 3110dd7  dht/client: Extract question-response code.
     new e690ca1  cadet/client: Process received msg:cadet:local:data messages.

The 2 revisions listed above as "new" are entirely new to this
repository and will be described in separate emails.  The revisions
listed as "add" were already present in the repository and have only
been added to this reference.


Summary of changes:
 gnu/gnunet/cadet/client.scm | 28 +++++++++++++++++++++++++++-
 gnu/gnunet/dht/client.scm   | 22 +++++++++-------------
 gnu/gnunet/server.scm       | 22 ++++++++++++++++++++--
 3 files changed, 56 insertions(+), 16 deletions(-)

diff --git a/gnu/gnunet/cadet/client.scm b/gnu/gnunet/cadet/client.scm
index de7d8f0..f8b3e71 100644
--- a/gnu/gnunet/cadet/client.scm
+++ b/gnu/gnunet/cadet/client.scm
@@ -61,6 +61,7 @@
          (only (gnu gnunet mq envelope)
                attempt-irrevocable-sent!)
          (only (gnu gnunet server)
+               maybe-ask* answer
                maybe-send-control-message!
                maybe-send-control-message!*
                make-error-handler
@@ -72,7 +73,8 @@
                /hashcode:512)
          (only (gnu gnunet message protocols) message-type)
          (only (gnu gnunet mq-impl stream) connect/fibers)
-         (only (gnu gnunet mq) make-message-queue)
+         (only (gnu gnunet mq)
+               make-message-queue inject-message!)
          (only (gnu gnunet netstruct syntactic)
                sizeof select read% set%!)
          (only (gnu gnunet utils bv-slice)
@@ -175,6 +177,24 @@
                         (lambda (lost) (cons 'lost lost)))))
       (define handlers
        (message-handlers
+        (message-handler
+         (type (symbol-value message-type msg:cadet:local:data))
+         ((interpose exp) exp)
+         ((well-formed? slice) #true)
+         ((handle! slice)
+          (let^ ((! cadet-data-length (sizeof /:msg:cadet:local:data '()))
+                 (! header (slice-slice slice 0 cadet-data-length))
+                 (! tail (slice-slice slice cadet-data-length))
+                 (! channel-number
+                    (read% /:msg:cadet:local:data '(channel-number) header))
+                 (! channel
+                    (maybe-ask* terminal-condition control-channel 'channel
+                                channel-number))
+                 (? (not channel)
+                    ???))
+                ;; TODO: while the message is being processed, other messages
+                ;; cannot be accepted -- document this limitation.
+                (inject-message! mq tail))))
         (message-handler
          (type (symbol-value message-type msg:cadet:local:acknowledgement))
          ((interpose exp) exp)
@@ -278,6 +298,12 @@
           ;; Tell the service to send the messages over CADET.
           (send-channel-stuff! channel)
           (continue))
+         ;; Respond to a query of the msg:cadet:local:data message handler.
+         (('channel answer-box channel-number)
+          (answer answer-box
+                  (hashtable-ref channel-number->channel-hash-map
+                                 channel-number #false))
+          (continue))
          (('lost . lost)
           (let loop ((lost lost))
             (match lost
diff --git a/gnu/gnunet/dht/client.scm b/gnu/gnunet/dht/client.scm
index 1c6a479..55ba62a 100644
--- a/gnu/gnunet/dht/client.scm
+++ b/gnu/gnunet/dht/client.scm
@@ -80,7 +80,7 @@
          (gnu gnunet mq envelope)
          (only (gnu gnunet server)
                maybe-send-control-message! maybe-send-control-message!*
-               make-error-handler
+               make-error-handler maybe-ask* answer
                <server> server-terminal-condition server-control-channel
                make-disconnect! handle-control-message!)
          (only (guile)
@@ -103,7 +103,7 @@
          (only (fibers operations)
                perform-operation choice-operation wrap-operation)
          (only (fibers channels)
-               make-channel put-operation get-operation get-message 
put-message)
+               put-operation get-operation put-message)
          (only (gnu gnunet concurrency lost-and-found)
                make-lost-and-found collect-lost-and-found-operation
                losable-lost-and-found)
@@ -797,14 +797,10 @@ unique id @var{unique-id}.  If there is no such get 
operation, or the get
 operation is cancelled, return @code{#false} instead."
        ;; It is possible to look at id->operation-map directly instead,
        ;; but hash tables are thread-unsafe.
-       ;; TODO: reduce allocations
-       (define response-channel (make-channel))
        ;; TODO: is the 'terminal-condition' case needed?
-       (and (maybe-send-control-message!* terminal-condition control-channel
-                                          'request-search-result-iterator
-                                          unique-id
-                                          response-channel)
-            (get-message response-channel)))
+       (maybe-ask* terminal-condition control-channel
+                   'request-search-result-iterator
+                   unique-id))
       (define handlers
        (message-handlers
         (message-handler
@@ -906,10 +902,10 @@ operation is cancelled, return @code{#false} instead."
           ;; Continue!
           (control))
          ;; Send by @code{request-search-result-iterator}.
-         (('request-search-result-iterator unique-id response-channel)
-          (put-message response-channel
-                       (and=> (hashv-ref id->operation-map unique-id)
-                              dereference))
+         (('request-search-result-iterator answer-box unique-id)
+          (answer answer-box
+                  (and=> (hashv-ref id->operation-map unique-id)
+                         dereference))
           ;; Continue!
           (control))
          (('resend-old-operations!)
diff --git a/gnu/gnunet/server.scm b/gnu/gnunet/server.scm
index 0c60dab..ca1b1e2 100644
--- a/gnu/gnunet/server.scm
+++ b/gnu/gnunet/server.scm
@@ -19,19 +19,20 @@
 ;; TODO: document
 (define-library (gnu gnunet server)
   (export maybe-send-control-message!* maybe-send-control-message!
+         maybe-ask* answer
          make-error-handler
          <server> server-terminal-condition server-control-channel
          make-disconnect!
          handle-control-message!)
   (import (only (rnrs base)
                begin define case else apply values quote lambda
-               if error list)
+               if error list let and)
          (only (rnrs records syntactic)
                define-record-type)
          (only (fibers conditions)
                make-condition wait-operation signal-condition!)
          (only (fibers channels)
-               make-channel put-operation)
+               make-channel put-operation put-message get-message)
          (only (fibers operations)
                choice-operation perform-operation wrap-operation)
          (only (gnu gnunet concurrency lost-and-found)
@@ -74,6 +75,23 @@ values are the same as for 
@code{maybe-send-control-message!*}."
       (apply maybe-send-control-message!* (server-terminal-condition server)
             (server-control-channel server) message))
 
+    (define (maybe-ask* terminal-condition control-channel question . rest)
+      "Maybe-send a list @code{(question answer-box . rest)} to the control 
channel of
+the server.  The control channel should put an answer in the answer box with
+@code{answer}, when done so, the response value is returned.  In case of a 
permanent
+disconnect, @code{#false} is returned.
+
+The type of @var{answer-box} is an implementation detail."
+      (let ((response-channel (make-channel)))
+       (and (apply maybe-send-control-message!* terminal-condition
+                   control-channel question response-channel rest)
+            (get-message response-channel))))
+
+    (define (answer answer-box answer)
+      "The counterpart of @code{maybe-ask*}."
+      (put-message answer-box answer)
+      (values)) ; for backtraces, if the type of @var{answer-box} is incorrect
+
     (define (make-error-handler connected disconnected terminal-condition 
control-channel)
       (define (error-handler key . arguments)
        (case key

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