[gnunet-scheme] branch master updated (46488d3 -> 88c05a7)

[gnunet]

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 46488d3  doc/scheme-gnunet: Remove obsolete warning.
     new 2819b57  dht/client: Make 'get-path' and 'put-path' read-only (bugfix).
     new c98d346  tests/distributed-hash-table: Test 'search-result'.
     new 479a6e8  dht/client: (search-result) Raise more precise conditions.
     new 88c05a7  dht/struct: Define /dht:path-element.

The 4 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/dht/client.scm        | 10 ++++-
 gnu/gnunet/dht/struct.scm        | 22 ++++++++++-
 tests/distributed-hash-table.scm | 84 +++++++++++++++++++++++++++++++---------
 3 files changed, 95 insertions(+), 21 deletions(-)

diff --git a/gnu/gnunet/dht/client.scm b/gnu/gnunet/dht/client.scm
index 7a0669a..5925c86 100644
--- a/gnu/gnunet/dht/client.scm
+++ b/gnu/gnunet/dht/client.scm
@@ -256,7 +256,15 @@ an object is a search result with the predicate 
@code{search-result?}. The
 optional keyword arguments @code{get-path} and @code{put-path} are currently
 undocumented and untested."
           ;; TODO: get-path and put-path
-          (%make (validate-datum datum) get-path put-path)))))
+          (%make (validate-datum datum)
+                 (and get-path
+                      (begin
+                        (verify-slice-readable 'get-path get-path)
+                        (slice/read-only get-path)))
+                 (and put-path
+                      (begin
+                        (verify-slice-readable 'put-path put-path)
+                        (slice/read-only put-path))))))))
 
     (define (copy-search-result old)
       "Make a copy of the search result @var{old}, such that modifications to 
the
diff --git a/gnu/gnunet/dht/struct.scm b/gnu/gnunet/dht/struct.scm
index b2e8688..644d4dd 100644
--- a/gnu/gnunet/dht/struct.scm
+++ b/gnu/gnunet/dht/struct.scm
@@ -1,5 +1,5 @@
 ;; This file is part of GNUnet.
-;; Copyright (C) 2001, 2002, 2003, 2004, 2009, 2011 GNUnet e.V.
+;; Copyright (C) 2001-2013, 2022 GNUnet e.V.
 ;;
 ;; 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,6 +18,7 @@
 
 (define-library (gnu gnunet dht struct)
   (export %DHT_BLOOM_SIZE
+         /dht:path-element
          /:msg:dht:client:get:stop
          /:msg:dht:client:get
          /:msg:dht:client:get-result-known
@@ -34,6 +35,8 @@
                /:message-header /time-absolute)
          (only (gnu gnunet hashcode struct)
                /hashcode:512)
+         (only (gnu gnunet crypto struct)
+               /peer-identity /eddsa-signature)
          (only (gnu gnunet netstruct syntactic)
                define-type structure/packed)
          (only (gnu gnunet netstruct procedural)
@@ -42,6 +45,23 @@
     ;; Size of the bloom filter the DT uses to filter peers.
     (define %DHT_BLOOM_SIZE 128)
 
+    ;; GNUNET_DHT_PathElement in C GNUnet
+    (define-type /dht:path-element
+      (structure/packed
+       ;; TODO: path vs. path element?
+       (synopsis "A (signed) path tracking a block's flow through the DHT is
+represented by an array of path elements, each consisting of a peer on the path
+and a signature by which the peer affirms its routing decision.")
+       (field (previous /peer-identity)
+             (synopsis "The previous peer on the path.
+
+The public key used to create the signature is in the
+@emph{next} path element, or the sender of the message if this was the last
+path element.")) ;; C GNUnet says somethin about a non-existent ‘succ’ field?
+       (field (signature /eddsa-signature)
+             (synopsis "Signature affirming the hop, of type
+@code{GNUNET_SIGNATURE_PURPOSE_DHT_HOP}."))))
+
     (define-type /:msg:dht:client:get:stop
       (structure/packed
        (synopsis "Message indicating the DHT should cancel outstanding requests
diff --git a/tests/distributed-hash-table.scm b/tests/distributed-hash-table.scm
index 6bf808c..c588c82 100644
--- a/tests/distributed-hash-table.scm
+++ b/tests/distributed-hash-table.scm
@@ -115,27 +115,28 @@
   (map datum? (list #false 'symbol (make-slice/read-write 0))))
 
 ;; For efficiency reasons, make sure the storage is reused.
-(define-syntax-rule (datum-key-test test-case k)
-  (test-assert test-case
-    (let* ((key k) ; only evaluate once, because eq? will be required
-          (datum (make-a-datum #:key key))
-          (new-key (datum-key datum)))
-      (and (datum? datum)
-          (slice-readable? new-key)
-          (not (slice-writable? new-key))
-          (eq? (slice-bv key) (slice-bv new-key))
-          (= (slice-length key) (slice-length new-key))))))
-(define-syntax-rule (datum-value-test test-case v)
+;;
+;; This verifies constructing a record and extracting a field from the record
+;; end ups with the value passed to the constructor, as a readable bytevector
+;; slice -- the writability of the original slice, if any, is removed.
+(define (slice-property-test test-case generate-slice stuff? slice->stuff 
stuff-slice)
   (test-assert test-case
-    (let* ((value v) ; only evaluate once, because eq? will be required
-          (datum (make-a-datum #:value value))
-          (new-value (datum-value datum)))
-      (and (datum? datum)
-          (slice-readable? new-value)
-          (not (slice-writable? new-value))
-          (eq? (slice-bv value) (slice-bv new-value))
-          (= (slice-length value) (slice-length new-value))))))
+    ;; only evaluate once, because eq? will be required
+    (let* ((slice (generate-slice))
+          (stuff (slice->stuff slice))
+          (new-slice (stuff-slice stuff)))
+      (and (stuff? stuff)
+          (slice-readable? new-slice)
+          (not (slice-writable? new-slice))
+          (eq? (slice-bv slice) (slice-bv new-slice))
+          (= (slice-length slice) (slice-length new-slice))))))
 
+(define-syntax-rule (datum-key-test test-case k)
+  (slice-property-test test-case (lambda () k) datum?
+                      (lambda (s) (make-a-datum #:key s)) datum-key))
+(define-syntax-rule (datum-value-test test-case v)
+  (slice-property-test test-case (lambda () v) datum?
+                      (lambda (s) (make-a-datum #:value s)) datum-value))
 (define-syntax-rule (datum-type-test test-case type type/integer)
   (test-equal test-case
     type/integer
@@ -265,4 +266,49 @@
       (and (search-result=? old new)
           (search-result-independent? old new)))))
 
+(define-syntax-rule (search-result-get-path-slice-test test-case k)
+  (slice-property-test test-case (lambda () k) search-result?
+                      (lambda (s) (datum->search-result (make-a-datum)
+                                                        #:get-path s))
+                      search-result-get-path))
+(define-syntax-rule (search-result-put-path-slice-test test-case k)
+  (slice-property-test test-case (lambda () k) search-result?
+                      (lambda (s) (datum->search-result (make-a-datum)
+                                                        #:put-path s))
+                      search-result-put-path))
+
+;; These detected a bug: the capabilities were not restricted!
+;; TODO: length
+;; TODO: can there be a get path without a put path?
+(search-result-get-path-slice-test "search-result-get-path, slice"
+                                  (make-slice/read-write 7))
+(search-result-get-path-slice-test "search-result-get-path, empty"
+                                  (make-slice/read-write 0))
+(search-result-put-path-slice-test "search-result-put-path, slice"
+                                  (make-slice/read-write 7))
+(search-result-put-path-slice-test "search-result-put-path, empty"
+                                  (make-slice/read-write 0))
+(test-equal "search-result-get-path, none"
+  (list #false) ; TODO: drop 'list' when SRFI-64 bug is fixed
+  (list (search-result-get-path (datum->search-result (make-a-datum)))))
+(test-equal "search-result-put-path, none"
+  (list #false) ; TODO: drop 'list' when SRFI-64 bug is fixed
+  (list (search-result-put-path (datum->search-result (make-a-datum)))))
+
+(test-missing-caps
+ "search-result get-path must be readable"
+ 'get-path
+ CAP_WRITE
+ CAP_READ
+ (datum->search-result
+  (make-a-datum) #:get-path (slice/write-only (make-slice/read-write 7))))
+
+(test-missing-caps
+ "search-result get-path must be readable"
+ 'put-path
+ CAP_WRITE
+ CAP_READ
+ (datum->search-result
+  (make-a-datum) #:put-path (slice/write-only (make-slice/read-write 7))))
+
 (test-end)

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