[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[gnunet-scheme] 24/42: cadet/client: Re-indent.
From: |
gnunet |
Subject: |
[gnunet-scheme] 24/42: cadet/client: Re-indent. |
Date: |
Sat, 10 Sep 2022 19:08:17 +0200 |
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 97e0228198a6d57a94e43c7fd977659a26281b4c
Author: Maxime Devos <maximedevos@telenet.be>
AuthorDate: Fri Sep 9 17:32:16 2022 +0200
cadet/client: Re-indent.
---
gnu/gnunet/cadet/client.scm | 183 ++++++++++++++++++++++----------------------
1 file changed, 92 insertions(+), 91 deletions(-)
diff --git a/gnu/gnunet/cadet/client.scm b/gnu/gnunet/cadet/client.scm
index 7772cd5..4f00126 100644
--- a/gnu/gnunet/cadet/client.scm
+++ b/gnu/gnunet/cadet/client.scm
@@ -92,7 +92,7 @@
(only (rnrs control)
when)
(only (pfds bbtrees)
- bbtree-set make-bbtree bbtree-ref)
+ bbtree-set make-bbtree bbtree-ref)
(only (rnrs records syntactic) define-record-type)
(only (ice-9 control) let/ec)
(only (ice-9 match) match)
@@ -157,8 +157,7 @@
#:service-name "cadet"
#:configuration config
#:initial-extra-loop-arguments
- (list empty-bbtree %minimum-local-channel-id)
- r))
+ (list empty-bbtree %minimum-local-channel-id) r))
;; channel-number->channel-map:
;; A 'bbtree' from channel numbers to their corresponding
@@ -203,98 +202,100 @@
(loop:terminal-condition loop) (loop:control-channel loop)
'acknowledgement channel-number))))))
- (define (control-message-handler message control control* message-queue
loop
+ (define (close-if-possible! message-queue 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! message-queue
+ (construct-local-channel-destroy
+ (channel-channel-number channel)))
+ ;; We don't need the envelope.
+ (values)))
+
+ ;; TODO: what about closed channels?
+ (define (send-channel-stuff! message-queue 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'
+ ;; messages can be sent and this decreases by sending messages.
+ ;;
+ ;; TODO: use priority information, somehow when cancelling a message
+ ;; cancel the corresponding message to be sent to the CADET service when
+ ;; there is still time, zero-copy networking.
+ (let/ec
+ stop
+ (define (stop-if-exhausted)
+ ;; The mutation 'replace > by >=' is caught by
+ ;; "data is not sent before an acknowledgement"
+ ;; in form of a hang.
+ (if (> (channel-allow-send channel) 0)
+ ;; (unless ...) and (when ...) can return *unspecified*,
+ ;; but (gnu gnunet mq) expects no return values. Detected
+ ;; by the "data is properly sent in response to acknowledgements,
+ ;; in-order" test.
+ (values)
+ (stop)))
+ ;; Tested by ‘data is properly sent in response to acknowledgements,
+ ;; in-order’ -- it catches the mutation 'replace 1 by zero' (as a hang)
+ (define (decrement!)
+ (set-channel-allow-send! channel
+ (- (channel-allow-send channel) 1)))
+ ;; It is important to check that a message can be sent before
+ ;; send! is called, otherwise the message will be removed from
+ ;; the message queue and be forgotten without being ever sent.
+ ;;
+ ;; Tested by ‘data is not sent before an acknowledgement’ -- it catches
+ ;; the mutation 'remove this line' (as a hang).
+ (stop-if-exhausted)
+ (define (send! envelope)
+ (attempt-irrevocable-sent!
+ envelope
+ ((go message priority)
+ ;; The mutation ‘don't call send-message!’ is caught by
+ ;; ‘data is properly sent in response to acknowledgements, in-order’
+ ;; as a hang and an exception.
+ ;;
+ ;; The mutation 'swap send-message!' and 'decrement!' is uncaught,
+ ;; but theoretically harmless.
+ ;; TODO: maybe get rid of the message queue limit in (gnu gnunet mq)
+ (send-message! message-queue
+ (construct-local-data
+ (channel-channel-number channel) ; TODO: multiple
channels is untested
+ 0 ;; TODO: relation between priority and
priority-preference?
+ message)) ; TODO: sending the _right_ message is
untested
+ ;; The mutation ‘don't call decrement!' is caught by
+ ;; ‘data is properly sent in response to acknowledgements, in-order’,
+ ;; as a hang with an exception.
+ (decrement!))
+ ((cancelled) (values)) ; TODO: untested
+ ((already-sent) (error "tried to send an envelope twice (CADET)")))
+ ;; Exit once nothing can be sent anymore (TODO check if
+ ;; make-one-by-one-sender allows non-local exits).
+ ;;
+ ;; The mutation 'don't call it' is caught by
+ ;; ‘data is properly sent in response to acknowledgements, in-order’
+ ;; as a hang and an exception?
+ ;;
+ ;; The mutation 'duplicate it' is uncaught, but theoretically harmless
+ ;; albeit inefficient.
+ (stop-if-exhausted))
+ ((make-one-by-one-sender send!) (channel-message-queue channel)))
+ (when (channel-desire-close? channel)
+ (close-if-possible! message-queue channel)))
+
+ (define (control-message-handler message control control* message-queue loop
channel-number->channel-map
next-free-channel-number)
"The main event loop"
(define (k/reconnect! channel-number->channel-map)
(run-loop loop channel-number->channel-map next-free-channel-number))
- (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! message-queue
- (construct-local-channel-destroy
- (channel-channel-number channel)))
- ;; We don't need the envelope.
- (values)))
(define (continue)
(control loop channel-number->channel-map next-free-channel-number))
(define (continue* message)
(control* message loop channel-number->channel-map
next-free-channel-number))
- ;; 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'
- ;; messages can be sent and this decreases by sending messages.
- ;;
- ;; TODO: use priority information, somehow when cancelling a message
- ;; cancel the corresponding message to be sent to the CADET service when
- ;; there is still time, zero-copy networking.
- (let/ec
- stop
- (define (stop-if-exhausted)
- ;; The mutation 'replace > by >=' is caught by
- ;; "data is not sent before an acknowledgement"
- ;; in form of a hang.
- (if (> (channel-allow-send channel) 0)
- ;; (unless ...) and (when ...) can return *unspecified*,
- ;; but (gnu gnunet mq) expects no return values. Detected
- ;; by the "data is properly sent in response to
acknowledgements, in-order"
- ;; test.
- (values)
- (stop)))
- ;; Tested by ‘data is properly sent in response to acknowledgements,
in-order’
- ;; -- it catches the mutation 'replace 1 by zero' (as a hang)
- (define (decrement!)
- (set-channel-allow-send! channel
- (- (channel-allow-send channel) 1)))
- ;; It is important to check that a message can be sent before
- ;; send! is called, otherwise the message will be removed from
- ;; the message queue and be forgotten without being ever sent.
- ;;
- ;; Tested by ‘data is not sent before an acknowledgement’ -- it catches
- ;; the mutation 'remove this line' (as a hang).
- (stop-if-exhausted)
- (define (send! envelope)
- (attempt-irrevocable-sent!
- envelope
- ((go message priority)
- ;; The mutation ‘don't call send-message!’ is caught by
- ;; ‘data is properly sent in response to acknowledgements,
in-order’
- ;; as a hang and an exception.
- ;;
- ;; The mutation 'swap send-message!' and 'decrement!' is uncaught,
- ;; but theoretically harmless.
- ;; TODO: maybe get rid of the message queue limit in (gnu gnunet
mq)
- (send-message! message-queue
- (construct-local-data
- (channel-channel-number channel) ; TODO: multiple
channels is untested
- 0 ;; TODO: relation between priority and
priority-preference?
- message)) ; TODO: sending the _right_ message is
untested
- ;; The mutation ‘don't call decrement!' is caught by
- ;; ‘data is properly sent in response to acknowledgements,
in-order’,
- ;; as a hang with an exception.
- (decrement!))
- ((cancelled) (values)) ; TODO: untested
- ((already-sent) (error "tried to send an envelope twice (CADET)")))
- ;; Exit once nothing can be sent anymore (TODO check if
- ;; make-one-by-one-sender allows non-local exits).
- ;;
- ;; The mutation 'don't call it' is caught by
- ;; ‘data is properly sent in response to acknowledgements, in-order’
- ;; as a hang and an exception?
- ;;
- ;; The mutation 'duplicate it' is uncaught, but theoretically
harmless
- ;; albeit inefficient.
- (stop-if-exhausted))
- ((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)
@@ -331,7 +332,7 @@
;; (in response to an 'acknowledgement' message) will take care
of things.
;;
;; TODO: untested. TODO: untested in case of reconnects.
- (close-if-possible! channel)
+ (close-if-possible! message-queue channel)
(continue)))
(('resend-old-operations!)
;; TODO: no operations and no channels are implemented yet,
@@ -346,17 +347,17 @@
(set-channel-allow-send!
channel (+ 1 (channel-allow-send channel)))
;; Actually send some message, if there are any to send.
- (send-channel-stuff! channel)
+ (send-channel-stuff! message-queue channel)
(continue)))
- (('send-channel-stuff! message-queue channel)
+ (('send-channel-stuff! message-queue/channel channel)
;; Tell the service to send the messages over CADET.
- (send-channel-stuff! channel)
+ (send-channel-stuff! message-queue channel)
(continue))
;; Respond to a query of the msg:cadet:local:data message handler.
(('channel answer-box channel-number)
(answer answer-box
- (bbtree-ref channel-number->channel-map
- channel-number (lambda () #false)))
+ (bbtree-ref channel-number->channel-map channel-number
+ (lambda () #false)))
(continue))
(('lost . lost)
(let loop ((lost lost))
--
To stop receiving notification emails like this one, please contact
gnunet@gnunet.org.
- [gnunet-scheme] 12/42: Revert "server: Only accept a single 'state' argument.", (continued)
- [gnunet-scheme] 12/42: Revert "server: Only accept a single 'state' argument.", gnunet, 2022/09/10
- [gnunet-scheme] 16/42: cadet/client: Avoid (mutating) hash tables., gnunet, 2022/09/10
- [gnunet-scheme] 05/42: dht/client: Bring API of reconnect mostly in line with (gnu gnunet server)., gnunet, 2022/09/10
- [gnunet-scheme] 28/42: server: Inline primitive-disconnect!., gnunet, 2022/09/10
- [gnunet-scheme] 15/42: server: New procedure for making the arguments to make-loop., gnunet, 2022/09/10
- [gnunet-scheme] 17/42: cadet/client: Use <loop> for various objects where possible., gnunet, 2022/09/10
- [gnunet-scheme] 27/42: cadet/client: Simplify more., gnunet, 2022/09/10
- [gnunet-scheme] 23/42: dht/client: Re-indent., gnunet, 2022/09/10
- [gnunet-scheme] 22/42: nse/indent: Re-indent., gnunet, 2022/09/10
- [gnunet-scheme] 26/42: server: Inline single-use server->loop-arguments., gnunet, 2022/09/10
- [gnunet-scheme] 24/42: cadet/client: Re-indent.,
gnunet <=
- [gnunet-scheme] 33/42: server: Document 'make-loop'., gnunet, 2022/09/10
- [gnunet-scheme] 30/42: doc/service-communication: Document the control loop., gnunet, 2022/09/10
- [gnunet-scheme] 18/42: cadet/client: Rewrite with run-loop., gnunet, 2022/09/10
- [gnunet-scheme] 32/42: server: Add type checking to make-loop., gnunet, 2022/09/10
- [gnunet-scheme] 36/42: doc/concurrency: Add missing label for lost-and-found., gnunet, 2022/09/10
- [gnunet-scheme] 39/42: server: Add type checking., gnunet, 2022/09/10
- [gnunet-scheme] 35/42: doc/service-communication: Document #:control-message-handler., gnunet, 2022/09/10
- [gnunet-scheme] 37/42: doc/service-communication: Document run-loop., gnunet, 2022/09/10
- [gnunet-scheme] 34/42: server: Rename control -> continue., gnunet, 2022/09/10
- [gnunet-scheme] 38/42: doc/service-communication: Add procedures to the index., gnunet, 2022/09/10