[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[gnunet-scheme] 02/03: dht/client: Extract error reporting and reconnect
From: |
gnunet |
Subject: |
[gnunet-scheme] 02/03: dht/client: Extract error reporting and reconnection code. |
Date: |
Wed, 27 Jul 2022 22:01:12 +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 2d82b482ddbed0fb5a63940515890361842831f8
Author: Maxime Devos <maximedevos@telenet.be>
AuthorDate: Wed Jul 27 21:52:05 2022 +0200
dht/client: Extract error reporting and reconnection code.
It is duplicated by nse/client.scm.
* gnu/gnunet/dht/client.scm (reconnect)[control*]: Extract 'oops!',
'disconnect!' and 'reconnect!' to ...
* gnu/gnunet/server.scm (handle-control-message!): ... this new
procedure, ...
* gnunet/dht/client.scm (reconnect)[k/reconnect!]: ... and make this
new procedure as a side-effect.
---
gnu/gnunet/dht/client.scm | 32 +++++++-------------------------
gnu/gnunet/server.scm | 47 +++++++++++++++++++++++++++++++++++++++++++----
2 files changed, 50 insertions(+), 29 deletions(-)
diff --git a/gnu/gnunet/dht/client.scm b/gnu/gnunet/dht/client.scm
index 0686ac3..8ab011b 100644
--- a/gnu/gnunet/dht/client.scm
+++ b/gnu/gnunet/dht/client.scm
@@ -81,7 +81,7 @@
(only (gnu gnunet server)
maybe-send-control-message! make-error-handler
<server> server-terminal-condition server-control-channel
- make-disconnect!)
+ make-disconnect! handle-control-message!)
(only (guile)
pk define-syntax-rule define* lambda* error
make-hash-table hashq-set! hashq-remove! hashv-set! hashv-ref
@@ -103,8 +103,6 @@
perform-operation choice-operation wrap-operation)
(only (fibers channels)
make-channel put-operation get-operation get-message
put-message)
- (only (gnu gnunet mq error-reporting)
- report-error)
(only (gnu gnunet concurrency lost-and-found)
make-lost-and-found collect-lost-and-found-operation
losable-lost-and-found)
@@ -878,6 +876,9 @@ operation is cancelled, return @code{#false} instead."
(when (hashv-ref id->operation-map (get:unique-id get))
(hashv-remove! id->operation-map (get:unique-id get))
(send-stop-get! mq get)))
+ (define (k/reconnect!)
+ (apply reconnect terminal-condition config id->operation-map
+ control-channel lost-and-found rest))
(define loop-operation
(choice-operation
(get-operation control-channel)
@@ -888,27 +889,6 @@ operation is cancelled, return @code{#false} instead."
(control* (perform-operation loop-operation)))
(define (control* message)
(match message
- (('oops! key . arguments)
- ;; Some unknown error, report it (report-error) and close
- ;; the queue (close-queue!). 'connected' will be called
- ;; from the 'input:regular-end-of-file' case in 'error-handler'.
- ;;
- ;; The error reporting and closing happen in no particular order.
- (signal-condition! terminal-condition)
- (apply report-error key arguments)
- (close-queue! mq)
- (values))
- (('disconnect!)
- ;; Ignore future requests instead of blocking.
- (signal-condition! terminal-condition)
- ;; Close networking ports.
- (close-queue! mq)
- ;; And the fibers of the <server> object are now done!
- (values))
- (('reconnect!)
- ;; Restart the loop with a new message queue.
- (apply reconnect terminal-condition config id->operation-map
- control-channel lost-and-found rest))
(('start-get! get)
;; Register the new get operation, such that we remember
;; where to send responses to.
@@ -970,6 +950,8 @@ operation is cancelled, return @code{#false} instead."
(process-stop-search get)
(loop rest))
((? server:dht? server)
- (control* '(disconnect!))))))))))
+ (control* '(disconnect!))))))))
+ (rest (handle-control-message!
+ rest mq terminal-condition k/reconnect!))))
;; Start the main event loop.
(control))))
diff --git a/gnu/gnunet/server.scm b/gnu/gnunet/server.scm
index 04de629..3e9e5e4 100644
--- a/gnu/gnunet/server.scm
+++ b/gnu/gnunet/server.scm
@@ -21,21 +21,28 @@
(export maybe-send-control-message!* maybe-send-control-message!
make-error-handler
<server> server-terminal-condition server-control-channel
- make-disconnect!)
+ make-disconnect!
+ handle-control-message!)
(import (only (rnrs base)
begin define case else apply values quote lambda
if error list)
(only (rnrs records syntactic)
define-record-type)
(only (fibers conditions)
- make-condition wait-operation)
+ make-condition wait-operation signal-condition!)
(only (fibers channels)
make-channel put-operation)
(only (fibers operations)
choice-operation perform-operation)
(only (gnu gnunet concurrency lost-and-found)
make-lost-and-found collect-lost-and-found-operation
- losable-lost-and-found))
+ losable-lost-and-found)
+ (only (gnu gnunet mq)
+ close-queue!)
+ (only (gnu gnunet mq error-reporting)
+ report-error)
+ (only (ice-9 match)
+ match))
(begin
(define (maybe-send-control-message!* terminal-condition control-channel
. message)
@@ -115,4 +122,36 @@ asynchronuous request; it won't be fulfilled immediately."
(error 'disconnect! ; TODO: test
"wrong server object type"
(list name type? server))))
- disconnect!)))
+ disconnect!)
+
+ (define (handle-control-message! message mq terminal-condition
k/reconnect!)
+ "The following messages are handled:
+
+@itemize
+@item oops!, by signalling @var{terminal-condition}, reporting the error and
closing the queue
+(not necessarily in that order).
+@item disconnect!, by signalling @var{terminal-condition} and closing the queue
+@item reconnect!, by calling the thunk @var{k/reconnect} in tail position
+
+TODO: maybe 'lost'"
+ (match message
+ (('oops! key . arguments)
+ ;; Some unknown error, report it (report-error) and close
+ ;; the queue (close-queue!). 'connected' will be called
+ ;; from the 'input:regular-end-of-file' case in 'error-handler'.
+ ;;
+ ;; The error reporting and closing happen in no particular order.
+ (signal-condition! terminal-condition)
+ (apply report-error key arguments)
+ (close-queue! mq)
+ (values))
+ (('disconnect!)
+ ;; Ignore future requests instead of blocking.
+ (signal-condition! terminal-condition)
+ ;; Close networking ports.
+ (close-queue! mq)
+ ;; And the fibers of the <server> object are now done!
+ (values))
+ (('reconnect!)
+ ;; Restart the loop with a new message queue.
+ (k/reconnect!))))))
--
To stop receiving notification emails like this one, please contact
gnunet@gnunet.org.