gnunet-svn
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[gnunet-scheme] branch master updated (5b37f53 -> dbb4430)


From: gnunet
Subject: [gnunet-scheme] branch master updated (5b37f53 -> dbb4430)
Date: Wed, 27 Jul 2022 00:21:10 +0200

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 5b37f53  simulate-dht-service: Verify that the argument is in fact a 
condition.
     new 1011baa  .gitignore: Ignore more.
     new 4e3e5eb  Revert "Eliminate guix.scm."
     new 39f3de4  cadet/client: Remove duplicate stub definition of channel?.
     new 3ba61c0  Merge remote-tracking branch 'g2/master'
     new 5e0002e  network-size: Standardise test order.
     new 439fe10  tests/cadet: Run all the standard tests.
     new 0d55965  tests/network-size: Test garbage collection of NSE server 
objects.
     new e130a0e  nse/client: Make the <server> a <losable>.
     new 58f7b2a  tests/network-size: Correct connect -> nse:connect.
     new 8b05e69  nse/client: When the object is lost, stop the fibers.
     new 8aeaef7  doc/network-size-estimation: Document that disconnection 
happens automatically.
     new adcd96b  tests/cadet: Enable "garbage collectable" test.
     new 1dbcc71  cadet/client: Handle 'resend-old-operations!'.
     new 05f59de  cadet/client: Handle 'reconnect!!'.
     new 2fedc9e  determine-reported-errors: Extract from the DHT tests.
     new dbb4430  dht/client: Move some code into (gnu gnunet server).

The 16 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:
 .gitignore                       |  2 ++
 doc/contributing.tm              | 10 +++---
 doc/network-size-estimation.tm   |  3 +-
 doc/service-communication.tm     | 16 ++++++++++
 gnu/gnunet/cadet/client.scm      |  9 +++++-
 gnu/gnunet/dht/client.scm        | 20 ++++++------
 gnu/gnunet/nse/client.scm        | 20 +++++++++---
 gnu/gnunet/server.scm            | 31 ++++++++++++++-----
 guix.scm                         | 67 ++++++++++++++++++++++++++++++++++++++++
 tests/cadet.scm                  | 11 +++++--
 tests/distributed-hash-table.scm | 44 +++-----------------------
 tests/network-size.scm           | 23 ++++++++------
 tests/utils.scm                  | 52 ++++++++++++++++++++++++++++++-
 13 files changed, 227 insertions(+), 81 deletions(-)
 create mode 100644 guix.scm

diff --git a/.gitignore b/.gitignore
index b6cab07..d3e08a3 100644
--- a/.gitignore
+++ b/.gitignore
@@ -7,6 +7,8 @@
 *~
 \#*\#
 *.go
+# temporary files for compilation
+*.go.*
 *.o
 *.so
 *.log
diff --git a/doc/contributing.tm b/doc/contributing.tm
index 724530f..67a4f76 100644
--- a/doc/contributing.tm
+++ b/doc/contributing.tm
@@ -31,11 +31,13 @@
     <item><hlink|Guile-Gcrypt|https://notabug.org/cwebber/guile-gcrypt>
   </itemize>
 
+  A few bug fixes to Guile are required that might not yet be included in
+  your distribution, see <verbatim|guix.scm>
+
   Users of <hlink|GNU Guix|https://guix.gnu.org><index|Guix> can run
-  <shell|guix shell -D gnunet-scheme> in the checkout to create an
-  environment where these dependencies are all
-  present.<space|1em>Scheme-GNUnet uses the standard GNU build system, so to
-  build Scheme-Gnunet, you only need to run
+  <shell|guix shell -D -f guix.scm> in the checkout to create an environment
+  where these dependencies are all present.<space|1em>Scheme-GNUnet uses the
+  standard GNU build system, so to build Scheme-Gnunet, you only need to run
 
   <\shell-code>
     autoreconf -vif
diff --git a/doc/network-size-estimation.tm b/doc/network-size-estimation.tm
index 2be4361..1d5556c 100644
--- a/doc/network-size-estimation.tm
+++ b/doc/network-size-estimation.tm
@@ -32,7 +32,8 @@
   called and <scm|(gnu gnunet nse client)> will retry
   connecting.<space|1em>To close the current connection, if any, and stop
   reconnecting, the idempotent procedure 
<scm|disconnect!><subindex|disconnect!|NSE>
-  can be called on the server object.
+  can be called on the server object.<space|1em>The server object will also
+  be disconnected after the server object becomes unreachable.
 
   <todo|input, validation, I/O errors?>
 
diff --git a/doc/service-communication.tm b/doc/service-communication.tm
index c13323c..3ed9e8f 100644
--- a/doc/service-communication.tm
+++ b/doc/service-communication.tm
@@ -420,6 +420,22 @@
   disconnection callbacks are called in the right order and sufficiently
   often.>
 
+  <\explain>
+    <scm|(determine-reported-errors <var|service> <var|connect> <var|proc>
+    #:key (<var|n-connections> 1) (<var|n-errors> 1))>
+  <|explain>
+    This is not a test by itself, but can be used as basis for writing tests
+    on error reporting logic. It connects to a service simulated by
+    <var|proc>, builds a list of errors passed to <scm|error-reporter> and
+    returns it. After a disconnect, it will automatically reconnect until
+    <var|n-connections> have been made. It also waits for <var|n-errors> to
+    be gathered and verifies that all fibers complete.
+
+    The simulation is done by the procedure <var|proc>. It is a procedure
+    accepting the connction port as seen by the server and can e.g. write to
+    the port and close it.
+  </explain>
+
   <todo|document more>
 
   <\example>
diff --git a/gnu/gnunet/cadet/client.scm b/gnu/gnunet/cadet/client.scm
index 5d8716a..f5c9df0 100644
--- a/gnu/gnunet/cadet/client.scm
+++ b/gnu/gnunet/cadet/client.scm
@@ -162,6 +162,10 @@
           (close-queue! mq)
           ;; And the fibers of the <server> object are now done!
           (values))
+         (('reconnect!)
+          ;; Restart the loop with a new message queue.
+          ;; TODO: deduplicate with (gnu gnunet dht client)
+          (reconnect config terminal-condition control-channel connected 
disconnected spawn lost-and-found))
          (('open-channel! channel)
           (let* ((channel-number next-free-channel-number)
                  ;; TODO: handle overflow, and respect bounds
@@ -170,6 +174,10 @@
             (send-local-channel-create! mq channel)
             (control next-free-channel-number)))
          (('close-channel! channel) TODO)
+         (('resend-old-operations!)
+          ;; TODO: no operations and no channels are implemented yet,
+          ;; so for now nothing can be done.
+          (continue))
          (('lost . lost)
           (let loop ((lost lost))
             (match lost
@@ -318,7 +326,6 @@ message @var{message}."
 
     (define (stub . foo)
       (error "todo"))
-    (define channel? stub)
 
     ;; TODO: callbacks, message queue, actually test it
     (define* (open-channel! server address)
diff --git a/gnu/gnunet/dht/client.scm b/gnu/gnunet/dht/client.scm
index 8cb7ee2..3db5863 100644
--- a/gnu/gnunet/dht/client.scm
+++ b/gnu/gnunet/dht/client.scm
@@ -59,6 +59,8 @@
                  (analyse-client-put #{ analyse-client-put}#)
                  (analyse-client-result #{ analyse-client-result}#))
 
+         (rename (server:dht? server?))
+
          connect
          disconnect!
          put!
@@ -77,7 +79,8 @@
          (gnu gnunet mq-impl stream)
          (gnu gnunet mq envelope)
          (only (gnu gnunet server)
-               maybe-send-control-message!* make-error-handler)
+               maybe-send-control-message!* make-error-handler
+               <server> server-terminal-condition server-control-channel)
          (only (guile)
                pk define-syntax-rule define* lambda* error
                make-hash-table hashq-set! hashq-remove! hashv-set! hashv-ref
@@ -580,16 +583,13 @@ currently unsupported."
     ;; via the control channel, using 'maybe-send-control-message!'.
     ;; Operations must be put in id->operation-map before sending them
     ;; to the service!
-    (define-record-type (<server> make-server server?)
-      (parent <losable>)
-      ;; terminal-condition: a disconnect has been requested
-      (fields (immutable terminal-condition server-terminal-condition)
-             (immutable control-channel server-control-channel)
-             ;; Atomic box holding an unsigned 64-bit integer.
-             (immutable next-unique-id/box server-next-unique-id/box))
+    (define-record-type (<server:dht> make-server server:dht?)
+      (parent <server>)
+      ;; Atomic box holding an unsigned 64-bit integer.
+      (fields (immutable next-unique-id/box server-next-unique-id/box))
       (protocol (lambda (%make)
                  (lambda ()
-                   ((%make (make-lost-and-found)) (make-condition) 
(make-channel)
+                   ((%make)
                     ;; Any ‘small’ natural number will do.
                     (make-atomic-box 0))))))
 
@@ -978,7 +978,7 @@ operation is cancelled, return @code{#false} instead."
                  ((? get? get)
                   (process-stop-search get)
                   (loop rest))
-                 ((? server? server)
+                 ((? server:dht? server)
                   (control* '(disconnect!))))))))))
       ;; Start the main event loop.
       (control))))
diff --git a/gnu/gnunet/nse/client.scm b/gnu/gnunet/nse/client.scm
index c54d664..e4986f1 100644
--- a/gnu/gnunet/nse/client.scm
+++ b/gnu/gnunet/nse/client.scm
@@ -53,6 +53,10 @@
                symbol-value value->index)
          (only (guile)
                define* const)
+         (only (gnu gnunet concurrency lost-and-found)
+               make-lost-and-found <losable>
+               losable-lost-and-found
+               collect-lost-and-found-operation)
          (only (gnu gnunet util struct)
                /:message-header)
          (only (gnu gnunet utils bv-slice)
@@ -81,6 +85,7 @@
       (opaque #t))
 
     (define-record-type (<server> %make-server server?)
+      (parent <losable>) ; for automatic fibers disposal when the <server> is 
unreachable
       ;; Atomic box of <estimate>
       (fields (immutable estimate/box server-estimate/box)
              ;; Atomic box of boolean.  Initially #f.  Set this
@@ -92,9 +97,10 @@
       (protocol
        (lambda (%make)
         (lambda ()
-          (%make (make-atomic-box #false)
-                 (make-atomic-box #false)
-                 (make-condition))))))
+          ((%make (make-lost-and-found))
+           (make-atomic-box #false)
+           (make-atomic-box #false)
+           (make-condition))))))
 
     (define (estimate server)
       "Return the current estimate of the number of peers on the network,
@@ -132,6 +138,7 @@ even if not connected.  This is an idempotent operation."
 
     ;; See 'connect'.
     (define* (reconnect estimate/box request-close?/box 
request-close-condition config
+                       lost-and-found
                        #:key
                        updated connected disconnected spawn #:rest rest)
       (define (handle-estimate! estimate-slice)
@@ -194,7 +201,7 @@ even if not connected.  This is an idempotent operation."
           ;; created.
           (unless (atomic-box-ref request-close?/box)
             (apply reconnect estimate/box request-close?/box 
request-close-condition
-                   config rest)))
+                   config lost-and-found rest)))
          ((connection:interrupted)
           (values))
          (else
@@ -207,6 +214,10 @@ even if not connected.  This is an idempotent operation."
       (define (request-close-handler)
        (perform-operation
         (choice-operation
+         ;; We lost ourselves, that means the server became unreachable.
+         ;; The presence of this line is tested by the "garbage collectable"
+         ;; test.
+         (collect-lost-and-found-operation lost-and-found)
          (wait-operation request-close-condition)
          ;; Make sure the fiber exits after a reconnect.
          (wait-operation mq-closed)))
@@ -235,6 +246,7 @@ The procedures @var{updated}, @var{connected} and 
@var{disconnected} are optiona
                 (server-request-close?/box server)
                 (server-request-close-condition server)
                 config
+                (losable-lost-and-found server)
                 #:updated updated #:connected connected #:disconnected 
disconnected
                 #:spawn spawn)
       server)))
diff --git a/gnu/gnunet/server.scm b/gnu/gnunet/server.scm
index 0bd9147..c9d6698 100644
--- a/gnu/gnunet/server.scm
+++ b/gnu/gnunet/server.scm
@@ -1,5 +1,5 @@
 ;; This file is part of Scheme-GNUnet
-;; Copyright © 2022 GNUnet e.V.
+;; Copyright © 2021, 2022 GNUnet e.V.
 ;;
 ;; Scheme-GNUnet is free software: you can redistribute it and/or modify it
 ;; under the terms of the GNU Affero General Public License as published
@@ -18,15 +18,21 @@
 
 ;; TODO: document
 (define-library (gnu gnunet server)
-  (export maybe-send-control-message!* make-error-handler)
+  (export maybe-send-control-message!* make-error-handler
+         <server> server-terminal-condition server-control-channel)
   (import (only (rnrs base)
-               begin define case else apply values quote)
+               begin define case else apply values quote lambda)
+         (only (rnrs records syntactic)
+               define-record-type)
          (only (fibers conditions)
-               wait-operation)
+               make-condition wait-operation)
          (only (fibers channels)
-               put-operation)
+               make-channel put-operation)
          (only (fibers operations)
-               choice-operation perform-operation))
+               choice-operation perform-operation)
+         (only (gnu gnunet concurrency lost-and-found)
+               make-lost-and-found collect-lost-and-found-operation
+               losable-lost-and-found))
   (begin
     (define (maybe-send-control-message!* terminal-condition control-channel
                                          . message)
@@ -68,4 +74,15 @@ This sends a @var{message} to @var{control-channel} or waits 
for
           (apply maybe-send-control-message!* terminal-condition
                  control-channel 'oops! key arguments)
           (values))))
-      error-handler)))
+      error-handler)
+
+    (define-record-type (<server> %make-server server?)
+      (parent <losable>)
+      ;; terminal-condition: a disconnect has been requested.
+      (fields (immutable terminal-condition server-terminal-condition)
+             (immutable control-channel server-control-channel))
+      (protocol (lambda (%make)
+                 (lambda ()
+                   ((%make (make-lost-and-found))
+                    (make-condition)
+                    (make-channel))))))))
diff --git a/guix.scm b/guix.scm
new file mode 100644
index 0000000..e38565f
--- /dev/null
+++ b/guix.scm
@@ -0,0 +1,67 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2021, 2022 GNUnet e.V.
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+;;;
+;;;  SPDX-License-Identifier: GPL-3.0-or-later
+
+(use-modules (gnu packages guile)
+            (gnu packages guile-xyz)
+            (gnu packages autotools)
+            (gnu packages gettext)
+            (gnu packages gnupg)
+            (gnu packages pkg-config)
+            (gnu packages xorg)
+            (gnu packages text-editors)
+            (guix packages)
+            (guix utils)
+            (guix gexp)
+            (guix git)
+            (guix git-download)
+            (guix download)
+            (guix build-system gnu)
+            ((guix licenses) #:prefix license:))
+
+(define %source-dir (dirname (current-filename)))
+
+(define-public scheme-gnunet
+  (package
+   (name "scheme-gnunet")
+   (version "0.2")
+   (source (local-file %source-dir
+                      #:recursive? #t
+                      #:select? (git-predicate %source-dir)))
+   (build-system gnu-build-system)
+   (propagated-inputs
+    (list guile-zlib guile-bytestructures guile-fibers guile-gcrypt
+         guile-json-4 guile-pfds))
+   (native-inputs
+    (list guile-3.0-latest guile-gcrypt guile-fibers-1.1 guile-json-4 
guile-pfds
+         automake
+         ;; Only used for testing.
+         guile-quickcheck
+          ;; Gettext brings 'AC_LIB_LINKFLAGS_FROM_LIBS'.
+         gettext-minimal
+         pkg-config
+         autoconf-wrapper
+         texmacs
+         xvfb-run))
+   (inputs (list guile-3.0-latest))
+   (synopsis "partial Scheme port of GNUnet")
+   (license license:agpl3+)
+   (description #f)
+   (home-page #f)))
+scheme-gnunet
diff --git a/tests/cadet.scm b/tests/cadet.scm
index f4cd279..046f52b 100644
--- a/tests/cadet.scm
+++ b/tests/cadet.scm
@@ -37,9 +37,14 @@
 (test-assert "(CADET) close, not connected --> all fibers stop, no callbacks 
called"
   (close-not-connected-no-callbacks "cadet" connect disconnect!))
 
-(test-skip 1) ; TODO: fix the bug
-(test-assert "(CADET) garbage collectable" ; TOO: error unbound variable 
(320:7 stub)
-  (garbage-collectable "cadet" connect))
+(test-assert "(CADET) garbage collectable"
+ (garbage-collectable "cadet" connect))
+
+(test-assert "(CADET) notify disconnected after end-of-file, after 'connected'"
+            (disconnect-after-eof-after-connected "cadet" connect))
+
+(test-assert "(CADET) reconnects"
+            (reconnects "cadet" connect))
 
 (define %peer-identity
   (bv-slice/read-write (u8-list->bytevector (iota (sizeof /peer-identity 
'())))))
diff --git a/tests/distributed-hash-table.scm b/tests/distributed-hash-table.scm
index fd24aa7..0a98e85 100644
--- a/tests/distributed-hash-table.scm
+++ b/tests/distributed-hash-table.scm
@@ -675,46 +675,6 @@ supported.  When @var{explode} is signalled, the 
connection is closed."
 (test-assert "(DHT) reconnects"
   (reconnects "dht" connect))
 
-(define* (determine-reported-errors proc #:key (n-connections 1) (n-errors 1))
-  (call-with-spawner/wait*
-   (lambda (config spawn)
-     (define errors '())
-     (define currently-connected? #false)
-     (define times-connected 0)
-     (define times-errored 0)
-     (define finally-disconnected-c (make-condition))
-     (define all-errors-c (make-condition))
-     (parameterize ((error-reporter (lambda foo
-                                     (assert (> times-connected 0))
-                                     (set! times-errored (+ 1 times-errored))
-                                     (set! errors (cons foo errors))
-                                     (when (>= times-errored n-errors)
-                                       (signal-condition! all-errors-c)))))
-       (define (connected)
-        (assert (not currently-connected?))
-        (set! currently-connected? #true)
-        (set! times-connected (+ 1 times-connected))
-        (assert (<= times-connected n-connections)))
-       (define (disconnected)
-        (assert currently-connected?)
-        (set! currently-connected? #false)
-        (when (= times-connected n-connections)
-          (signal-condition! finally-disconnected-c)))
-       (define server
-        (connect config #:connected connected #:disconnected disconnected
-                 #:spawn spawn))
-       ;; Give 'error-reporter' a chance to be called too often
-       (sleep 0.001)
-       ;; The error handler and 'disconnected' are called in no particular
-       ;; order, so we have to wait for both.
-       (wait finally-disconnected-c)
-       (wait all-errors-c)
-       ;; keep 'server' reachable long enough.
-       (pk server)
-       (and (not currently-connected?)
-           (= times-connected n-connections) errors)))
-   `(("dht" . ,proc))))
-
 (define (put-ill-formed-message port)
   (define b (make-bytevector (sizeof /:message-header '())))
   (define s (slice/write-only (bv-slice/read-write b)))
@@ -727,6 +687,8 @@ supported.  When @var{explode} is signalled, the connection 
is closed."
   `((logic:ill-formed
      ,(value->index (symbol-value message-type msg:dht:client:result))))
   (determine-reported-errors
+   "dht"
+   connect
    (lambda (port spawn-fiber)
      (put-ill-formed-message port)
      (close-port port))))
@@ -738,6 +700,8 @@ supported.  When @var{explode} is signalled, the connection 
is closed."
   `((logic:ill-formed
      ,(value->index (symbol-value message-type msg:dht:client:result))))
   (determine-reported-errors
+   "dht"
+   connect
    (let ((i 0))
      (lambda (port spawn-fiber)
        (set! i (+ i 1))
diff --git a/tests/network-size.scm b/tests/network-size.scm
index f809d6e..7e3e352 100644
--- a/tests/network-size.scm
+++ b/tests/network-size.scm
@@ -46,6 +46,19 @@
 
 (test-begin "network-size")
 
+(test-assert "close, not connected --> all fibers stop, no callbacks called"
+  (close-not-connected-no-callbacks
+   "nse" nse:connect nse:disconnect!
+   #:rest (list #:disconnected #{don't-call-me}#)))
+
+(test-assert "garbage collectable"
+  (garbage-collectable "nse" nse:connect))
+
+(test-assert "notify disconnected after end-of-file, after 'connected'"
+  (disconnect-after-eof-after-connected "nse" nse:connect))
+
+(test-assert "reconnects" (reconnects "nse" nse:connect))
+
 (define (no-error-handler . e)
   (pk 'e e)
   (error "no error handler"))
@@ -184,16 +197,6 @@
         (loop (standard-back-off time-delta))))
      #t)))
 
-(test-assert "notify disconnected after end-of-file, after 'connected'"
-  (disconnect-after-eof-after-connected "nse" nse:connect))
-
-(test-assert "reconnects" (reconnects "nse" nse:connect))
-
-(test-assert "close, not connected --> all fibers stop, no callbacks called"
-  (close-not-connected-no-callbacks
-   "nse" nse:connect nse:disconnect!
-   #:rest (list #:disconnected #{don't-call-me}#)))
-
 (test-assert "close, connected --> all fibers stop, two callbacks called"
   (call-with-spawner/wait
    (lambda (spawn)
diff --git a/tests/utils.scm b/tests/utils.scm
index 58628c7..7428281 100644
--- a/tests/utils.scm
+++ b/tests/utils.scm
@@ -28,6 +28,7 @@
   #:autoload (fibers timers) (sleep)
   #:autoload (gnu gnunet config db)
   (hash->configuration hash-key key=? set-value!)
+  #:autoload (gnu gnunet mq error-reporting) (error-reporter)
   #:export (conservative-gc? calls-in-tail-position?
                             call-with-services
                             call-with-services/fibers
@@ -42,7 +43,8 @@
                             close-not-connected-no-callbacks
                             garbage-collectable
                             disconnect-after-eof-after-connected
-                            reconnects))
+                            reconnects
+                            determine-reported-errors))
 
 (define (make-nonblocking! sock)
   (fcntl sock F_SETFL
@@ -362,3 +364,51 @@ sufficiently often."
        (wait connected-again)
        (assert connected?)
        #t))))
+
+(define* (determine-reported-errors service connect proc #:key (n-connections 
1) (n-errors 1))
+  "This procedure can be used as a basic for the error reporting logic --
+it connects to a simulated service, builds a list of errors passed to
+@code{error-reporter} and return it.  After a disconnect, it will automatically
+reconnect until @var{n-connections} have been made.  It also waits for 
@var{n-errors}
+to be gathered and verifies that all fibers complete.
+
+The simulation is done by the procedure @var{proc}.  It is a procedure 
accepting the
+connection port as seen by the server and can e.g. write to the port or close 
it."
+  (call-with-spawner/wait*
+   (lambda (config spawn)
+     (define errors '())
+     (define currently-connected? #false)
+     (define times-connected 0)
+     (define times-errored 0)
+     (define finally-disconnected-c (make-condition))
+     (define all-errors-c (make-condition))
+     (parameterize ((error-reporter (lambda foo
+                                     (assert (> times-connected 0))
+                                     (set! times-errored (+ 1 times-errored))
+                                     (set! errors (cons foo errors))
+                                     (when (>= times-errored n-errors)
+                                       (signal-condition! all-errors-c)))))
+       (define (connected)
+        (assert (not currently-connected?))
+        (set! currently-connected? #true)
+        (set! times-connected (+ 1 times-connected))
+        (assert (<= times-connected n-connections)))
+       (define (disconnected)
+        (assert currently-connected?)
+        (set! currently-connected? #false)
+        (when (= times-connected n-connections)
+          (signal-condition! finally-disconnected-c)))
+       (define server
+        (connect config #:connected connected #:disconnected disconnected
+                 #:spawn spawn))
+       ;; Give 'error-reporter' a chance to be called too often
+       (sleep 0.001)
+       ;; The error handler and 'disconnected' are called in no particular
+       ;; order, so we have to wait for both.
+       (wait finally-disconnected-c)
+       (wait all-errors-c)
+       ;; keep 'server' reachable long enough.
+       (pk server)
+       (and (not currently-connected?)
+           (= times-connected n-connections) errors)))
+   `((,service . ,proc))))

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



reply via email to

[Prev in Thread] Current Thread [Next in Thread]