[gnunet-scheme] branch master updated (ff36dc8 -> 1b12768)

[gnunet]

This is an automated email from the git hooks/post-receive script.

maxime-devos pushed a change to branch master
in repository gnunet-scheme.

    from ff36dc8  tests/lost-and-found: Note that "concurrent losing" is a bit 
slow.
     new 007c83a  tests/util: Remove reference to 'gc-timeout'.
     new 2d82b48  dht/client: Extract error reporting and reconnection code.
     new 1b12768  nse/client: Use 'server' module for error reporting and 
reconnection code.

The 3 revisions listed above as "new" are entirely new to this
repository and will be described in separate emails.  The revisions
listed as "add" were already present in the repository and have only
been added to this reference.


Summary of changes:
 gnu/gnunet/dht/client.scm | 32 +++++++-------------------------
 gnu/gnunet/nse/client.scm | 21 ++++++---------------
 gnu/gnunet/server.scm     | 47 +++++++++++++++++++++++++++++++++++++++++++----
 tests/utils.scm           |  2 +-
 4 files changed, 57 insertions(+), 45 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/nse/client.scm b/gnu/gnunet/nse/client.scm
index e118359..50edd5f 100644
--- a/gnu/gnunet/nse/client.scm
+++ b/gnu/gnunet/nse/client.scm
@@ -81,7 +81,8 @@
                <server> make-disconnect!
                server-terminal-condition
                server-control-channel
-               make-error-handler)
+               make-error-handler
+               handle-control-message!)
           (only (gnu gnunet nse struct)
                /:msg:nse:estimate))
   (begin
@@ -178,6 +179,8 @@ timestamp."
                            control-channel))
       (define mq (connect/fibers config "nse" handlers error-handler
                                 #:spawn spawn))
+      (define (k/reconnect!)
+       (apply reconnect terminal-condition config control-channel 
lost-and-found estimate/box rest))
       (define loop-operation
        (choice-operation
         (get-operation control-channel)
@@ -188,19 +191,6 @@ timestamp."
        (control* (perform-operation loop-operation)))
       (define (control* message)
        (match message
-         ;; TODO: deduplicate these things copied from (gnu gnunet dht client)
-         (('oops key . arguments)
-          (signal-condition! terminal-condition)
-          (apply report-error key arguments)
-          (close-queue! mq)
-          (values))
-         (('disconnect!)
-          (signal-condition! terminal-condition)
-          (close-queue! mq)
-          (values))
-         (('reconnect!)
-          (apply reconnect terminal-condition config control-channel 
lost-and-found estimate/box rest))
-         ;; (TODO: Start of our own code)
          (('resend-old-operations!)
           (send-start!)
           (control)) ; continue
@@ -208,7 +198,8 @@ timestamp."
           ;; We lost ourselves, that means the server became unreachable.
           ;; The presence of this line is tested by the "garbage collectable"
           ;; test.
-          (control* '(disconnect!)))))
+          (control* '(disconnect!)))
+         (rest (handle-control-message! message mq terminal-condition 
k/reconnect!))))
       ;; Start main the 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!))))))
diff --git a/tests/utils.scm b/tests/utils.scm
index 6abf87f..bdad806 100644
--- a/tests/utils.scm
+++ b/tests/utils.scm
@@ -262,7 +262,7 @@ fiber exit and the fibers do not keep a reference to the 
service object."
            (sleep delay)
            (if (weak-vector-ref reference 0)
                ;; not yet collected, try again later.
-               (and (< delay (gc-timeout)) (loop (* 2 delay)))
+               (and (< delay 2.) (loop (* 2 delay)))
                ;; A single (gc) is not sufficient -- the entry in the weak 
vector
                ;; could become #false without it being added to the guardian,
                ;; causing the fibers started by the service to not stop yet,

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