[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[gnunet-scheme] 17/42: cadet/client: Use <loop> for various objects wher
From: |
gnunet |
Subject: |
[gnunet-scheme] 17/42: cadet/client: Use <loop> for various objects where possible. |
Date: |
Sat, 10 Sep 2022 19:08:10 +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 3c649c8727afdc24ed635a1f1ca7dda23463b783
Author: Maxime Devos <maximedevos@telenet.be>
AuthorDate: Fri Sep 9 15:25:09 2022 +0200
cadet/client: Use <loop> for various objects where possible.
Fits better in (gnu gnunet server) that way.
* gnu/gnunet/cadet/client.scm (reconnect): Use <loop> for various
arguments.
(connect): Adjust to new API.
(spawn-procedure): Remove now unused procedure.
---
gnu/gnunet/cadet/client.scm | 73 ++++++++++++++++++++++-----------------------
1 file changed, 36 insertions(+), 37 deletions(-)
diff --git a/gnu/gnunet/cadet/client.scm b/gnu/gnunet/cadet/client.scm
index af58f32..04ceb35 100644
--- a/gnu/gnunet/cadet/client.scm
+++ b/gnu/gnunet/cadet/client.scm
@@ -70,7 +70,11 @@
make-disconnect!
server-terminal-condition
server-control-channel
- handle-control-message!)
+ handle-control-message!
+ make-loop run-loop server->loop-arguments loop:control-channel
+ loop:lost-and-found loop:terminal-condition loop:configuration
+ loop:spawner loop:connected loop:disconnected
+ make-error-handler*/loop)
(only (gnu gnunet hashcode struct)
/hashcode:512)
(only (gnu gnunet message protocols) message-type)
@@ -159,18 +163,16 @@
"Asynchronuously connect to the CADET service, using the configuration
@var{config}, returning a CADET server object."
(define server (%make-server))
- (spawn-procedure spawn config
- (server-terminal-condition server)
- (server-control-channel server)
- connected disconnected spawn
- (losable-lost-and-found server)
- empty-bbtree)
+ (define loop
+ (apply make-loop
+ #:configuration config
+ #:connected connected
+ #:disconnected disconnected
+ #:spawn spawn
+ (server->loop-arguments server)))
+ (spawn (lambda () (reconnect loop empty-bbtree)))
server)
- ;; TODO: reduce duplication with (gnu gnunet dht client)
- (define (spawn-procedure spawn . rest)
- (spawn (lambda () (apply reconnect rest))))
-
;; channel-number->channel-map:
;; A 'bbtree' from channel numbers to their corresponding
;; <channel> object, or nothing if the control loop
@@ -178,14 +180,11 @@
;; has been closed.
;;
;; TODO: GC problems, split in external and internal parts
- (define (reconnect config terminal-condition control-channel
- connected disconnected spawn
- lost-and-found
- channel-number->channel-map)
+ (define (reconnect loop channel-number->channel-map)
(define loop-operation
(choice-operation
- (get-operation control-channel)
- (wrap-operation (collect-lost-and-found-operation lost-and-found)
+ (get-operation (loop:control-channel loop))
+ (wrap-operation (collect-lost-and-found-operation (loop:lost-and-found
loop))
(lambda (lost) (cons 'lost lost)))))
(define handlers
(message-handlers
@@ -200,7 +199,8 @@
(! channel-number
(read% /:msg:cadet:local:data '(channel-number) header))
(! channel
- (maybe-ask* terminal-condition control-channel 'channel
+ (maybe-ask* (loop:terminal-condition loop)
+ (loop:control-channel loop) 'channel
channel-number))
(? (not channel)
???))
@@ -216,21 +216,20 @@
;; The slice needs to be read here (and not in 'control'), as it
might
;; later be reused for something different.
(let ((channel-number (analyse-local-acknowledgement slice)))
- (maybe-send-control-message!* terminal-condition control-channel
- 'acknowledgement
- channel-number))))))
- (define error-handler
- (make-error-handler connected disconnected terminal-condition
- control-channel))
- (define mq (connect/fibers config "cadet" handlers error-handler
- #:spawn spawn))
+ (maybe-send-control-message!*
+ (loop:terminal-condition loop)
+ (loop:control-channel loop)
+ 'acknowledgement
+ channel-number))))))
+ (define error-handler (make-error-handler*/loop loop))
+ (define mq (connect/fibers
+ (loop:configuration loop) "cadet" handlers error-handler
+ #:spawn (loop:spawner loop)))
(define (k/reconnect! channel-number->channel-map)
- (reconnect config terminal-condition control-channel connected
- disconnected spawn lost-and-found
- channel-number->channel-map))
- (define (control channel-number->channel-map next-free-channel-number)
+ (reconnect loop channel-number->channel-map))
+ (define (control loop channel-number->channel-map
next-free-channel-number)
"The main event loop."
- (control* channel-number->channel-map next-free-channel-number
+ (control* loop channel-number->channel-map next-free-channel-number
(perform-operation loop-operation)))
(define (close-if-possible! channel)
;; Pre-conditions:
@@ -244,12 +243,12 @@
(channel-channel-number channel)))
;; We don't need the envelope.
(values)))
- (define (control* channel-number->channel-map next-free-channel-number
+ (define (control* loop channel-number->channel-map
next-free-channel-number
message)
(define (continue)
- (control channel-number->channel-map next-free-channel-number))
+ (control loop channel-number->channel-map next-free-channel-number))
(define (continue* message)
- (control* channel-number->channel-map next-free-channel-number
+ (control* loop channel-number->channel-map next-free-channel-number
message))
;; TODO: what about closed channels?
(define (send-channel-stuff! channel)
@@ -331,7 +330,7 @@
(bbtree-set channel-number->channel-map channel-number
channel)))
(send-local-channel-create! mq channel)
- (control channel-number->channel-map
next-free-channel-number)))
+ (control loop channel-number->channel-map
next-free-channel-number)))
(('close-channel! channel)
;; 'close-channel!' can only be sent after the <channel> object
;; was returned by the procedure 'open-channel!', because only
@@ -395,10 +394,10 @@
(continue* '(disconnect!))))))))
(rest
(handle-control-message!
- rest mq terminal-condition
+ rest mq (loop:terminal-condition loop)
(cut k/reconnect! channel-number->channel-map)))))
;; Start the main event loop.
- (control channel-number->channel-map %minimum-local-channel-id))
+ (control loop channel-number->channel-map %minimum-local-channel-id))
(define-record-type (<cadet-address> make-cadet-address cadet-address?)
(fields (immutable peer cadet-address-peer)
--
To stop receiving notification emails like this one, please contact
gnunet@gnunet.org.
- [gnunet-scheme] 20/42: server: Add default arguments to 'make-loop'., (continued)
- [gnunet-scheme] 20/42: server: Add default arguments to 'make-loop'., gnunet, 2022/09/10
- [gnunet-scheme] 25/42: server: Re-indent., gnunet, 2022/09/10
- [gnunet-scheme] 31/42: doc/service-communication: Document spawn-server-loop., gnunet, 2022/09/10
- [gnunet-scheme] 11/42: dht: Use <loop> for state where possible., gnunet, 2022/09/10
- [gnunet-scheme] 13/42: dht/client: Rewrite in terms of (gnu gnunet server)., gnunet, 2022/09/10
- [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 <=
- [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, 2022/09/10
- [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