[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[gnunet-scheme] 63/324: Define message envelope type and procedures.
From: |
gnunet |
Subject: |
[gnunet-scheme] 63/324: Define message envelope type and procedures. |
Date: |
Tue, 21 Sep 2021 13:21:43 +0200 |
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 a55cc7e79dfb836344c33161ebeb95c034bf1095
Author: Maxime Devos <maximedevos@telenet.be>
AuthorDate: Sat Jan 30 15:25:53 2021 +0100
Define message envelope type and procedures.
The message envelope is a nice Scheme record wrapped
around the ‘real’ duocentehexaquinquagesimal network
messages, and includes some niceties such as a ‘notify
on sent’ hook and a priority-preference value.
FIXME: the test found a bug in bv-slice.scm.
* README.org (Modules): note that
gnu/gnunet/message/envelope.scm exists.
* gnu/gnunet/message/envelope.scm: new records and
associated procedures.
* tests/envelope.scm: test it.
---
README.org | 2 +
gnu/gnunet/message/envelope.scm | 118 ++++++++++++++++++++++++++++++++++++
tests/envelope.scm | 129 ++++++++++++++++++++++++++++++++++++++++
3 files changed, 249 insertions(+)
diff --git a/README.org b/README.org
index ab1d5f9..e075eef 100644
--- a/README.org
+++ b/README.org
@@ -30,6 +30,8 @@
+ gnu/gnunet/util/mq.scm and friends: message queues for
network messages, and calling an appropriate handler for
each message type.
+ + gnu/gnunet/message/envelope.scm: some program data around
+ message types (e.g. priority, notify on sent hook)
* Conventions
** Fiddling with options
Options like ‘priority’, ‘anonymity’, ‘replication’
diff --git a/gnu/gnunet/message/envelope.scm b/gnu/gnunet/message/envelope.scm
new file mode 100644
index 0000000..cf2fc41
--- /dev/null
+++ b/gnu/gnunet/message/envelope.scm
@@ -0,0 +1,118 @@
+;; This file is part of scheme-GNUnet.
+;; Copyright (C) 2012-2019 GNUnet e.V.
+;; Copyright (C) 2021 Maxime Devos
+;;
+;; 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
+;; by the Free Software Foundation, either version 3 of the License,
+;; or (at your option) any later version.
+;;
+;; scheme-GNUnet 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
+;; Affero General Public License for more details.
+;;
+;; You should have received a copy of the GNU Affero General Public License
+;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+;;
+;; SPDX-License-Identifier: AGPL3.0-or-later
+
+;; Upstream GNUnet:
+;; @author Florian Dold
+;; @file util/mq.c
+;; @brief general purpose request queue
+;;
+;; Scheme-GNUnet:
+;; @author Maxime Devos
+;; @file gnu/gnunet/message/envelope.scm
+
+(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)
+ (import (gnu gnunet utils bv-slice)
+ (srfi srfi-26)
+ (rnrs base)
+ (ice-9 optargs)
+ (rnrs records syntactic))
+ (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!!))
+ (protocol
+ (lambda (%make)
+ (lambda* (mh #:key
+ (notify-sent! #f)
+ (priority 0))
+ "Make a 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."
+ ;; 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!))))
+ (sealed #f)
+ (opaque #t))
+
+ (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!))))
+
+ (define-record-type (<envelope/dll> make-envelope/dll envelope/dll?)
+ (fields (immutable capability %envelope/dll-capability)
+ (mutable left %envelope/dll-previous
+ %set-envelope/dll-previous!)
+ (mutable right %envelope/dll-next
+ %set-envelope/dll-next!))
+ (protocol
+ (lambda (%make)
+ (lambda (cap . args)
+ "A variant of @code{make-envelope}, that organises envelopes
+in a linked list. The capability @var{cap} will be required for accessing
+and modifying this list."
+ (apply %make cap #f #f args))))
+ (sealed #f)
+ (opaque #t))
+
+ (define (envelope-dll-check ev/dll cap)
+ "Verify whether the capability @var{cap} can be used
+for accessing the underlying DLL of the envelope @var{ev}.
+If not, raise an exception."
+ ;; FIXME &bad-capability exception?
+ (assert (eq? (%envelope/dll-capability ev/dll) cap)))
+
+ (define (envelope-dll ev/dll cap)
+ "Return the DLL procedures of the DLL envelope @var{ev/dll},
+using the capability @var{cap}."
+ (envelope-dll-check ev/dll cap)
+ (values (cute %envelope/dll-previous ev/dll)
+ (cute %set-envelope/dll-previous! ev/dll <>)
+ (cute %envelope/dll-next ev/dll)
+ (cute %set-envelope/dll-next! ev/dll <>)))))
diff --git a/tests/envelope.scm b/tests/envelope.scm
new file mode 100644
index 0000000..06906bb
--- /dev/null
+++ b/tests/envelope.scm
@@ -0,0 +1,129 @@
+;; This file is part of scheme-GNUnet.
+;; Copyright (C) 2021 Maxime Devos
+;;
+;; 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
+;; by the Free Software Foundation, either version 3 of the License,
+;; or (at your option) any later version.
+;;
+;; scheme-GNUnet 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
+;; Affero General Public License for more details.
+;;
+;; You should have received a copy of the GNU Affero General Public License
+;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+;;
+;; SPDX-License-Identifier: AGPL3.0-or-later
+
+(use-modules (gnu gnunet message envelope)
+ (gnu gnunet utils bv-slice)
+ (ice-9 control)
+ (rnrs bytevectors)
+ (srfi srfi-26))
+
+(test-begin "envelope")
+
+(define %arbitrary-slice (make-slice/read-write 50))
+(define %arbitrary-bv (make-bytevector 50))
+(define %arbitrary-priority 7)
+(define (%bogus-notify-sent!) (throw 'what))
+
+;; Priorities (represented by raw integers)
+(let ((mk-prio (cute make-envelope %arbitrary-slice
+ #:priority <>))
+ (acceptable-priorities
+ '(0 1 511)))
+ (test-equal "priorities are preserved"
+ acceptable-priorities
+ (map (compose envelope-priority mk-prio)
+ acceptable-priorities))
+ (test-error "priorities ≥ 512 are rejected" #t
+ (mk-prio 512))
+ (test-error "priorities < 0 are rejected" #t
+ (mk-prio -1))
+ (test-error "inexact priorities are rejected" #t
+ (mk-prio 0.))
+ (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)))))
+
+;; Message slice
+(let ((mk-slice (cute make-envelope <>)))
+ (test-error "message must be a slice (bv)"
+ #t
+ (mk-slice %arbitrary-bv))
+ (test-error "message must be a slice (#f)"
+ #t
+ (mk-slice #f))
+ (test-error "slice must be readable"
+ #t
+ (mk-slice (slice/write-only (make-slice/read-write 50))))
+ (test-expect-fail 1)
+ (test-error "slice may be writable"
+ #t
+ (mk-slice (make-slice/read-write 50)))
+ ;; It isn't required that they be eq?, per se,
+ ;; but rather, it should point to the same
+ ;; memory region.
+ (test-eq "slice is preserved"
+ %arbitrary-slice
+ (envelope-message-slice (mk-slice %arbitrary-slice))))
+
+;; 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
+ (make-envelope/dll 'cap %arbitrary-slice
+ #:priority 444)))
+ (test-assert "envelope/dll? implies envelope?"
+ (envelope? (mk-dll 'check)))
+ (test-assert "envelope? does not imply envelope/dll?"
+ (not (envelope/dll? (make-envelope %arbitrary-slice))))
+
+ (test-assert "capability check success"
+ (envelope-dll-check (mk-dll 'cap) 'cap))
+ (test-error "capability check failure" #t
+ (envelope-dll-check (mk-dll 'cap) 'imposter))
+
+ (test-error "envelope-dll checks capability (failure)" #t
+ (envelope-dll (mk-dll 'cap) 'imposter))
+ (test-assert "envelope-dll checks capability (success)"
+ (envelope-dll (mk-dll 'cap) 'cap)))
+;; XXX test DLL, this requires a DLL library
+
+(test-end "envelope")
--
To stop receiving notification emails like this one, please contact
gnunet@gnunet.org.
- [gnunet-scheme] 49/324: scripts: publish-store: correct file name creation, (continued)
- [gnunet-scheme] 49/324: scripts: publish-store: correct file name creation, gnunet, 2021/09/21
- [gnunet-scheme] 57/324: mq: define priority and preference values, gnunet, 2021/09/21
- [gnunet-scheme] 59/324: Fix value creation in integer->value, gnunet, 2021/09/21
- [gnunet-scheme] 54/324: Add missing dependency ‘guix-stuff.scm’, gnunet, 2021/09/21
- [gnunet-scheme] 62/324: Change e-mail address, gnunet, 2021/09/21
- [gnunet-scheme] 58/324: scripts: publish-store: use SRFI-39 parameters for configuration, gnunet, 2021/09/21
- [gnunet-scheme] 61/324: Write code for message handlers, gnunet, 2021/09/21
- [gnunet-scheme] 55/324: enum: implement docstrings and general niceness, gnunet, 2021/09/21
- [gnunet-scheme] 56/324: Define many GNUnet message types., gnunet, 2021/09/21
- [gnunet-scheme] 69/324: doc: Update ROADMAP with steps to do, gnunet, 2021/09/21
- [gnunet-scheme] 63/324: Define message envelope type and procedures.,
gnunet <=
- [gnunet-scheme] 73/324: concurrency: implement an ‘update stream’, gnunet, 2021/09/21
- [gnunet-scheme] 81/324: nse: define network structures., gnunet, 2021/09/21
- [gnunet-scheme] 74/324: build: add autotools scripts, gnunet, 2021/09/21
- [gnunet-scheme] 78/324: scripts: download-store: remove debugging, gnunet, 2021/09/21
- [gnunet-scheme] 60/324: Allow using integer->value on maximal value, gnunet, 2021/09/21
- [gnunet-scheme] 68/324: scripts: download-store: allow downloads in nar format, gnunet, 2021/09/21
- [gnunet-scheme] 67/324: scripts: Don't flatten the FS tree and use SXML instead of JSON, gnunet, 2021/09/21
- [gnunet-scheme] 66/324: Document how to use GNUnet FS without networking., gnunet, 2021/09/21
- [gnunet-scheme] 70/324: doc: Progress update in README.org, gnunet, 2021/09/21
- [gnunet-scheme] 72/324: mq: fix make-envelope/dll constructor., gnunet, 2021/09/21