[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[gnunet-scheme] branch master updated (59ef9f9 -> 079243f)
|
From: |
gnunet |
|
Subject: |
[gnunet-scheme] branch master updated (59ef9f9 -> 079243f) |
|
Date: |
Tue, 22 Feb 2022 20:36:43 +0100 |
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 59ef9f9 Unify some procedures in CADET and DHT client libraries.
new 39ce0bf utils/bv-slice: Define copying procedures.
new d12032f utils/bv-slice: Define ‘slice-independent’ procedure.
new 079243f cadet/client: Define the record type for CADET addresses.
The 3 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:
gnu/gnunet/cadet/client.scm | 31 +++++--
gnu/gnunet/dht/client.scm | 21 ++---
gnu/gnunet/utils/bv-slice.scm | 38 +++++++-
tests/bv-slice.scm | 183 +++++++++++++++++++++++++++++++++++++++
tests/cadet.scm | 61 +++++++++++++
tests/distributed-hash-table.scm | 3 -
6 files changed, 314 insertions(+), 23 deletions(-)
diff --git a/gnu/gnunet/cadet/client.scm b/gnu/gnunet/cadet/client.scm
index ab57e8b..f863d49 100644
--- a/gnu/gnunet/cadet/client.scm
+++ b/gnu/gnunet/cadet/client.scm
@@ -20,16 +20,24 @@
make-cadet-address cadet-address? cadet-address-peer
cadet-address-port
channel? open-channel! close-channel!
port? open-port! close-port!)
- (import (only (gnu gnunet concurrency lost-and-found)
+ (import (only (gnu gnunet crypto struct)
+ /peer-identity)
+ (only (gnu gnunet concurrency lost-and-found)
make-lost-and-found collect-lost-and-found-operation)
(only (gnu gnunet mq handler) message-handlers)
(only (gnu gnunet mq) close-queue!)
(only (gnu gnunet server)
maybe-send-control-message!* make-error-handler)
+ (only (gnu gnunet hashcode struct)
+ /hashcode:512)
(only (gnu gnunet mq-impl stream) connect/fibers)
+ (only (gnu gnunet netstruct syntactic)
+ sizeof)
+ (only (gnu gnunet utils bv-slice)
+ slice-copy/read-only slice-length)
(only (rnrs base)
begin define lambda assert quote cons apply values
- case else)
+ case else =)
(only (rnrs records syntactic) define-record-type)
(only (ice-9 match) match)
(only (guile) define*)
@@ -111,12 +119,23 @@
;; Start the main event loop.
(control))
+ (define-record-type (<cadet-address> make-cadet-address cadet-address?)
+ (fields (immutable peer cadet-address-peer)
+ (immutable port cadet-address-port))
+ (protocol (lambda (%make)
+ "Make a CADET address for contacting the peer @var{peer}
+(a readable bytevector slice containing a @code{/peer-identity}) at port
+@var{port} (a readable bytevector slice containing a @code{/hashcode:512}).
+The slices @var{peer} and @var{port} are copied, so future changes to them
+do not have any impact on the cadet address."
+ (lambda (peer port)
+ (assert (= (sizeof /peer-identity '()) (slice-length peer)))
+ (assert (= (sizeof /hashcode:512 '()) (slice-length port)))
+ (%make (slice-copy/read-only peer)
+ (slice-copy/read-only port))))))
+
(define (stub . foo)
(error "todo"))
- (define make-cadet-address stub)
- (define cadet-address? stub)
- (define cadet-address-peer stub)
- (define cadet-address-port stub)
(define channel? stub)
(define open-channel! stub)
(define close-channel! stub)
diff --git a/gnu/gnunet/dht/client.scm b/gnu/gnunet/dht/client.scm
index 6b4f74c..db999fb 100644
--- a/gnu/gnunet/dht/client.scm
+++ b/gnu/gnunet/dht/client.scm
@@ -110,7 +110,8 @@
read% sizeof set%! select)
(only (gnu gnunet utils bv-slice)
slice-length slice/read-only make-slice/read-write slice-copy!
- slice-slice verify-slice-readable)
+ slice-slice verify-slice-readable slice-copy/read-write
+ slice-copy/read-only)
(gnu gnunet utils hat-let)
(only (gnu gnunet utils cut-syntax)
cut-syntax)
@@ -246,18 +247,12 @@ If this bound is exceeded, an appropriate
@code{&overly-large-datum} and
(slice/read-only value)
expiration))))) ; TODO validate expiration
- ;; XXX deduplicate
- (define (slice-copy slice)
- (define new (make-slice/read-write (slice-length slice)))
- (slice-copy! slice new)
- new)
-
(define (copy-datum old)
"Make a copy of the datum @var{old}, such that modifications to the
slices in @var{old} do not impact the new datum."
(make-datum (datum-type old)
- (slice-copy (datum-key old))
- (slice-copy (datum-value old))
+ (slice-copy/read-only (datum-key old))
+ (slice-copy/read-only (datum-value old))
#:expiration (datum-expiration old)))
;; A request to insert something in the DHT.
@@ -309,7 +304,7 @@ query object with the predicate @code{query?}."
"Make a copy of the query object @var{old}, such that modifications to
the
slices in @var{old} do not impact the new query object."
(make-query (query-type old)
- (slice-copy (query-key old))
+ (slice-copy/read-only (query-key old))
#:desired-replication-level
(query-desired-replication-level old)))
@@ -395,8 +390,10 @@ slices in @var{old} do not impact the new search result."
(define get-path (search-result-get-path old))
(define put-path (search-result-put-path old))
(datum->search-result (copy-datum (search-result->datum old))
- #:get-path (and get-path (slice-copy get-path))
- #:put-path (and put-path (slice-copy put-path))))
+ #:get-path
+ (and get-path (slice-copy/read-only get-path))
+ #:put-path
+ (and put-path (slice-copy/read-only put-path))))
diff --git a/gnu/gnunet/utils/bv-slice.scm b/gnu/gnunet/utils/bv-slice.scm
index 550ddff..c171039 100644
--- a/gnu/gnunet/utils/bv-slice.scm
+++ b/gnu/gnunet/utils/bv-slice.scm
@@ -59,6 +59,8 @@
;; Large operations
slice-copy!
slice-zero!
+ slice-copy/read-write
+ slice-copy/read-only
;; Exceptions
&missing-capabilities
@@ -67,7 +69,9 @@
missing-capabilities-what
missing-capabilities-permitted
missing-capabilities-required
- CAP_READ CAP_WRITE)
+ CAP_READ CAP_WRITE
+
+ slice-independent?)
(import (rnrs arithmetic bitwise)
(rnrs base)
(rnrs bytevectors)
@@ -331,4 +335,34 @@ the writable slice @var{slice}. The slices may overlap."
(bytevector-copy! (slice-bv from) (slice-offset from)
(slice-bv to) (slice-offset to)
(slice-length from))
- (values)))
+ (values))
+
+ (define (slice-copy/read-write original)
+ "Return a fresh read-write slice with the same contents as @var{original}.
+Future modifications to @var{original} will not impact the returned slice.
+The slice @var{original} must be readable."
+ (verify-slice-readable 'original original)
+ (define new (make-slice/read-write (slice-length original)))
+ (slice-copy! original new)
+ new)
+
+ (define (slice-copy/read-only original)
+ "Return a fresh read-only slice with the same contents as @var{original}.
+Future modifications to @var{original} will not impact the returned slice.
+THe slice @var{originall} must be readable."
+ (slice/read-only (slice-copy/read-write original)))
+
+ (define (slice-independent? x y)
+ "Return @code{#true} if all changes to the bytes in @var{x} do not
+impact @var{y}, @code{#false} otherwise. This is a symmetric relation.
+If @var{x} or @var{y} is empty, the slices @var{x} and @var{y} are independent.
+The capabilities of @var{x} and @var{y} are irrelevant."
+ ;; Except for utils/bv-slice.scm, the tests actually only require
+ ;; @code{(not (eq? (slice-bv x) (slice-bv y)))}.
+ ;;
+ ;; TODO: should write access to 'x' or 'y' be required?
+ (or (not (eq? (slice-bv x) (slice-bv y)))
+ (= 0 (slice-length x))
+ (= 0 (slice-length y))
+ (<= (+ (slice-offset x) (slice-length x)) (slice-offset y))
+ (<= (+ (slice-offset y) (slice-length y)) (slice-offset x)))))
diff --git a/tests/bv-slice.scm b/tests/bv-slice.scm
index de97c92..edaefbf 100644
--- a/tests/bv-slice.scm
+++ b/tests/bv-slice.scm
@@ -19,7 +19,9 @@
(import (gnu gnunet utils bv-slice)
(srfi srfi-26)
(ice-9 match)
+ (only (rnrs base) assert)
(rnrs conditions)
+ (rnrs control)
(rnrs exceptions)
(rnrs bytevectors))
@@ -176,6 +178,187 @@
(object->string
(slice/write-only (bv-slice/read-write #vu8(1 2 3)))))
+(test-missing-caps
+ "source of slice-copy/read-write must be readable"
+ 'original
+ CAP_WRITE
+ CAP_READ
+ (slice-copy/read-write (slice/write-only (make-slice/read-write 9))))
+
+(test-missing-caps
+ "even if the length is zero"
+ 'original
+ CAP_WRITE
+ CAP_READ
+ (slice-copy/read-write (slice/write-only (make-slice/read-write 0))))
+
+(test-assert "return value of slice-copy/read-write is read-write"
+ (let ((copy (slice-copy/read-write (make-slice/read-write 9))))
+ (and (slice-readable? copy) (slice-writable? copy))))
+(test-assert "return value of slice-copy/read-write is read-write, even if
length is zero"
+ (let ((copy (slice-copy/read-write (make-slice/read-write 0))))
+ (and (slice-readable? copy) (slice-writable? copy))))
+
+(test-assert "return value of slice-copy/read-write independent of original"
+ (let* ((original (make-slice/read-write 9))
+ (copy (slice-copy/read-write original)))
+ (slice-independent? original copy)))
+(test-assert "return value of slice-copy/read-write is fresh even if length is
zero"
+ (let* ((original (make-slice/read-write 0))
+ (copy (slice-copy/read-write original)))
+ (not (eq? original copy))))
+(test-equal "slice-copy/read-write returns something with the same contents
(1)"
+ #vu8(10 9 8 7 6 5)
+ (let* ((original (bv-slice/read-write #vu8(11 10 9 8 7 6 5 4) 1 6))
+ (copy (slice-copy/read-write original))
+ (bv (make-bytevector 6)))
+ (slice-copy! copy (bv-slice/read-write bv))
+ bv))
+(test-equal "slice-copy/read-write returns something with the same contents
(2)"
+ #vu8(10 9 8 7 6 5)
+ (let* ((original (slice/read-only
+ (bv-slice/read-write #vu8(11 10 9 8 7 6 5 4) 1 6)))
+ (copy (slice-copy/read-write original))
+ (bv (make-bytevector 6)))
+ (slice-copy! copy (bv-slice/read-write bv))
+ bv))
+
+(test-missing-caps
+ "source of slice-copy/read-only must be readable"
+ 'original
+ CAP_WRITE
+ CAP_READ
+ (slice-copy/read-only (slice/write-only (make-slice/read-write 9))))
+
+(test-missing-caps
+ "even if the size is zero"
+ 'original
+ CAP_WRITE
+ CAP_READ
+ (slice-copy/read-only (slice/write-only (make-slice/read-write 0))))
+
+(test-assert "return value of slice-copy/read-only is read-only"
+ (let ((copy (slice-copy/read-only (make-slice/read-write 9))))
+ (and (slice-readable? copy) (not (slice-writable? copy)))))
+(test-assert "return value of slice-copy/read-only is read-only, even if
length is zero"
+ (let ((copy (slice-copy/read-only (make-slice/read-write 0))))
+ (and (slice-readable? copy) (not (slice-writable? copy)))))
+(test-assert "return value of slice-copy/read-only independent of original"
+ (let* ((original (make-slice/read-write 9))
+ (copy (slice-copy/read-only original)))
+ (slice-independent? original copy)))
+(test-assert "return value of slice-copy/read-only is fresh even if length is
zero (1)"
+ (let* ((original (make-slice/read-write 0))
+ (copy (slice-copy/read-only original)))
+ (not (eq? original copy))))
+(test-assert "return value of slice-copy/read-only is fresh even if length is
zero (2)"
+ (let* ((original (slice/read-only (make-slice/read-write 0)))
+ (copy (slice-copy/read-only original)))
+ (not (eq? original copy))))
+(test-equal "slice-copy/read-only returns something with the same contents (1)"
+ #vu8(10 9 8 7 6 5)
+ (let* ((original (bv-slice/read-write #vu8(11 10 9 8 7 6 5 4) 1 6))
+ (copy (slice-copy/read-only original))
+ (bv (make-bytevector 6)))
+ (slice-copy! copy (bv-slice/read-write bv))
+ bv))
+(test-equal "slice-copy/read-only returns something with the same contents (2)"
+ #vu8(10 9 8 7 6 5)
+ (let* ((original (slice/read-only
+ (bv-slice/read-write #vu8(11 10 9 8 7 6 5 4) 1 6)))
+ (copy (slice-copy/read-only original))
+ (bv (make-bytevector 6)))
+ (slice-copy! copy (bv-slice/read-write bv))
+ bv))
+
+(test-assert "empty slices are independent"
+ (slice-independent? (make-slice/read-write 0) (make-slice/read-write 0)))
+
+(test-assert "empty slices are independent, even if using the same bytevector"
+ (let ((bv #vu8()))
+ (slice-independent? (bv-slice/read-write bv) (bv-slice/read-write bv))))
+
+(test-assert "empty slices are independent, even when using offsets (1)"
+ (let ((bv #vu8(0 1 2 3)))
+ (slice-independent? (bv-slice/read-write bv 1 0)
+ (bv-slice/read-write bv 2 0))))
+
+(test-assert "empty slices are independent, even when using offsets (2)"
+ (let ((bv #vu8(0 1 2 3)))
+ (slice-independent? (bv-slice/read-write bv 2 0)
+ (bv-slice/read-write bv 1 0))))
+
+(test-assert "empty slices are independent, even if eq?"
+ (let ((s (bv-slice/read-write #vu8())))
+ (slice-independent? s s)))
+
+(test-assert "slice-independent? is irreflexive (assuming non-empty) and
ignores capabilities (1)"
+ (let ((s (make-slice/read-write 99)))
+ (not (slice-independent? (slice/write-only s) (slice/read-only s)))))
+
+(test-assert "slice-independent? is irreflexive (assuming non-empty) and
ignores capabilities (2)"
+ (let ((s (make-slice/read-write 1)))
+ (not (slice-independent? (slice/write-only s) (slice/read-only s)))))
+
+(test-assert "empty slice is independent, even if inside the other slice"
+ (let ((bv #vu8(0 1 2 3 4 5 6 7 8 9)))
+ (do ((offset-x 0 (+ 1 offset-x)))
+ ((> offset-x (bytevector-length bv)) #true)
+ (do ((length-x 0 (+ 1 length-x)))
+ ((>= length-x (- (bytevector-length bv) offset-x)))
+ (let ((x (bv-slice/read-write bv offset-x length-x)))
+ (do ((offset 0 (+ 1 offset)))
+ ((>= offset (bytevector-length bv)) (values))
+ (let ((y (bv-slice/read-write bv offset 0)))
+ (assert (slice-independent? x y))
+ (assert (slice-independent? y x)))))))))
+
+(test-assert "non-overlapping ranges are independent"
+ (let ((bv #vu8(0 1 2 3 4 5 6 7 8 9)))
+ (do ((offset-x 0 (+ 1 offset-x)))
+ ((> offset-x (bytevector-length bv)) #true)
+ (do ((length-x 0 (+ 1 length-x)))
+ ((>= length-x (- (bytevector-length bv) offset-x)))
+ (let ((x (bv-slice/read-write bv offset-x length-x)))
+ ;; Make a slice on the left
+ (do ((offset-y 0 (+ 1 offset-y)))
+ ((> offset-y offset-x))
+ (do ((length-y 0 (+ 1 length-y)))
+ ((>= (+ length-y offset-y) offset-x))
+ (let ((y (bv-slice/read-write bv offset-y length-y)))
+ (assert (slice-independent? x y))
+ (assert (slice-independent? y x)))))
+ ;; And a slice on the right
+ (do ((offset-y (+ offset-x length-x) (+ 1 offset-y)))
+ ((> offset-y (bytevector-length bv)))
+ (do ((length-y 0 (+ 1 length-y)))
+ ((>= (+ length-y offset-y) (bytevector-length bv)))
+ (let ((y (bv-slice/read-write bv offset-y length-y)))
+ (assert (slice-independent? x y))
+ (assert (slice-independent? y x))))))))))
+
+(test-assert "overlapping ranges are dependent"
+ (let ((bv #vu8(0 1 2 3 4 5 6 7 8 9)))
+ (do ((offset-x 0 (+ 1 offset-x)))
+ ;; - 1 to make sure 'x' is non-empty
+ ((> offset-x (- (bytevector-length bv) 1)) #true)
+ (do ((length-x 1 (+ 1 length-x)))
+ ((>= length-x (- (bytevector-length bv) offset-x)))
+ (let ((x (bv-slice/read-write bv offset-x length-x)))
+ ;; Choose a start coordinate inside x or left of x
+ (do ((offset-y 0 (+ 1 offset-y)))
+ ((>= offset-y (+ offset-x length-x) -1))
+ ;; Choose a (non-empty) length
+ (do ((length-y (if (< offset-y offset-x)
+ (- offset-x offset-y -1)
+ 1)
+ (+ 1 length-y)))
+ ((>= (+ offset-y length-y) (bytevector-length bv)))
+ (let ((y (bv-slice/read-write bv offset-y length-y)))
+ (assert (not (slice-independent? x y)))
+ (assert (not (slice-independent? y x)))))))))
+ #true))
+
(test-end "bv-slice")
;; ^ TODO: test other procedures
diff --git a/tests/cadet.scm b/tests/cadet.scm
index b509ccf..5a395cc 100644
--- a/tests/cadet.scm
+++ b/tests/cadet.scm
@@ -17,6 +17,11 @@
;; SPDX-License-Identifier: AGPL-3.0-or-later
(define-module (test-distributed-hash-table))
(import (gnu gnunet cadet client)
+ (gnu gnunet utils bv-slice)
+ (gnu gnunet netstruct syntactic)
+ (gnu gnunet crypto struct)
+ (gnu gnunet hashcode struct)
+ (rnrs bytevectors)
(srfi srfi-64)
(tests utils))
@@ -25,4 +30,60 @@
(close-not-connected-no-fallbacks "cadet" connect disconnect!))
(test-assert "(CADET) garbage collectable"
(garbage-collectable "cadet" connect))
+
+(define %peer-identity
+ (bv-slice/read-write (u8-list->bytevector (iota (sizeof /peer-identity
'())))))
+(define %port
+ (bv-slice/read-write
+ (u8-list->bytevector (map (lambda (x) (- 255 x))
+ (iota (sizeof /hashcode:512 '()))))))
+(test-assert "cadet-address?"
+ (and (cadet-address? (make-cadet-address %peer-identity %port))
+ (not (cadet-address? 'foobar))))
+
+(test-equal "cadet-address, deconstruct"
+ '(#true #true)
+ (let ((cadet (make-cadet-address %peer-identity %port)))
+ ;; TODO: extend 'bytevector=?' to accept ranges, then define
+ ;; 'slice=?'.
+ (list (equal? (cadet-address-peer cadet) (slice/read-only %peer-identity))
+ (equal? (cadet-address-port cadet) (slice/read-only %port)))))
+
+(test-error "cadet-address, wrong peer identity size (1)" #f
+ (make-cadet-address (make-slice/read-write 0) %port))
+(test-error "cadet-address, wrong peer identity size (2)" #f
+ (make-cadet-address
+ (make-slice/read-write (- (sizeof /peer-identity '()) 1)) %port))
+(test-error "cadet-address, wrong peer identity size (3)" #f
+ (make-cadet-address
+ (make-slice/read-write (+ (sizeof /peer-identity '()) 1)) %port))
+
+(test-error "cadet-address, wrong port size (1)" #f
+ (make-cadet-address %peer-identity (make-slice/read-write 0)))
+(test-error "cadet-address, wrong port size (2)" #f
+ (make-cadet-address
+ %peer-identity
+ (make-slice/read-write (- (sizeof /hashcode:512 '()) 1))))
+(test-error "cadet-address, wrong port size (3)" #f
+ (make-cadet-address
+ %peer-identity
+ (make-slice/read-write (+ (sizeof /hashcode:512 '()) 1))))
+
+(test-assert "cadet-address, read-only port"
+ (let ((slice (cadet-address-port (make-cadet-address %peer-identity %port))))
+ (and (slice-readable? slice) (not (slice-writable? slice)))))
+(test-assert "cadet-address, read-only peer"
+ (let ((slice (cadet-address-peer (make-cadet-address %peer-identity %port))))
+ (and (slice-readable? slice) (not (slice-writable? slice)))))
+
+(test-assert "cadet-address, independent slices"
+ (let ((struct (make-cadet-address %peer-identity %port)))
+ (and (slice-independent? %peer-identity (cadet-address-peer struct))
+ (slice-independent? %port (cadet-address-port struct)))))
+
+(test-equal "cadet-address, equal?"
+ (make-cadet-address %peer-identity %port)
+ (make-cadet-address (slice-copy/read-only %peer-identity)
+ (slice-copy/read-only %port)))
+
(test-end "CADET")
diff --git a/tests/distributed-hash-table.scm b/tests/distributed-hash-table.scm
index 0d752b6..a961e43 100644
--- a/tests/distributed-hash-table.scm
+++ b/tests/distributed-hash-table.scm
@@ -268,9 +268,6 @@
(define (insertion=? x y)
(equal? (insertion->sexp x) (insertion->sexp y)))
-(define (slice-independent? x y)
- (not (eq? (slice-bv x) (slice-bv y))))
-
(define (query-independent? x y)
(slice-independent? (query-key x) (query-key y)))
--
To stop receiving notification emails like this one, please contact
gnunet@gnunet.org.
- [gnunet-scheme] branch master updated (59ef9f9 -> 079243f),
gnunet <=