[gnunet-scheme] 252/324: nse/client: Allow disconnecting.

[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 cea7cfd7416b33b664defea4bbacf78114d7e08a
Author: Maxime Devos <maximedevos@telenet.be>
AuthorDate: Fri Sep 10 14:07:47 2021 +0200

    nse/client: Allow disconnecting.
    
    * gnu/gnunet/nse/client.scm
      (<server>)[request-close-condition]: New field
      (disconnect!): New procedure.
      (reconnect): Add 'request-close-condition' argument.
      (reconnect)[request-close-handler]: New procedure.
      (reconnect): Spawn 'request-close-handler'.
      (connect)[request-close-condition]: New variable.
      (connect): Use new variable.
    * tests/utils.scm: Export 'call-with-temporary-directory'.
    * tests/network-size.scm
      ("close, not connected --> all fibers stop, no callbacks called"):
      New test.
---
 gnu/gnunet/nse/client.scm | 41 ++++++++++++++++++++++++++++++++---------
 tests/network-size.scm    | 25 ++++++++++++++++++++++++-
 tests/utils.scm           |  3 ++-
 3 files changed, 58 insertions(+), 11 deletions(-)

diff --git a/gnu/gnunet/nse/client.scm b/gnu/gnunet/nse/client.scm
index f19f06c..92e8d77 100644
--- a/gnu/gnunet/nse/client.scm
+++ b/gnu/gnunet/nse/client.scm
@@ -32,7 +32,7 @@
          estimate:timestamp
          server?
          connect
-         ;; TODO: disconnect
+         disconnect!
          estimate)
   (import (only (rnrs base)
                begin define quote lambda case values expt = else apply)
@@ -45,7 +45,9 @@
           (only (fibers)
                spawn-fiber)
          (only (fibers conditions)
-               make-condition wait signal-condition!)
+               make-condition wait wait-operation signal-condition!)
+         (only (fibers operations)
+               choice-operation perform-operation)
          (only (gnu extractor enum)
                symbol-value value->index)
          (only (guile)
@@ -60,7 +62,7 @@
                message-handler
                message-handlers)
           (only (gnu gnunet mq)
-               send-message!)
+               send-message! close-queue!)
           (only (gnu gnunet mq-impl stream)
                connect/fibers)
           (gnu gnunet message protocols)
@@ -76,7 +78,9 @@
       (opaque #t))
 
     (define-record-type (<server> %make-server server?)
-      (fields (immutable estimate/box server-estimate/box))) ; atomic box of 
flonum
+      (fields (immutable estimate/box server-estimate/box) ; atomic box of 
flonum
+             (immutable request-close-condition
+                        server-request-close-condition)))
 
     (define (estimate server)
       "Return the current estimate of the number of peers on the network,
@@ -114,8 +118,14 @@ Maybe +inf.0 as well?"
 timestamp."
       (%estimate:timestamp estimate))
 
+    (define (disconnect! server)
+      "Asynchronuously disconnect from the NSE server and stop reconnecting,
+even if not connected.  This is an idempotent operation."
+      (signal-condition! (server-request-close-condition server)))
+
     ;; See 'connect'.
-    (define* (reconnect estimate/box config #:key updated connected 
disconnected
+    (define* (reconnect estimate/box request-close-condition config #:key
+                       updated connected disconnected
                        (spawn spawn-fiber) #:rest rest)
       (define (handle-estimate! estimate-slice)
        (define estimate
@@ -144,6 +154,7 @@ timestamp."
               (value->index (symbol-value message-type msg:nse:start)))
        (send-message! mq s))
       (define mq-defined (make-condition))
+      (define mq-closed (make-condition))
       (define (error-handler error)
        (case error
          ;; TODO report input errors?
@@ -161,11 +172,22 @@ timestamp."
           ;; it is possible that 'connected' is called twice without
           ;; a call to 'disconnected' in-between, which would presumably
           ;; be confusing.
+          (signal-condition! mq-closed)
           (when disconnected (disconnected))
-          (apply reconnect estimate/box config rest))))
+          (apply reconnect estimate/box request-close-condition config rest))))
+      ;; Only started after 'mq' is defined, so no need to wait for
+      ;; 'mq-defined'.
+      (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 "nse" handlers error-handler
                                 #:spawn spawn))
-      (signal-condition! mq-defined))
+      (signal-condition! mq-defined)
+      (spawn-fiber request-close-handler))
 
     (define* (connect config #:key updated connected disconnected
                      (spawn spawn-fiber) #:rest rest)
@@ -181,5 +203,6 @@ shortly after calling @var{disconnected}.
 
 The procedures @var{updated}, @var{connected} and @var{disconnected} are 
optional."
       (define estimate/box (make-atomic-box #f))
-      (apply reconnect estimate/box config rest)
-      (%make-server estimate/box))))
+      (define request-close-condition (make-condition))
+      (apply reconnect estimate/box request-close-condition config rest)
+      (%make-server estimate/box request-close-condition))))
diff --git a/tests/network-size.scm b/tests/network-size.scm
index 8ba03bb..b24af10 100644
--- a/tests/network-size.scm
+++ b/tests/network-size.scm
@@ -22,6 +22,7 @@
        (gnu gnunet mq handler)
        (gnu extractor enum)
        (gnu gnunet message protocols)
+       (gnu gnunet config db)
        (only (rnrs base)
              assert)
        (prefix (gnu gnunet nse client) #{nse:}#)
@@ -32,11 +33,13 @@
        (only (fibers) sleep)
        (gnu gnunet netstruct syntactic)
        (ice-9 match)
+       (prefix (rnrs hashtables) #{rnrs:}#)
        (srfi srfi-1)
        (srfi srfi-26)
        (srfi srfi-43)
        (srfi srfi-64)
-       (fibers conditions))
+       (fibers conditions)
+       (tests utils))
 
 (test-begin "network-size")
 
@@ -259,4 +262,24 @@
        (assert connected?)
        #t))))
 
+(test-assert "close, not connected --> all fibers stop, no callbacks called"
+  (call-with-spawner/wait
+   (lambda (spawn)
+     (call-with-temporary-directory
+      (lambda (somewhere)
+       (define where (in-vicinity somewhere "sock.et"))
+       (define config (hash->configuration
+                       (rnrs:make-hashtable hash-key key=?)))
+       (set-value! identity config "nse" "UNIXPATH" where)
+       (define (#{don't-call-me}# . rest)
+         (error "oops ~a" rest))
+       (define server (nse:connect config #:spawn spawn
+                                   #:connected #{don't-call-me}#
+                                   #:disconnected #{don't-call-me}#
+                                   #:updated #{don't-call-me}#))
+       (sleep 0.001)
+       (nse:disconnect! server)
+       (sleep 0.001)
+       #t)))))
+
 (test-end "network-size")
diff --git a/tests/utils.scm b/tests/utils.scm
index 5e20fc4..3bde3c9 100644
--- a/tests/utils.scm
+++ b/tests/utils.scm
@@ -30,7 +30,8 @@
                             call-with-services
                             call-with-services/fibers
                             call-with-spawner
-                            call-with-spawner/wait))
+                            call-with-spawner/wait
+                            call-with-temporary-directory))
 
 ;; Current versions of guile (at least 3.0.5) use a conservative
 ;; garbage collector, so some tests concerning garbage collection

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