[gnunet-scheme] 276/324: nse/client: Stop reconnecting when a disconnect is requested.

[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 1f416463bd46b669dc9929dc9453db9f22feacd1
Author: Maxime Devos <maximedevos@telenet.be>
AuthorDate: Sun Sep 12 17:25:54 2021 +0200

    nse/client: Stop reconnecting when a disconnect is requested.
    
    * gnu/gnunet/nse/client.scm
      (<server>)[request-close?/box]: New field.
      (disconnect!): Set new box before signalling the condition.
      
(reconnect)[error-handler]{input:regular-end-of-file,input:premature-end-of-file}:
      When the new box holds #t as value, don't reconnect.
      (connect): Adjust callers.
    * tests/network-size.scm
      ("close, connected --> all fibers stop, two callbacks called"): New test.
---
 gnu/gnunet/nse/client.scm | 25 ++++++++++++++++++-----
 tests/network-size.scm    | 51 +++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 71 insertions(+), 5 deletions(-)

diff --git a/gnu/gnunet/nse/client.scm b/gnu/gnunet/nse/client.scm
index 006d533..21af1bb 100644
--- a/gnu/gnunet/nse/client.scm
+++ b/gnu/gnunet/nse/client.scm
@@ -38,7 +38,7 @@
                begin define quote lambda case values expt = else apply
                and >=)
          (only (rnrs control)
-               when)
+               when unless)
          (only (rnrs records syntactic)
                define-record-type)
           (only (ice-9 atomic)
@@ -83,6 +83,10 @@
     (define-record-type (<server> %make-server server?)
       ;; Atomic box of <estimate>
       (fields (immutable estimate/box server-estimate/box)
+             ;; Atomic box of boolean.  Initially #f.  Set this
+             ;; to #t before signalling request-close-condition.
+             (immutable request-close?/box
+                        server-request-close?/box)
              (immutable request-close-condition
                         server-request-close-condition)))
 
@@ -117,10 +121,12 @@ timestamp."
     (define (disconnect! server)
       "Asynchronuously disconnect from the NSE server 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)))
 
     ;; See 'connect'.
-    (define* (reconnect estimate/box request-close-condition config #:key
+    (define* (reconnect estimate/box request-close?/box 
request-close-condition config
+                       #:key
                        updated connected disconnected spawn #:rest rest)
       (define (handle-estimate! estimate-slice)
        (define estimate
@@ -169,7 +175,15 @@ even if not connected.  This is an idempotent operation."
           ;; be confusing.
           (signal-condition! mq-closed)
           (when disconnected (disconnected))
-          (apply reconnect estimate/box request-close-condition config rest))
+          ;; Don't reconnect after 'close-queue!'.  About races: it's not
+          ;; paramount we stop reconnecting immediately, but we should stop
+          ;; eventually after 'request-close?/box' is set and
+          ;; 'request-close-condition' is signalled, and 
'request-close-handler'
+          ;; will take care of closing the new queue if it shouldn't have been
+          ;; created.
+          (unless (atomic-box-ref request-close?/box)
+            (apply reconnect estimate/box request-close?/box 
request-close-condition
+                   config rest)))
          ((connection:interrupted)
           (values))
          (else
@@ -205,8 +219,9 @@ shortly after calling @var{disconnected}.
 
 The procedures @var{updated}, @var{connected} and @var{disconnected} are 
optional."
       (define estimate/box (make-atomic-box #f))
+      (define request-close?/box (make-atomic-box #f))
       (define request-close-condition (make-condition))
-      (reconnect estimate/box request-close-condition config
+      (reconnect estimate/box request-close?/box request-close-condition config
                 #:updated updated #:connected connected #:disconnected 
disconnected
                 #:spawn spawn)
-      (%make-server estimate/box request-close-condition))))
+      (%make-server estimate/box request-close?/box request-close-condition))))
diff --git a/tests/network-size.scm b/tests/network-size.scm
index 1dafbc8..c7ce3f8 100644
--- a/tests/network-size.scm
+++ b/tests/network-size.scm
@@ -33,6 +33,8 @@
        (only (fibers) sleep)
        (gnu gnunet netstruct syntactic)
        (ice-9 match)
+       (ice-9 suspendable-ports)
+       (ice-9 control)
        (prefix (rnrs hashtables) #{rnrs:}#)
        (srfi srfi-1)
        (srfi srfi-26)
@@ -288,4 +290,53 @@ is @var{where}."
        (sleep 0.001)
        #t)))))
 
+(test-assert "close, connected --> all fibers stop, two callbacks called"
+  (call-with-spawner/wait
+   (lambda (spawn)
+     (call-with-temporary-directory
+      (lambda (somewhere)
+       (define where (in-vicinity somewhere "sock.et"))
+       (define config (make-nse-config where))
+       (define (#{don't-call-me}# . rest)
+         (error "oops ~a" rest))
+       (define connected? #f)
+       (define disconnected? #f)
+       (define connected-cond (make-condition))
+       (define disconnected-cond (make-condition))
+       (define (connected)
+         (assert (not connected?))
+         (set! connected? #t)
+         (signal-condition! connected-cond))
+       (define done (make-condition))
+       (define (disconnected)
+         (assert (not disconnected?))
+         (assert connected?)
+         (signal-condition! disconnected-cond)
+         (set! disconnected? #t))
+       (define server (nse:connect config #:spawn spawn
+                                   #:connected connected
+                                   #:disconnected disconnected
+                                   #:updated #{don't-call-me}#))
+       (define listening (socket AF_UNIX SOCK_STREAM 0))
+       (make-nonblocking! listening)
+       (bind listening AF_UNIX where)
+       (listen listening 1)
+       (define connection (accept listening))
+       (wait connected-cond)
+       (nse:disconnect! server)
+       (wait disconnected-cond)
+       (define old-waiter (current-read-waiter))
+       (sleep 0.01) ;; give the NSE client a chance to accidentally connect
+       (let/ec ec
+         (parameterize ((current-read-waiter
+                         (lambda (p)
+                           (if (eq? p listening)
+                               (ec)
+                               (old-waiter p)))))
+           (set! connection (accept listening))
+           (error "client tried to connect again")))
+       #t)))
+   ;; call-with-spawner/wait is more reliable without parallelism
+   #:parallelism 1))
+
 (test-end "network-size")

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