[gnunet-scheme] 02/03: dht/client: Extract error reporting and reconnection code.

[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 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.