[gnunet-scheme] 07/49: dht/client: Implement reconnecting.

[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 f3794516c98e6a18667cec7b1f66f946e7f08b07
Author: Maxime Devos <maximedevos@telenet.be>
AuthorDate: Fri Sep 17 17:14:43 2021 +0200

    dht/client: Implement reconnecting.
    
    * gnu/gnunet/dht/client.scm
      (<server>): New record.
      (disconnect!,connect): New procedures.
      (reconnect)[mq-closed,mq]: New variable.
      (reconnect)[error-handler,request-close-handler]: New procedures.
---
 gnu/gnunet/dht/client.scm | 78 +++++++++++++++++++++++++++++++++++++++++++----
 1 file changed, 72 insertions(+), 6 deletions(-)

diff --git a/gnu/gnunet/dht/client.scm b/gnu/gnunet/dht/client.scm
index 1f65a23..e37abff 100644
--- a/gnu/gnunet/dht/client.scm
+++ b/gnu/gnunet/dht/client.scm
@@ -32,11 +32,23 @@
          ;; Extended API: monitor
          start-monitor!
          stop-monitor!)
-  (import (gnu gnunet mq handler)
+  (import (gnu gnunet mq)
+         (gnu gnunet mq handler)
+         (gnu gnunet mq-impl stream)
          (only (guile)
-               define-syntax-rule)
+               pk define-syntax-rule define*)
+         (only (ice-9 atomic)
+               make-atomic-box atomic-box-ref atomic-box-set!)
          (only (gnu extractor enum)
                symbol-value)
+         (only (fibers)
+               spawn-fiber)
+         (only (fibers conditions)
+               make-condition signal-condition! wait-operation)
+         (only (fibers operations)
+               perform-operation choice-operation)
+         (only (gnu gnunet mq error-reporting)
+               report-error)
          (gnu gnunet dht struct)
          (only (gnu gnunet crypto struct)
                /peer-identity)
@@ -47,8 +59,18 @@
          (only (gnu gnunet utils bv-slice)
                slice-length slice/read-only)
          (only (rnrs base)
-               and >= = quote * + - define begin ... let*))
+               and >= = quote * + - define begin ... let*
+               quote case else values apply)
+         (only (rnrs control)
+               unless)
+         (only (rnrs records syntactic)
+               define-record-type))
   (begin
+    (define-record-type (<server> %make-server server?)
+      (fields (immutable request-close?/box server-request-close?/box)
+             (immutable request-close-condition
+                        server-request-close-condition)))
+
     (define-syntax-rule (well-formed?/path-length slice type (field ...) 
compare)
       "Verify the TYPE message in @var{slice}, which has @var{field ...} ...
 (e.g. one or more of get-path-length or put-path-length) and corresponding
@@ -67,8 +89,25 @@ message header is assumed to be correct."
                  ...)
             (compare extra-size (* (+ field ...) (sizeof /peer-identity 
'()))))))
 
-    ;; TODO: WIP!
-    (define (reconnect . todo)
+    ;; TODO reduce duplication with (gnu gnunet nse client) --- maybe introduce
+    ;; (gnu gnunet client) as in the C implementation?
+    (define (disconnect! server)
+      "Asynchronuously disconnect from the DHT service and stop reconnecting,
+even if not connected.  This is an idempotent operation."
+      (atomic-box-set! (server-request-close?/box server) #t)
+      (signal-condition! (server-request-close-condition server)))
+
+    (define* (connect config #:key (spawn spawn-fiber))
+      "Connect to the DHT service in the background."
+      (define request-close?/box (make-atomic-box #f))
+      (define request-close-condition (make-condition))
+      (reconnect request-close?/box request-close-condition config
+                #:spawn spawn)
+      (%make-server request-close?/box request-close-condition))
+
+    (define* (reconnect request-close?/box request-close-condition config
+                       #:key (spawn spawn-fiber)
+                       #:rest rest)
       (define handlers
        (message-handlers
         (message-handler
@@ -107,4 +146,31 @@ message header is assumed to be correct."
           (well-formed?/path-length slice /:msg:dht:client:result
                                     (get-path-length put-path-length) >=))
          ((handle! slice) ???))))
-      todo)))
+      ;; TODO: abstract duplication in (gnu gnunet nse client)
+      (define mq-closed (make-condition))
+      (define (error-handler error . arguments)
+       (case error
+         ((connection:connected)
+          (pk 'todo-connected)
+          'todo)
+         ((input:regular-end-of-file input:premature-end-of-file)
+          (signal-condition! mq-closed)
+          (unless (atomic-box-ref request-close?/box)
+            (apply reconnect request-close?/box request-close-condition
+                   config rest)))
+         ((connection:interrupted)
+          (values))
+         (else
+          (apply report-error error arguments)
+          (close-queue! mq))))
+      (define (request-close-handler)
+       (perform-operation
+        (choice-operation
+         (wait-operation request-close-condition)
+         ;; Make sure the fiber exits after a reconnect.
+         (wait-operation mq-closed)))
+       (close-queue! mq))
+      (define mq (connect/fibers config "dht" handlers error-handler
+                                #:spawn spawn))
+      (spawn request-close-handler)
+      'todo)))

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