[gnunet-scheme] 03/03: cadet/client: Handle closing channels.

[gnunet]

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

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

commit ca548283b2a3141b2814c778af567b05ea32f5bc
Author: Maxime Devos <maximedevos@telenet.be>
AuthorDate: Mon Aug 29 13:35:34 2022 +0200

    cadet/client: Handle closing channels.
    
    * gnu/gnunet/cadet/client.scm
    (<channel>)[channel-number]: Add relationship with desire-close?
    (<channel>)[desire-close?]: New field.
    (<channel>)(protocol): Adjust constructor to new field.
    (reconnect)[close-if-possible!]: New procedure.
    (reconnect)[control*]{send-channel-stuff!} Add TODO.
    (reconnect)[control*]{send-channel-stuff!}: Use new procedure.
    (reconnect)[control*]<close-channel!> Handle completely, using
    new 'desire-close?' and 'close-if-possible!'.
    * tests/cadet.scm
    ("msg:cadet:local:channel:destroy is sent when closing channels"):
    Unskip test with now implemented code. Fix return value.
---
 gnu/gnunet/cadet/client.scm | 59 ++++++++++++++++++++++++++++++++++++++++-----
 tests/cadet.scm             |  4 +--
 2 files changed, 55 insertions(+), 8 deletions(-)

diff --git a/gnu/gnunet/cadet/client.scm b/gnu/gnunet/cadet/client.scm
index acd0dfe..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)
@@ -89,7 +90,7 @@
                case else = define-syntax + expt - let* let and >
                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)
@@ -122,11 +123,18 @@
              ;; 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.  When a channel is closed, it is
-             ;; set to #true.
+             ;; 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.
@@ -139,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))
@@ -221,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'
@@ -290,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)
@@ -304,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.