[gnunet-scheme] branch master updated (a9dbb6e -> ca54828)

[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 a9dbb6e  data-string: Do not select imports.
     new e2458a6  cadet/client: Mark some channel-number behaviour as 
unimplemented.
     new 4db6fcc  cadet/client: Add a 'closed' state to <channel>.
     new ca54828  cadet/client: Handle closing channels.

The 3 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 | 68 +++++++++++++++++++++++++++++++++++++++------
 tests/cadet.scm             |  4 +--
 2 files changed, 61 insertions(+), 11 deletions(-)

diff --git a/gnu/gnunet/cadet/client.scm b/gnu/gnunet/cadet/client.scm
index 83234e9..e296e5a 100644
--- a/gnu/gnunet/cadet/client.scm
+++ b/gnu/gnunet/cadet/client.scm
@@ -57,7 +57,8 @@
          (only (gnu gnunet mq handler)
                message-handlers message-handler)
          (only (gnu gnunet mq)
-               close-queue! send-message! make-one-by-one-sender)
+               close-queue! send-message! make-one-by-one-sender
+               message-queue-length)
          (only (gnu gnunet mq envelope)
                attempt-irrevocable-sent!)
          (only (gnu gnunet server)
@@ -87,9 +88,9 @@
          (only (rnrs base)
                begin define lambda assert quote cons apply values
                case else = define-syntax + expt - let* let and >
-               not if)
+               not if eq?)
          (only (rnrs control)
-               unless)
+               when unless)
          (only (rnrs hashtables)
                make-eqv-hashtable hashtable-ref hashtable-set!)
          (only (rnrs records syntactic) define-record-type)
@@ -121,10 +122,19 @@
              (immutable options channel-options)
              ;; Initially #false, when no channel number has been chosen yet
              ;; by the client.  When the control loop accepts the <channel>,
-             ;; a channel number is assigned.  After a reconnect, channel
-             ;; numbers are reset.
+             ;; a channel number is assigned.  When a channel is closed, it is
+             ;; set to #true, but only after the remaining messages have been
+             ;; sent to the service.  Before setting this to #true, 
'desire-close?'
+             ;; must be #true.
+             ;;
+             ;; After a reconnect, channel numbers are reset (TODO: implement 
that).
              (mutable channel-number channel-channel-number
                       set-channel-channel-number!)
+             ;; Initially #false.  Set to #true when a close is requested.  
Cannot
+             ;; revert to #false.  If #true, then once all messages have been 
sent
+             ;; to the service, channel-number must be set to #true.
+             (mutable desire-close? channel-desire-close?
+                      set-channel-desire-close?)
              (immutable message-queue channel-message-queue) ; <message-queue>
              ;; (Natural number, possibly zero) The number of messages the 
service
              ;; currently allows the the client to send to the service.
@@ -137,7 +147,7 @@
       (protocol (lambda (%make)
                  (lambda (server destination options message-queue)
                    ((%make (losable-lost-and-found server)) server
-                    destination options #false message-queue 0)))))
+                    destination options #false #false message-queue 0)))))
 
     (define* (connect config #:key (connected values) (disconnected values)
                      (spawn spawn-fiber))
@@ -161,7 +171,8 @@
     ;; channel-number->channel-hash-map:
     ;;   A hash map from channel numbers to their corresponding
     ;;   <channel> object, or nothing if the control loop
-    ;;   has not processes 'open-channel!' yet.
+    ;;   has not processes 'open-channel!' yet or if the channel
+    ;;   has been closed.
     ;;
     ;;   TODO: GC problems, split in external and internal parts
     (define (reconnect config terminal-condition control-channel
@@ -218,11 +229,24 @@
        "The main event loop."
        (control* next-free-channel-number
                  (perform-operation loop-operation)))
+      (define (close-if-possible! channel)
+       ;; Pre-conditions:
+       ;;  * the channel is open
+       ;;  * and a close has been requested
+       ;;
+       ;; TODO: untested.
+       (when (= (message-queue-length (channel-message-queue channel)) 0)
+         (send-message! mq
+                        (construct-local-channel-destroy
+                         (channel-channel-number channel)))
+         ;; We don't need the envelope.
+         (values)))
       (define (control* next-free-channel-number message)
        (define (continue)
          (control next-free-channel-number))
        (define (continue* message)
          (control* next-free-channel-number message))
+       ;; TODO: what about closed channels?
        (define (send-channel-stuff! channel)
          ;; Send messages one-by-one, keeping in mind that we might not be able
          ;; to send all messages to the service at once, only 
'channel-allow-send'
@@ -287,7 +311,9 @@
             ;; The mutation 'duplicate it' is uncaught, but theoretically 
harmless
             ;; albeit inefficient.
             (stop-if-exhausted))
-          ((make-one-by-one-sender send!) (channel-message-queue channel))))
+          ((make-one-by-one-sender send!) (channel-message-queue channel)))
+         (when (channel-desire-close? channel)
+           (close-if-possible! channel)))
        (match message
          (('open-channel! channel)
           (let* ((channel-number next-free-channel-number)
@@ -301,7 +327,31 @@
                             channel)
             (send-local-channel-create! mq channel)
             (control next-free-channel-number)))
-         (('close-channel! channel) TODO)
+         (('close-channel! channel)
+          ;; 'close-channel!' can only be sent after the <channel> object
+          ;; was returned by the procedure 'open-channel!', because only
+          ;; then the channel becomes available. This procedure 
(synchronuously)
+          ;; sends a 'open-channel!' message and messages are processed by
+          ;; the control loop in-order, so the channel has already been opened.
+          ;;
+          ;; The only remaining states are: the channel is open / the channel
+          ;; is closed.
+          (let^ ((! channel-number (channel-channel-number channel))
+                 (? (channel-desire-close? channel)
+                    ;; It has already been requested to close to channel
+                    ;; (maybe it even has already been closed).  This is fine,
+                    ;; as 'close-channel!' is idempotent.  Nothing to do!
+                    ;; TODO: untested.
+                    (continue)))
+                (set-channel-desire-close? channel #true)
+                ;; This procedure will take care of actually closing the 
channel
+                ;; (if currently possible).  If it's not currently possible
+                ;; due to a lack of acknowledgements, then a future 
'send-channel-stuff!'
+                ;; (in response to an 'acknowledgement' message) will take 
care of things.
+                ;;
+                ;; TODO: untested.  TODO: untested in case of reconnects.
+                (close-if-possible! channel)
+                (continue)))
          (('resend-old-operations!)
           ;; TODO: no operations and no channels are implemented yet,
           ;; so for now nothing can be done.
diff --git a/tests/cadet.scm b/tests/cadet.scm
index 9a1b0d7..53eaeb2 100644
--- a/tests/cadet.scm
+++ b/tests/cadet.scm
@@ -398,7 +398,6 @@
        #:hz 0
        #:parallelism 1)))))
 
-(test-skip 1) ; TODO: 'close-channel!' is not yet handled
 ;; TODO: extend test to multiple channels, making sure the destroy is sent
 ;; for the right channel.
 (test-assert
@@ -461,6 +460,7 @@
        (open-channel! server address0 (message-handlers)))
       (wait created-condition)
       (close-channel! channel)
-      (wait closed-condition)))))
+      (wait closed-condition)
+      #true))))
 
 (test-end "CADET")

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