gnunet-svn
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[gnunet-scheme] branch master updated (8bda28b -> b7a8906)


From: gnunet
Subject: [gnunet-scheme] branch master updated (8bda28b -> b7a8906)
Date: Sun, 16 Jan 2022 18:35:53 +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 8bda28b  bv-slice: Create a condition type for capability mismatches.
     new 3f0fe4d  tests/bv-slice: Fix slice-zero! tests.
     new affb4f0  NEWS: Document new (gnu gnunet utils bv-slice) condition.
     new b7a8906  dht/client: Improve and test <datum> records.

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:
 NEWS                             |   6 +-
 doc/scheme-gnunet.tm             |   6 +-
 gnu/gnunet/dht/client.scm        |  56 ++++++++++++++----
 gnu/gnunet/utils/bv-slice.scm    |  15 ++++-
 tests/bv-slice.scm               |  18 ++++--
 tests/distributed-hash-table.scm | 125 ++++++++++++++++++++++++++++++++++++++-
 6 files changed, 203 insertions(+), 23 deletions(-)

diff --git a/NEWS b/NEWS
index a940072..cf57ae2 100644
--- a/NEWS
+++ b/NEWS
@@ -7,10 +7,12 @@
 
 -*- mode: org; coding: utf-8 -*-
 * Changes since 0.1
-** Bug fixes
+** Bug fixes and other ‘non-user facing’ changes
    - The NSE client now accepts NaN as standard deviation instead of printing 
an error message.
      Sometimes the NSE service sends NaN as standard deviation, see
      <https://bugs.gnunet.org/view.php?id=7021#c18399>.
    - The bytes in a slice are only printed when the slice is readable,
      so unreadability of slices cannot be circumvented with object->string
-     anymore.
\ No newline at end of file
+     anymore.
+   - Bytevector slice manipulating code now raises &missing-capabilities
+     conditions instead of &assertion when appropriate.
\ No newline at end of file
diff --git a/doc/scheme-gnunet.tm b/doc/scheme-gnunet.tm
index bd7573f..6c3619b 100644
--- a/doc/scheme-gnunet.tm
+++ b/doc/scheme-gnunet.tm
@@ -7,7 +7,7 @@
   manual>|<doc-author|<author-data|<author-name|Maxime
   Devos>|<author-email|maximedevos@telenet.be>>>>
 
-  Copyright (C) 2021 GNUnet e.V.
+  Copyright (C) 2021, 2022 GNUnet e.V.
 
   Permission is granted to copy, distribute and/or modify this document under
   the terms of the GNU Free Documentation License, Version 1.3 or any later
@@ -1089,6 +1089,10 @@
     <scm|datum-expiration> return the key, value and expiration time
     respectively. It can be tested if an object is a datum object with the
     predicate <scm|datum?>.
+
+    The length of <var|value> may be at most <scm|%max-datum-value-length>.
+    If this bound is exceeded, an appropriate <scm|&overly-large-datum> and
+    <scm|&who> condition is raised.
   </explain>
 
   <\explain>
diff --git a/gnu/gnunet/dht/client.scm b/gnu/gnunet/dht/client.scm
index 51ed937..dc81244 100644
--- a/gnu/gnunet/dht/client.scm
+++ b/gnu/gnunet/dht/client.scm
@@ -1,5 +1,5 @@
 ;; This file is part of GNUnet
-;; Copyright (C) 2004-2013, 2016, 2021 GNUnet e.V.
+;; Copyright (C) 2004-2013, 2016, 2021, 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
@@ -28,6 +28,10 @@
          bound-replication-level
 
          ;; Non-interactive data structures
+         %max-datum-value-length
+         &overly-large-datum make-overly-large-datum overly-large-datum?
+         overly-large-datum-type overly-large-datum-length
+
          make-datum datum? datum-type datum-key datum-value datum-expiration
          datum->insertion insertion? insertion->datum
          insertion-desired-replication-level
@@ -80,16 +84,20 @@
                read% sizeof set%! select)
          (only (gnu gnunet utils bv-slice)
                slice-length slice/read-only make-slice/read-write slice-copy!
-               slice-slice)
+               slice-slice verify-slice-readable)
          (only (rnrs base)
                and >= = quote * + - define begin ... let*
                quote case else values apply let cond if >
-               <= expt assert integer? lambda for-each
+               <= expt assert exact? integer? lambda for-each
                not expt min max)
          (only (rnrs control)
                unless when)
          (only (rnrs records syntactic)
-               define-record-type))
+               define-record-type)
+         (only (rnrs conditions)
+               &error condition make-who-condition define-condition-type)
+         (only (rnrs exceptions)
+               raise))
   (begin
     ;; The minimal and maximal replication levels the DHT service allows.
     ;; While the service won't reject replication levels outside this range,
@@ -120,7 +128,10 @@ valid replication to the level, to the range the DHT 
service likes."
 
     (define (validate-key key)
       "If @var{key} is, in-fact, a readable /hashcode:512, return it as a
-readable bytevector slice. If not, raise an appropriate exception. "
+readable bytevector slice. If not, raise an appropriate exception.  The 'what'
+in the @code{&missing-capabilities} condition, if any, is the symbol
+@code{key}."
+      (verify-slice-readable 'key key)
       (if (= (slice-length key) (sizeof /hashcode:512 '()))
          (slice/read-only key)
          (error "length of key incorrect")))
@@ -130,6 +141,22 @@ readable bytevector slice. If not, raise an appropriate 
exception. "
 appropriate exception."
       (if (datum? datum) datum (error "not a datum")))
 
+    ;; TODO: more-or-less copied from gnunet_util_lib.h
+    (define %max-message-size 65535)
+
+    (define %max-datum-value-length
+      (- %max-message-size (sizeof /:msg:dht:client:put '())))
+    (assert (<= 0 %max-datum-value-length))
+
+    ;; TODO: maybe check types in 'make-overly-large-datum'.
+    ;; TODO: &error / &serious / &condition?
+    (define-condition-type &overly-large-datum &error
+      make-overly-large-datum
+      overly-large-datum?
+      ;; block type, as an (exact) integer
+      (type   overly-large-datum-type)
+      ;; length of the (overly large) value
+      (length overly-large-datum-length))
     ;; TODO: use the data structures below and test them
 
     ;; An key-value entry in the DHT.
@@ -148,11 +175,20 @@ The keyword argument @var{expiration} is optional, see 
???.
 
 The numeric value of the block type can be retrieved with the accessor
 @code{datum-type}. The accessors @code{datum-key}, @code{datum-value} and
-@code{datum-expiration} return the keyn value and expiration time respectively.
-It can be tested if an object is a datum object with the predicate 
@code{datum?}."
-          (%make (canonical-block-type type)
+@code{datum-expiration} return the key, value and expiration time respectively.
+It can be tested if an object is a datum object with the predicate 
@code{datum?}.
+
+The length of @var{value} may be at most @code{%max-datum-value-length}.
+If this bound is exceeded, an appropriate @code{&overly-large-datum} and
+@code{&who} condition is raised."
+          (define t (canonical-block-type type))
+          (unless (<= (slice-length value) %max-datum-value-length)
+            (raise (condition
+                    (make-who-condition 'make-datum)
+                    (make-overly-large-datum t (slice-length value)))))
+          (%make t
                  (validate-key key)
-                 (slice/read-only value) ; TODO: max size
+                 (slice/read-only value)
                  expiration))))) ; TODO validate expiration
 
     ;; XXX deduplicate
@@ -318,7 +354,7 @@ slices in @var{old} do not impact the new search result."
     (define (canonical-block-type type)
       "Return the numeric value of the block type @var{type}
 (a @code{block-type?} or in-bounds integer)."
-      (cond ((integer? type)
+      (cond ((and (integer? type) (exact? type))
             (unless (and (<= 0 type (- (expt 2 32) 1)))
               (error "block type out of bounds"))
             type)
diff --git a/gnu/gnunet/utils/bv-slice.scm b/gnu/gnunet/utils/bv-slice.scm
index ab6071c..99c0a93 100644
--- a/gnu/gnunet/utils/bv-slice.scm
+++ b/gnu/gnunet/utils/bv-slice.scm
@@ -35,6 +35,8 @@
          slice/read-only
          slice/write-only
          slice/read-write
+         verify-slice-readable
+         verify-slice-writable
          ;; Small operations
          slice-u8-ref
          slice-u16-ref
@@ -225,9 +227,16 @@ If not, raise an appropriate @code{&missing-capabilities}."
       (let ((permitted-cap-bits (slice-capability-bits slice)))
        (raise (make-missing-capabilities what permitted-cap-bits
                                          required-cap-bits)))))
+  (define (make-verify-slice-cap required-cap-bits)
+    (lambda (what slice)
+      "Verify that @var{slice} has the capabilities @var{required-cap-bits}.
+If not, raise an appropriate @code{&missing-capabilities}."
+      (verify-slice-cap what slice required-cap-bits)))
 
   (define slice-readable? (make-slice-cap-p CAP_READ))
   (define slice-writable? (make-slice-cap-p CAP_WRITE))
+  (define verify-slice-readable (make-verify-slice-cap CAP_READ))
+  (define verify-slice-writable (make-verify-slice-cap CAP_WRITE))
 
   (define (make-select-capabilities desired-cap-bits)
     (slice-as-well
@@ -304,7 +313,7 @@ If not, raise an appropriate @code{&missing-capabilities}."
 
   (define (slice-zero! slice)
     "Zero out the writable slice @var{slice}."
-    (verify-slice-cap 'slice slice CAP_WRITE)
+    (verify-slice-writable 'slice slice)
     ;; TODO optimise this and/or optimise guile's compiler
     ;; w.r.t. bytevectors, structs and type inference.
     (let loop ((i 0))
@@ -316,8 +325,8 @@ If not, raise an appropriate @code{&missing-capabilities}."
   (define (slice-copy! from to)
     "Copy the contents of the readable slice @var{from} to
 the writable slice @var{slice}.  The slices may overlap."
-    (verify-slice-cap 'from from CAP_READ)
-    (verify-slice-cap 'to to CAP_WRITE)
+    (verify-slice-readable 'from from)
+    (verify-slice-writable 'to to)
     (assert (= (slice-length from) (slice-length to)))
     (bytevector-copy! (slice-bv from) (slice-offset from)
                      (slice-bv to) (slice-offset to)
diff --git a/tests/bv-slice.scm b/tests/bv-slice.scm
index 9ccf765..4daef84 100644
--- a/tests/bv-slice.scm
+++ b/tests/bv-slice.scm
@@ -97,13 +97,19 @@
     (slice-zero! dest)
     (slice-bv dest)))
 
-(test-error "slice-zero! requires writability"
-  &assertion
-  (slice-zero! (slice/write-only (make-slice/read-write 9))))
+(test-missing-caps
+ "slice-zero! requires writability"
+ 'slice
+ CAP_READ
+ CAP_WRITE
+ (slice-zero! (slice/read-only (make-slice/read-write 9))))
 
-(test-error "even if the length is zero"
-  &assertion
-  (slice-zero! (slice/write-only (make-slice/read-write 0))))
+(test-missing-caps
+ "even if the length is zero"
+ 'slice
+ CAP_READ
+ CAP_WRITE
+ (slice-zero! (slice/read-only (make-slice/read-write 0))))
 
 (define (some-numbers N)
   (map (cut expt 2 <>) (iota N)))
diff --git a/tests/distributed-hash-table.scm b/tests/distributed-hash-table.scm
index 1cb134b..c80abc4 100644
--- a/tests/distributed-hash-table.scm
+++ b/tests/distributed-hash-table.scm
@@ -1,5 +1,5 @@
 ;; This file is part of scheme-GNUnet, a partial Scheme port of GNUnet.
-;; Copyright (C) 2021 GNUnet e.V.
+;; Copyright (C) 2021, 2022 GNUnet e.V.
 ;;
 ;; 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
@@ -17,10 +17,38 @@
 ;; SPDX-License-Identifier: AGPL-3.0-or-later
 (define-module (test-distributed-hash-table))
 (import (gnu gnunet dht client)
+       (gnu gnunet utils bv-slice)
+       (gnu gnunet netstruct syntactic)
+       (gnu gnunet hashcode struct)
+       (gnu gnunet block)
+       (gnu gnunet message protocols)
+       (gnu extractor enum)
+       (rnrs exceptions)
+       (rnrs conditions)
        (rnrs base)
        (srfi srfi-26)
        (srfi srfi-64))
 
+;; Copied from tests/bv-slice.scm.
+(define-syntax-rule (test-missing-caps test-case what permitted required code)
+  (test-equal test-case
+    (list what permitted required)
+    (guard (c ((missing-capabilities? c)
+              (list (missing-capabilities-what c)
+                    (missing-capabilities-permitted c)
+                    (missing-capabilities-required c))))
+      code)))
+
+(define-syntax-rule (test-overly-large-datum test-case who canonical-type
+                                            length)
+  (test-equal test-case
+    (list who canonical-type length)
+    (guard (c ((overly-large-datum? c)
+              (list (overly-large-datum-who c)
+                    (missing-capabilities-permitted c)
+                    (missing-capabilities-required c))))
+      code)))
+
 ;; It's easy to accidentally swap the min and the max,
 ;; or use theoretical bounds instead of effective bounds.
 (test-begin "bound-replication-level")
@@ -73,4 +101,99 @@
 (test-error "way too small" (bound-replication-level (- 
%minimum-replication-level #e1e20)))
 (test-error "non-numeric" (bound-replication-level 'what))
 
+(define* (make-a-datum #:key
+                      (type 0)
+                      (key (make-slice/read-write (sizeof /hashcode:512 '())))
+                      (value (make-slice/read-write 0)))
+  (make-datum type key value))
+(test-assert "datum?"
+  (datum? (make-a-datum)))
+(test-equal "not a datum"
+  '(#false #false #false)
+  (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)
+  (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))))))
+
+(define-syntax-rule (datum-type-test test-case type type/integer)
+  (test-equal test-case
+    type/integer
+    (datum-type (make-a-datum #:type type))))
+
+(datum-key-test "datum-key"
+               (make-slice/read-write (sizeof /hashcode:512 '())))
+(datum-key-test "datum-key, read-only is sufficient"
+               (slice/read-only
+                (make-slice/read-write
+                 (sizeof /hashcode:512 '()))))
+
+(test-missing-caps
+ "datum key must be readable"
+ 'key
+ CAP_WRITE
+ CAP_READ
+ (make-a-datum #:key (slice/write-only (make-slice/read-write
+                                       (sizeof /hashcode:512 '())))))
+
+;; AFAIK a zero length value is allowed, albeit somewhat pointless?
+(datum-value-test "datum-value, length 0" (make-slice/read-write 0))
+(datum-value-test "datum-value, maximal length"
+                 (make-slice/read-write %max-datum-value-length))
+(datum-value-test "datum-value" (make-slice/read-write 900))
+
+(define (test-datum-overly-large test-case type type/integer length)
+  (test-equal test-case
+    (list 'make-datum type/integer length)
+    (guard (c ((overly-large-datum? c)
+              (list (condition-who c)
+                    (overly-large-datum-type c)
+                    (overly-large-datum-length  c))))
+      (make-a-datum #:type type #:value (make-slice/read-write length)))))
+
+(test-datum-overly-large
+ "datum-value, too large (1, numeric type)" 19 19
+ (* 2 %max-datum-value-length))
+
+(test-datum-overly-large
+ "datum-value, too large (2, numeric type)" 19 19
+ (* 2 %max-datum-value-length))
+
+(test-datum-overly-large
+ "datum-value, too large (1, symbolic type)" (symbol-value block-type 
block:revocation) 12
+ (* 2 %max-datum-value-length))
+
+(datum-type-test "datum-key, symbolic type (1)"
+                (symbol-value block-type block:consensus-element) 25)
+(datum-type-test "datum-key, symbolic type (2)"
+                (symbol-value block-type block:dht:hello) 7)
+(datum-type-test "datum-key, known numeric type (1)" 7 7)
+(datum-type-test "datum-key, known numeric type (2)" 8 8)
+(datum-type-test "datum-key, unknown numeric type" 4294967295 4294967295)
+
+(test-error "datum-type, out-of-bounds" (make-a-datum #:type 4294967296))
+(test-error "datum-type, wrong enumeration"
+           (make-a-datum #:type (symbol-value message-type msg:util:dummy)))
+(test-error "datum-type, wrong type (1)" (make-a-datum #:type 'foo))
+;; This detected a bug!
+(test-error "datum-type, wrong type (2)" (make-a-datum #:type 1.0))
+
 (test-end)

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



reply via email to

[Prev in Thread] Current Thread [Next in Thread]