[gnunet-scheme] 85/324: mq: Do not include callbacks in envelopes.

[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 fca741650ca94fae9df6dae7052408210555058b
Author: Maxime Devos <maximedevos@telenet.be>
AuthorDate: Tue Feb 23 17:31:29 2021 +0100

    mq: Do not include callbacks in envelopes.
    
    While callbacks are rather practical to use,
    particularily in a lispy language like Scheme,
    they will use whatever dynamic state is floating
    around (exception handlers, input/output ports, ...).
    
    Ambient authority is rather annoying ...
    
    * README.org (Conventions):
      new subsection ‘Fibers, capabilities and ambient authority’.
      (Modules): correct description of envelope.scm.
    * gnu/gnunet/message/envelope.scm
      (&double-notify-sent, make-double-notify-sent)
      (double-notify-sent?): new condition type to indicate a bad
       notify-sent!.
      (<envelope>, make-envelope): do not accept a callback anymore ...
      (notify-sent!, wait-sent-operation): ... signal a condition instead.
      (<envelope/dll>): this will probably end up to be a left-over from
      the C implementation; deprecate.
    * tests/envelope.scm: adjust test case to new API.
---
 README.org                      | 12 +++++-
 gnu/gnunet/message/envelope.scm | 86 +++++++++++++++++++++++++----------------
 tests/envelope.scm              | 66 ++++++++++++++++---------------
 3 files changed, 98 insertions(+), 66 deletions(-)

diff --git a/README.org b/README.org
index 46ac13d..b6ec797 100644
--- a/README.org
+++ b/README.org
@@ -46,7 +46,7 @@
 * Modules
   + gnu/gnunet/directory.scm: directory construction
   + gnu/gnunet/message/envelope.scm: some program data around
-    message types (e.g. priority, notify on sent hook)
+    message types (e.g. priority, notify-on-sent)
   + gnu/gnunet/concurrency/update.scm: a box with a value,
     that can be updated, resulting in a new box.  Updates
     can be waited upon.
@@ -100,6 +100,16 @@
      are created when accessing network structures with
      (gnu gnunet netstruct syntactic).
 * Conventions
+** Fibers, capabilities and ambient authority
+   Modules are expected to use ‘fibers’ for concurrency.
+
+   They should not introduce any ambient authority,
+   and avoid implicit use of pre-existing ambient authority
+   (e.g. current-output-port, the current persona).
+
+   To avoid accidental reuse of capabilities accross
+   modules, do not call callbacks where it can be avoided.
+   Consider conditions for signalling an event occurred instead.
 ** Documenting modules
    Add a little information to ‘* Modules’.
 ** Fiddling with options
diff --git a/gnu/gnunet/message/envelope.scm b/gnu/gnunet/message/envelope.scm
index 749017a..2849787 100644
--- a/gnu/gnunet/message/envelope.scm
+++ b/gnu/gnunet/message/envelope.scm
@@ -26,65 +26,85 @@
 ;; @author Maxime Devos
 ;; @file gnu/gnunet/message/envelope.scm
 
-(library (gnu gnunet message envelope)
+(define-library (gnu gnunet message envelope)
   (export <envelope> make-envelope envelope?
          <envelope/dll> make-envelope/dll envelope/dll?
          envelope-message-slice envelope-priority
-         notify-sent! envelope-dll-check envelope-dll)
+         notify-sent! wait-sent-operation
+         envelope-dll-check envelope-dll
+         &double-notify-sent make-double-notify-sent
+         double-notify-sent?)
   (import (gnu gnunet utils bv-slice)
          (srfi srfi-26)
          (rnrs base)
          (ice-9 optargs)
-         (rnrs records syntactic))
+         (rnrs records syntactic)
+         (only (rnrs exceptions)
+               raise)
+         (only (fibers conditions)
+               make-condition
+               signal-condition!
+               wait-operation)
+         (only (rnrs conditions)
+               condition &violation
+               make-who-condition
+               make-message-condition
+               define-condition-type))
   (begin
     (define-record-type (<envelope> make-envelope envelope?)
       (fields (immutable message-slice envelope-message-slice)
              (immutable message-prio  envelope-priority)
-             ;; Set to #t once the message is sent.
-             (mutable notify-sent! %envelope-notify-sent!
-                      %set-envelope-notify-sent!!))
+             ;; Signalled when the message has been sent.
+             (immutable message-sent envelope-message-sent-condition))
       (protocol
        (lambda (%make)
-        (lambda* (mh #:key
-                     (notify-sent! #f)
-                     (priority 0))
-          "Make a message envelope for the message @var{mh}
+        (lambda* (mh #:key (priority 0))
+          "Make a fresh message envelope for the message @var{mh}
 (a readable bytevector slice) and priority @var{priority}
-(a numeric value from @code{gnu gnunet util mq-enum}).
-
-When the message has been sent to the network (and thus
-cannot be cancelled anymore), the thunk @var{notify-sent!}
-should be called if present."
+(a numeric value from @code{gnu gnunet util mq-enum})."
           ;; FIXME also check if @var{mh} is large enough?
           (assert (slice-readable? mh))
-          (assert (or (not notify-sent!)
-                      (procedure? notify-sent!)))
           (assert (and (integer? priority)
                        (exact? priority)
                        (<= 0 priority)
                        ;; XXX magic number
                        (< priority 512)))
-          (%make mh priority notify-sent!))))
+          (%make mh priority (make-condition)))))
       (sealed #f)
       (opaque #t))
 
+    (define-condition-type &double-notify-sent &violation
+      make-double-notify-sent double-notify-sent?)
+
+    ;; See notify-sent!.
+    (define (notify-sent-condition)
+      (condition (make-double-notify-sent)
+                (make-who-condition 'notify-sent!)
+                (make-message-condition
+                 "notify-sent! was called twice on same envelope")))
+
     (define (notify-sent! ev)
-      "Call the ‘notify sent’ callback thunk of @var{ev}, if any.
-This may only be done once."
-      (let ((ev:notify-sent! (%envelope-notify-sent! ev)))
-       ;; Detect casual violations of the ‘only once’ rule.
-       ;; Won't always work in all MT scenario's, but this
-       ;; is ‘merely’ a rather convenient debugging and testing
-       ;; aid, not a protection against an attacker.
-       (assert (not (eq? #t ev:notify-sent!)))
-       (%set-envelope-notify-sent!! ev #t)
-       ;; First call %set-envelope-notify-sent!,
-       ;; and only then call the ev:notify-sent! thunk,
-       ;; to detect cases where ev:notify-sent! calls
-       ;; notify-sent! with @var{ev} again, and in
-       ;; case ev:notify-sent! throws an exception.
-       (and ev:notify-sent! (ev:notify-sent!))))
+      "Mark the envelope @var{ev} as sent.
+
+This is the responsibility of the transport.
+
+Conceptually, this should only be available to the message
+transport, but the only other potential user would be
+the message sender, so this shouldn't matter.
+
+It is an error to call more than one.  Currently,
+an appropriate @code{&double-notify-sent} is raised."
+      (if (signal-condition! (envelope-message-sent-condition ev))
+         (values)
+         (raise (notify-sent-condition))))
+
+    (define (wait-sent-operation ev)
+      "Return an operation for waiting until the envelope
+@var{ev} has been sent.  If the message has already been sent,
+this operation returns immediately."
+      (wait-operation (envelope-message-sent-condition ev)))
 
+    ;; XXX I doubt this will see any use.
     (define-record-type (<envelope/dll> make-envelope/dll envelope/dll?)
       (fields (immutable capability %envelope/dll-capability)
              (mutable left %envelope/dll-previous
diff --git a/tests/envelope.scm b/tests/envelope.scm
index 06906bb..eb6f39f 100644
--- a/tests/envelope.scm
+++ b/tests/envelope.scm
@@ -19,6 +19,8 @@
 (use-modules (gnu gnunet message envelope)
             (gnu gnunet utils bv-slice)
             (ice-9 control)
+            (ice-9 receive)
+            (fibers operations)
             (rnrs bytevectors)
             (srfi srfi-26))
 
@@ -47,32 +49,38 @@
   (test-error "fractional priorities are rejected" #t
              (mk-prio 1/2)))
 
-;; Notify sent callbacks
-(let ((mk-notify-sent (cute make-envelope %arbitrary-slice
-                           #:notify-sent! <>)))
-  (test-assert "allow #f as notify-sent!"
-    (begin (notify-sent! (mk-notify-sent #f)) #t))
-  (test-error "notify-sent! can only be called once (#f)"
-    #t
-    (let ((ev (mk-notify-sent #f)))
-      (notify-sent! ev)
-      (notify-sent! ev)))
-  (test-assert "notify-sent! thunk is called exactly once"
-    (let* ((count 0)
-          (thunk (lambda () (set! count (+ 1 count)))))
-      (notify-sent! (mk-notify-sent thunk))
-      (= count 1)))
-  (test-error "no recursion in notify-sent! allowed"
-    #t
-    (let/ec success
-      (letrec* ((recursive (make-parameter #f))
-               (thunk (lambda ()
-                        (if (recursive)
-                            (success)
-                            (parameterize ((recursive #t))
-                              (notify-sent! ev)))))
-               (ev (mk-notify-sent thunk)))
-       (notify-sent! ev)))))
+;; Notify sent events
+(let ((mk (cute make-envelope %arbitrary-slice)))
+  (test-equal "notify-sent! is usable"
+    '()
+    (receive result (notify-sent! (mk))
+      result))
+
+  (test-equal "wait-sent-operation returns after notify-sent!"
+    '()
+    (let ((a (mk)))
+      (notify-sent! a)
+      (receive result (perform-operation (wait-sent-operation a))
+       result)))
+
+  (test-equal "wait-sent-operation can be used twice"
+    '(() . ())
+    (let ((a (mk)))
+      (notify-sent! a)
+      (cons
+       (receive result (perform-operation (wait-sent-operation a))
+          result)
+       (receive result (perform-operation (wait-sent-operation a))
+          result))))
+
+  (test-error "don't call notify-sent! twice"
+    &double-notify-sent
+    (let ((a (mk)))
+      (notify-sent! a)
+      (notify-sent! a))))
+
+;; Whether wait-sent blocking cannot really be tested
+;; without resorting to time-outs.
 
 ;; Message slice
 (let ((mk-slice (cute make-envelope <>)))
@@ -99,12 +107,6 @@
 ;; Envelope DLL
 (let ((mk-dll (cute make-envelope/dll <> %arbitrary-slice)))
   (mk-dll 'stuff)
-  (test-assert "make-envelope/dll allows #:notify-sent!"
-    (let/ec ec
-      (notify-sent!
-       (make-envelope/dll 'cap %arbitrary-slice
-                         #:notify-sent! (lambda () (ec #t))))
-      #f))
   (test-equal "make-envelope/dll allows #:priority"
     444
     (envelope-priority

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