[gnunet-scheme] branch master updated (51336ae -> 582ac1e)

[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 51336ae  cadet/struct: Define /:msg:cadet:command-line-traffic.
     new 8b1c8d1  cadet/client: Add a message queue to the <channel> API.
     new 4360b73  cadet/client: Accept some message handlers as well.
     new 4267734  cadet/client: Actually define a message queue when opening a 
channel.
     new 3212a29  cadet/client: Send message queue flushing requests to the 
main event loop.
     new 582ac1e  cadet/client: Actually put the message-queue in the <channel>.

The 5 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 | 42 ++++++++++++++++++++++++++++++++++++------
 1 file changed, 36 insertions(+), 6 deletions(-)

diff --git a/gnu/gnunet/cadet/client.scm b/gnu/gnunet/cadet/client.scm
index 5ae4ef8..d77df43 100644
--- a/gnu/gnunet/cadet/client.scm
+++ b/gnu/gnunet/cadet/client.scm
@@ -19,6 +19,7 @@
   (export connect disconnect!
          make-cadet-address cadet-address? cadet-address-peer 
cadet-address-port
          channel? open-channel! close-channel!
+         channel-message-queue
          port? open-port! close-port!
          %max-cadet-message-size
 
@@ -64,6 +65,7 @@
                /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 netstruct syntactic)
                sizeof select read% set%!)
          (only (gnu gnunet utils bv-slice)
@@ -84,7 +86,9 @@
          (only (fibers conditions) make-condition wait-operation
                signal-condition!)
          (only (fibers operations)
-               wrap-operation choice-operation perform-operation))
+               wrap-operation choice-operation perform-operation)
+         (only (srfi srfi-45)
+               delay force))
   (begin
     (define-record-type (<server:cadet> %make-server server:cadet?)
       (parent <server>)
@@ -105,11 +109,12 @@
              ;; a channel number is assigned.  After a reconnect, channel
              ;; numbers are reset.
              (mutable channel-number channel-channel-number
-                      set-channel-channel-number!))
+                      set-channel-channel-number!)
+             (immutable message-queue channel-message-queue)) ; <message-queue>
       (protocol (lambda (%make)
-                 (lambda (server destination options)
+                 (lambda (server destination options message-queue)
                    ((%make (losable-lost-and-found server)) server
-                    destination options #false)))))
+                    destination options #false message-queue)))))
 
     (define* (connect config #:key (connected values) (disconnected values)
                      (spawn spawn-fiber))
@@ -166,6 +171,10 @@
           ;; TODO: no operations and no channels are implemented yet,
           ;; so for now nothing can be done.
           (continue))
+         (('send-channel-stuff! message-queue channel)
+          ;; Tell the service to send the messages over CADET.
+          TODO
+          (continue))
          (('lost . lost)
           (let loop ((lost lost))
             (match lost
@@ -317,12 +326,33 @@ message @var{message}."
       (error "todo"))
 
     ;; TODO: callbacks, message queue, actually test it
-    (define* (open-channel! server address)
+    (define* (open-channel! server address handlers)
       (assert (and (server:cadet? server) (cadet-address? address)))
-      (define channel (%make-channel server address 0))
+      (define error-handler stub)
+      (define sender (make-channel-sender (delay channel)))
+      (define closer stub)
+      (define message-queue
+       (make-message-queue handlers
+                           error-handler
+                           (make-channel-sender (delay channel))
+                           closer))
+      (define channel (%make-channel server address 0 message-queue))
       (maybe-send-control-message! server 'open-channel! channel)
       channel)
 
+    (define (make-channel-sender channel-promise)
+      (lambda (message-queue)
+       (define channel (force channel-promise))
+       (define server (channel-server channel))
+       ;; Ask the main event loop to send messages.
+       ;; We could use 'make-one-by-one' sender to ask the main event
+       ;; loop to send them (one-by-one), but such ping-ponging seems
+       ;; much slower than needed (unverified).
+       (maybe-send-control-message! server
+                                    'send-channel-stuff!
+                                    message-queue
+                                    (force channel-promise))))
+
     ;; TODO: call when mq is closed, maybe unify closing the message queue
     ;; and the channel?
     (define (close-channel! channel)

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