[gnunet-scheme] branch master updated: Unify some procedures in CADET and DHT client libraries.

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

The following commit(s) were added to refs/heads/master by this push:
     new 59ef9f9  Unify some procedures in CADET and DHT client libraries.
59ef9f9 is described below

commit 59ef9f936e684c715d10117810c70ae8d0c55c1d
Author: Maxime Devos <maximedevos@telenet.be>
AuthorDate: Mon Feb 21 14:56:55 2022 +0000

    Unify some procedures in CADET and DHT client libraries.
    
    * gnu/gnunet/cadet/client.scm (maybe-send-control-message!*): Extract
      this ...
    * gnu/gnunet/dht/client.scm (maybe-send-control-message!*): ... and
      this equivalent procedure to ...
    * gnu/gnunet/server.scm: ... here.
    * gnu/gnunet/cadet/client.scm (reconnect)[error-handler]: Extract this
      ...
    * gnu/gnunet/dht/client.scm (reconnect)[error-handler]: ... and this
      equivalent procedure to ...
    * gnu/gnunet/server.scm: ... to here.
    * Makefile.am (modules): Register new file.
---
 Makefile.am                 |  4 +++-
 gnu/gnunet/cadet/client.scm | 30 ++++++------------------------
 gnu/gnunet/dht/client.scm   | 45 ++++++---------------------------------------
 3 files changed, 15 insertions(+), 64 deletions(-)

diff --git a/Makefile.am b/Makefile.am
index 594698e..3f19001 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -94,7 +94,9 @@ modules = \
   gnu/gnunet/nse/struct.scm \
   \
   gnu/gnunet/netstruct/procedural.scm \
-  gnu/gnunet/netstruct/syntactic.scm
+  gnu/gnunet/netstruct/syntactic.scm \
+  \
+  gnu/gnunet/server.scm
 
 GOBJECTS = $(modules:%.scm=%.go)
 nobase_dist_guilesite_DATA = $(modules) gnu/gnunet/config/default.conf
diff --git a/gnu/gnunet/cadet/client.scm b/gnu/gnunet/cadet/client.scm
index 94ac640..ab57e8b 100644
--- a/gnu/gnunet/cadet/client.scm
+++ b/gnu/gnunet/cadet/client.scm
@@ -24,6 +24,8 @@
                make-lost-and-found collect-lost-and-found-operation)
          (only (gnu gnunet mq handler) message-handlers)
          (only (gnu gnunet mq) close-queue!)
+         (only (gnu gnunet server)
+               maybe-send-control-message!* make-error-handler)
          (only (gnu gnunet mq-impl stream) connect/fibers)
          (only (rnrs base)
                begin define lambda assert quote cons apply values
@@ -38,13 +40,7 @@
          (only (fibers operations)
                wrap-operation choice-operation perform-operation))
   (begin
-    ;; TODO: deduplicate these three procedures with (gnu gnunet dht client)
-    (define (maybe-send-control-message!* terminal-condition control-channel
-                                         . message)
-      (perform-operation
-       (choice-operation
-       (wait-operation terminal-condition)
-       (put-operation control-channel message))))
+    ;; TODO: deduplicate these two procedures with (gnu gnunet dht client)
     (define (maybe-send-control-message! server . message)
       (apply maybe-send-control-message!* (server-terminal-condition server)
             (server-control-channel server) message))
@@ -89,23 +85,9 @@
         (wrap-operation (collect-lost-and-found-operation lost-and-found)
                         (lambda (lost) (cons 'lost lost)))))
       (define handlers (message-handlers)) ; TODO
-      ;; TODO: abstract duplication in (gnu gnunet dht client)
-      (define (error-handler key . arguments)
-       (case key
-         ((connection:connected)
-          (connected)
-          (maybe-send-control-message!* terminal-condition control-channel
-                                        'resend-old-operations!)
-          (values))
-         ((input:regular-end-of-file input:premature-end-of-file)
-          (disconnected)
-          (maybe-send-control-message!* terminal-condition control-channel 
'reconnect!))
-         ((connection:interrupted)
-          (values))
-         (else
-          (apply maybe-send-control-message!* terminal-condition
-                 control-channel 'oops! key arguments)
-          (values))))
+      (define error-handler
+       (make-error-handler connected disconnected terminal-condition
+                           control-channel))
       (define mq (connect/fibers config "cadet" handlers error-handler
                                 #:spawn spawn))
       (define (control)
diff --git a/gnu/gnunet/dht/client.scm b/gnu/gnunet/dht/client.scm
index 5ed1583..6b4f74c 100644
--- a/gnu/gnunet/dht/client.scm
+++ b/gnu/gnunet/dht/client.scm
@@ -76,6 +76,8 @@
          (gnu gnunet mq handler)
          (gnu gnunet mq-impl stream)
          (gnu gnunet mq envelope)
+         (only (gnu gnunet server)
+               maybe-send-control-message!* make-error-handler)
          (only (guile)
                pk define-syntax-rule define* lambda* error
                make-hash-table hashq-set! hashq-remove! hashv-set! hashv-ref
@@ -596,16 +598,6 @@ currently unsupported."
                     ;; Any ‘small’ natural number will do.
                     (make-atomic-box 0))))))
 
-    (define (maybe-send-control-message!* terminal-condition control-channel
-                                         . message)
-      "See @code{maybe-send-control-message!}."
-      (perform-operation
-       (choice-operation
-       ;; Nothing to do when the <server> is permanently disconnected,
-       ;; or is being disconnected.
-       (wait-operation terminal-condition)
-       (put-operation control-channel message))))
-
     (define (maybe-send-control-message! server . message)
       "Send @var{message} to the control channel of @var{server}, or don't
 do anything if @var{server} has been permanently disconnected."
@@ -887,35 +879,10 @@ operation is cancelled, return @code{#false} instead."
                     ((get:iterator handle) search-result)))
                 ;; TODO: wrong type (maybe a put handle?).
                 TODO-error-reporting/2)))))
-      ;; TODO: abstract duplication in (gnu gnunet nse client)
-      (define (error-handler key . arguments)
-       (case key
-         ((connection:connected)
-          (connected)
-          ;; Tell 'control' to resume old requests.
-          (maybe-send-control-message!* terminal-condition control-channel
-                                        'resend-old-operations!)
-          (values))
-         ((input:regular-end-of-file input:premature-end-of-file)
-          (disconnected)
-          ;; Tell the event loop that it is time to restart,
-          ;; unless it is already stopping.
-          (maybe-send-control-message!* terminal-condition control-channel 
'reconnect!))
-         ;; 'control' closed the queue and will exit, nothing to do here!
-         ;;
-         ;; Tested by "(DHT) close, not connected --> all fibers stop,
-         ;; no callbacks called" in tests/distributed-hash-table.scm.
-         ((connection:interrupted)
-          (values))
-         (else
-          ;; Some unknown problem, let 'control' report the error,
-          ;; disconnect and stop reconnecting.  The first two happen
-          ;; in no particular order.
-          (apply maybe-send-control-message!* terminal-condition
-                 control-channel 'oops! key arguments)
-          (values))))
-      (define mq (connect/fibers config "dht" handlers error-handler
-                                #:spawn spawn))
+      (define error-handler
+       (make-error-handler connected disconnected terminal-condition
+                           control-channel))
+      (define mq (connect/fibers config "dht" handlers error-handler))
       (define (process-stop-search get)
        ;; TODO: tests!
        ;; TODO: cancel outstanding messages to the DHT services for this

-- 
To stop receiving notification emails like this one, please contact
gnunet@gnunet.org.