mq-impl/stream: Allow closing queues made with connect-fibers.

* gnu/gnunet/mq-impl/stream.scm
  (connect/fibers): Document new behaviour.
  (connect/fibers)[interrupt-condition]: New variable.
  (connect/fibers)[close*!]: New procedure.
  (connect/fibers)[mq]: Use new procedure.
  (connect/fibers)[allow-interrupt-operation]: New variable.
  (connect/fibers)[sleep*]: New procedure.
  (connect/fibers): Pass new 'sleep*' procedure to 'connect-unix'.
  (connect/fibers): Inject 'connection:interrupted' if appropriate
  instead of 'connection:connected'.
  (connect-unix): Add 'sleep' argument.
* doc/scheme-gnunet.tm (Disconnecting): New section.
* tests/mq-stream.scm
  ("can close while still connecting (--> interrupted)")
  ("can close after being connected (--> regular-end-of-file)"):
  New tests.
* README.org (List of errors): Note existence of 'connectin:interrupted'.

1 files changed, 62 insertions, 0 deletions

diff --git a/tests/mq-stream.scm b/tests/mq-stream.scm
index f5a56e6..6b1850a 100644
--- a/tests/mq-stream.scm
+++ b/tests/mq-stream.scm
@@ -751,4 +751,66 @@ If an EPIPE system error is raised, return #f."
          #:parallelism 1)
         (port-closed? alpha)))
 
+(test-assert "can close while still connecting (--> interrupted)"
+  (call-with-socket-location
+   (lambda (where config)
+     (call-with-spawner/wait
+      (lambda (spawn)
+        (define interrupted? #f)
+        (define cond (make-condition))
+        (define (error-handler . e)
+          (match e
+            ('(connection:interrupted)
+             (begin
+               (pk 'interrupted)
+               (assert (not interrupted?))
+               (set! interrupted? #t)
+               (signal-condition! cond)))
+            (_ (error "what ~a" e))))
+        (define mq (connect/fibers config "service" no-handlers error-handler
+                                   #:spawn spawn))
+        (close-queue! mq)
+        (wait cond)
+        #t)))))
+
+(test-assert "can close after being connected (--> regular-end-of-file)"
+  (call-with-socket-location
+   (lambda (where config)
+     (call-with-spawner/wait
+      (lambda (spawn)
+        (define connected? #f)
+        (define connected-condition (make-condition))
+        (define disconnected? #f)
+        (define disconnected-condition (make-condition))
+        (define (error-handler . e)
+          (match e
+            ('(connection:connected)
+             (pk 'connected)
+             (assert (not connected?))
+             (set! connected? #t)
+             (signal-condition! connected-condition))
+            ('(input:regular-end-of-file)
+             (assert connected?)
+             (assert (not disconnected?))
+             (set! disconnected? #t)
+             (signal-condition! disconnected-condition))
+            (_ (error "what ~a" e))))
+        (define mq (connect/fibers config "service" no-handlers error-handler
+                                   #:spawn spawn))
+        (spawn
+         (lambda ()
+           (define listening-sock (socket PF_UNIX SOCK_STREAM 0))
+           (bind listening-sock AF_UNIX where)
+           (listen listening-sock 1)
+           ;; Make it non-blocking (because guile-fibers is used)
+           (fcntl listening-sock F_SETFL
+                  (bitwise-ior (fcntl listening-sock F_GETFL) O_NONBLOCK))
+           ;; Not actually interested in the return value
+           (accept listening-sock)))
+        (wait connected-condition)
+        (assert (not disconnected?))
+        (close-queue! mq)
+        (wait disconnected-condition)
+        #t)))))
+
 (test-end "mq-stream")