[gnunet-scheme] 95/324: util: Allow splitting and constructing ancillary messages.

[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 4b50b1bd1b7f63d681e55d9c405c6f2a534b2b17
Author: Maxime Devos <maximedevos@telenet.be>
AuthorDate: Sun Mar 21 16:30:26 2021 +0100

    util: Allow splitting and constructing ancillary messages.
    
    Ancillary messages are used among other applications for
    passing file descriptors over Unix sockets and for
    sending/receiving additional information such as the send/receive
    and source/destination address of a packet.
    
    Reference: RFC 3542 - Advanced Socket Application Program Interface
    (API) for IPv6.
    
    * Makefile.am
      (modules): Add gnu/gnunet/util/cmsg.scm.
      (SCM_TESTS): Add tests/cmsg.scm.
    * README.org (Modules): Mention gnu/gnunet/util/cmsg.scm.
    * gnu/gnunet/util/cmsg.scm: New module for constructing and
      dissecting ancillary messages.
    * tests/cmsg.scm: Test the new module.
---
 Makefile.am              |   4 +-
 README.org               |   2 +
 gnu/gnunet/util/cmsg.scm | 309 ++++++++++++++++++++++++++++++++++++
 tests/cmsg.scm           | 406 +++++++++++++++++++++++++++++++++++++++++++++++
 4 files changed, 720 insertions(+), 1 deletion(-)

diff --git a/Makefile.am b/Makefile.am
index 9d236a4..1e20804 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -47,6 +47,7 @@ modules = \
   gnu/gnunet/utils/hat-let.scm \
   gnu/gnunet/utils/netstruct.scm \
   \
+  gnu/gnunet/util/cmsg.scm \
   gnu/gnunet/icmp/struct.scm \
   \
   gnu/gnunet/util/struct.scm \
@@ -93,7 +94,8 @@ SCM_TESTS = \
   tests/message-handler.scm \
   tests/update.scm \
   tests/message-io.scm \
-  tests/bv-slice.scm
+  tests/bv-slice.scm \
+  tests/cmsg.scm
 
 SCM_TESTS_ENVIRONMENT = \
   GUILE_AUTO_COMPILE=0 \
diff --git a/README.org b/README.org
index 2c10948..a615bbc 100644
--- a/README.org
+++ b/README.org
@@ -111,6 +111,8 @@
 ** More refined IP, TCP, UDP, ...
    + gnu/gnunet/icmp/struct.scm: ICM packet types & codes
      (incomplete, to be used for error messages)
+   + gnu/gnunet/util/cmsg.scm: Constructing & analysing
+     ancillary messages (likewise)
 
    TODO: IP_PKTINFO for interface address, scope ...
    TODO: message queue based upon this
diff --git a/gnu/gnunet/util/cmsg.scm b/gnu/gnunet/util/cmsg.scm
new file mode 100644
index 0000000..f56cd45
--- /dev/null
+++ b/gnu/gnunet/util/cmsg.scm
@@ -0,0 +1,309 @@
+;;   This file is part of scheme-GNUnet, a partial Scheme port of GNUnet.
+;;   Copyright (C) 2021 Maxime Devos <maximedevos@telenet.be>
+;;
+;;   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.
+;;
+;;   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: AGPL-3.0-or-later
+
+;; Accessing ancillary data from Scheme.
+
+;; * Analysis: bytes -> ancillary messages
+;;
+;; The basic procedure is @code{split-ancillary},
+;; which analyses the first ancillary message.
+;; Also defined is:
+;;
+;; + count-ancillaries
+;; + control->ancillary-vector
+;; + control->ancillary-list
+;; + ancillary:protocol
+;; + ancillary:type
+;; + ancillary:data
+;;
+;; * Construction: ancillary messages -> bytes
+;;
+;; + control-size: determine the length of the bytevector
+;;   to allocate for use in sendmsg(2).
+;; + write-ancillary->control!: copy an ancillary message to a slice
+;; + write-ancillaries->control!: likewise, for multiple ancillaries
+;; + write-ancillary-vector->control!: likewise with different calling
+;;   convention.
+;; + ancillaries->bytevector: likewise, and make a fresh bytevector for it.
+;; + ancillary-vector->bytevector: likewise, with a different calling
+;;   convention.
+;;
+;; * TODO: basic analysis of sock_extended_err & others
+(define-module (gnu gnunet util cmsg)
+  #:export (;; Data types
+           <ancillary>
+           make-ancillary
+           ancillary?
+           ancillary:protocol
+           ancillary:type
+           ancillary:data
+           ;; Conditions
+           &control-data-too-small
+           make-control-data-too-small
+           control-data-too-small?
+           control-data-too-small:written
+           control-data-too-small:bytes-written
+           ;; bytes --> ancillaries
+           split-ancillary
+           count-ancillaries
+           control->ancillary-vector
+           control->ancillary-list
+           ;; ancillaries --> bytes
+           control-size
+           write-ancillary->control!
+           write-ancillary-vector->control!
+           write-ancillaries->control!
+           ancillary-vector->bytevector
+           ancillaries->bytevector)
+  #:use-module (rnrs records syntactic)
+  #:use-module (rnrs conditions)
+  #:use-module (rnrs bytevectors)
+  #:use-module (rnrs exceptions)
+  #:use-module (bytestructures guile)
+  #:use-module ((rnrs base) #:select (assert))
+  #:use-module (srfi srfi-8)
+  #:use-module (srfi srfi-26)
+  #:use-module (gnu gnunet utils bv-slice))
+
+;; XXX system specific -- but size_t according to POSIX
+(define socklen_t size_t)
+
+(define cmsghdr
+  (bs:struct
+   `((len ,socklen_t) ; length of data + this header
+     (level ,int)
+     (type ,int))))
+
+(define cmsghdr:size (bytestructure-descriptor-size cmsghdr))
+
+;; This is something glibc does
+(define align-len
+  (let ((s (bytestructure-descriptor-size size_t)))
+    (lambda (len)
+      (logand (+ len s -1)
+             (lognot (- s 1))))))
+
+(assert (= cmsghdr:size (align-len cmsghdr:size)))
+
+(define-syntax-rule (case-values exp
+                                case ...)
+  (call-with-values (lambda () exp)
+    (case-lambda case ...)))
+
+(define-record-type (<ancillary> make-ancillary ancillary?)
+  (fields (immutable protocol ancillary:protocol)
+         (immutable type ancillary:type)
+         (immutable data ancillary:data))
+  (sealed #t)
+  (opaque #t)
+  (protocol
+   (lambda (%make)
+     (lambda (protocol type data)
+       "Construct an ancillary message, originating from
+the protocol @var{protocol}, having a protocol-specific type
+@var{type} and data @var{data} (a readable bytevector slice).
+The numeric values of @var{protocol} and @var{type} and
+system-dependent."
+       ;; TODO verify bounds of protocol and type
+       (assert (and (exact-integer? protocol)
+                   (exact-integer? type)
+                   (slice-readable? data)))
+       (%make protocol type data)))))
+
+
+;; Analysis of control data
+
+(define (split-ancillary control-slice)
+  "Split off the first ancillary datum from @var{control-slice},
+returning the protocol, the type, the bytevector slice of the data
+and the rest.  If there are no ancillaries anymore, return nothing
+instead.  If a fancy data type for ancillaries is desired, see
+@code{make-ancillary}.  If the ancillary didn't fit in
+@var{control-slice} (i.e., it was truncated), this is counted as
+‘no ancillaries’."
+  (assert (slice-readable? control-slice))
+  (if (< (slice-length control-slice) cmsghdr:size)
+      (values)
+      (receive (len level type)
+         (let ((bv (slice-bv control-slice))
+               (of (slice-offset control-slice)))
+           (let-syntax ((ref (syntax-rules ()
+                               ((_ field)
+                                (bytestructure-ref* bv of cmsghdr 'field)))))
+             (values (ref len)
+                     (ref level)
+                     (ref type))))
+       ;; according to glibc, the first can happen somehow
+       (if (or (< len cmsghdr:size)
+               (< (slice-length control-slice) len))
+           (values)
+           (let ((aligned-len (align-len len)))
+             (values level type
+                     (slice-slice control-slice cmsghdr:size
+                                  (- len cmsghdr:size))
+                     (slice-slice control-slice
+                                  (min (slice-length control-slice)
+                                       aligned-len))))))))
+
+(define (count-ancillaries control-slice)
+  "Count the number of ancillary messages in @var{control-slice}.
+Ignore the last ancillary if it was truncated."
+  (let loop ((n 0) (control-slice control-slice))
+    (case-values (split-ancillary control-slice)
+                (() n)
+                ((x y z rest)
+                 (loop (+ 1 n) rest)))))
+
+(define (control->ancillary-vector control-slice)
+  "Make a vector of ancillary messages for each
+ancillary message in @var{control-slice} (in the same order).
+Ignore the last ancillary if it was truncated."
+  (let* ((n (count-ancillaries control-slice))
+        (v (make-vector n)))
+    (let loop ((i 0) (control-slice control-slice))
+      (if (< i n)
+         (receive (protocol type data rest)
+             (split-ancillary control-slice)
+           (vector-set! v i (make-ancillary protocol type data))
+           (loop (+ 1 i) rest))
+         v))))
+
+(define (control->ancillary-list control-slice)
+  "Make a list of ancillary messages for each
+ancillary message in @var{control-slice} (in the same order).
+Ignore the last ancillary if it was truncated."
+  (let loop ((control-slice control-slice))
+    (case-values (split-ancillary control-slice)
+                (() '())
+                ((protocol type data rest)
+                 (cons (make-ancillary protocol type data)
+                       (loop rest))))))
+
+
+;; Constructing control data
+(define (control-size . data-sizes)
+  (define control-size-acc
+    (case-lambda
+      ((n) n)
+      ((n data-size . data-sizes)
+       (apply control-size-acc (+ n (align-len (+ cmsghdr:size data-size)))
+             data-sizes))))
+  (apply control-size-acc 0 data-sizes))
+
+(define (write-ancillary->control! control-slice ancillary)
+  "Write the ancillary message @var{ancillary} to the control
+data @var{control-slice} (a writable bytevector slice).
+
+Return the number written/the length of the ancillary message
+on success (that is, there was sufficient space in
+@var{control-slice}), and zero values otherwise."
+  (assert (slice-writable? control-slice))
+  (assert (ancillary? ancillary))
+  (let ((required-space
+        (+ cmsghdr:size
+           (align-len (slice-length (ancillary:data ancillary))))))
+    (if (< (slice-length control-slice) required-space)
+       (values)
+       (let ((bv (slice-bv control-slice))
+             (of (slice-offset control-slice))
+             (length
+              (+ cmsghdr:size (slice-length (ancillary:data ancillary)))))
+         (let-syntax ((set (syntax-rules ()
+                             ((_ field val)
+                              (bytestructure-set!* bv of cmsghdr 'field 
val)))))
+           (set len length)
+           (set level (ancillary:protocol ancillary))
+           (set type (ancillary:type ancillary))
+           (slice-copy! (ancillary:data ancillary)
+                        (slice/write-only
+                         control-slice cmsghdr:size
+                         (slice-length
+                          (ancillary:data ancillary))))
+           (slice-zero!
+            (slice-slice control-slice length (- required-space length))))
+         required-space))))
+
+(define-condition-type &control-data-too-small &error
+  %make-control-data-too-small control-data-too-small?
+  (written control-data-too-small:written) ; ancillaries written
+  ;; total size of ancillaries written, including padding
+  (bytes-written  control-data-too-small:bytes-written))
+
+(define (make-control-data-too-small written bytes-written)
+  (assert (and (exact-integer? written)
+              (exact-integer? bytes-written)
+              (<= 0 written)
+              (<= 0 bytes-written)))
+  (%make-control-data-too-small written bytes-written))
+
+(define (write-ancillary-vector->control! control-slice a)
+  "Write the ancillary messages in the vector @var{a} to the
+control data @var{control-slice} (a writable bytevector slice)
+and return the number of bytes written (including padding).
+
+In case @var{control-slice} is too small, a @code{&control-data-too-small}
+error is raised.
+
+Even if such a condition is raised, this procedure will still
+write as many ancillary messages as fit in @var{control-slice},
+setting the @var{written} field to the number of ancillary
+messages written and @var{bytes-written} to the number of bytes
+these control messages occupy."
+  (define (too-small ancillaries-written bytes-written)
+    (raise (condition
+           (make-control-data-too-small ancillaries-written bytes-written)
+           (make-who-condition 'write-ancillary-vector->control!))))
+  (assert (and (slice-writable? control-slice) (vector? a)))
+  (let loop ((i 0) (bytes-written 0) (control-slice control-slice))
+    (if (< i (vector-length a))
+       (let ((x (vector-ref a i)))
+         (assert (ancillary? x))
+         (case-values (write-ancillary->control! control-slice x)
+                      (() (too-small i bytes-written))
+                      ((n)
+                       (loop (+ i 1) (+ bytes-written n)
+                             (slice-slice control-slice n)))))
+       bytes-written)))
+
+(define (write-ancillaries->control! control-slice . a)
+  (write-ancillary-vector->control! control-slice
+                                   (list->vector a)))
+
+(define (ancillary-vector->bytevector a)
+  "Make a fresh bytevector consisting of the ancillary messages in
+the vector @var{a}."
+  ;; TODO performance: the lucid calculation of the required bytevector
+  ;; size could be done less lucid (reduce allocations, single pass).
+  (let* ((size (apply + (map (compose
+                             (cute + cmsghdr:size <>)
+                             align-len
+                             slice-length
+                             ancillary:data)
+                            (vector->list a))))
+        (bv (make-bytevector size))
+        ;; should not result in &control-data-too-small
+        (written (write-ancillary-vector->control!
+                  (bv-slice/read-write bv)
+                  a)))
+    (assert (= size written))
+    bv))
+
+(define (ancillaries->bytevector . a)
+  "Make a fresh bytevector consisting of the ancillary messages
+@var{a}."
+  (ancillary-vector->bytevector (list->vector a)))
diff --git a/tests/cmsg.scm b/tests/cmsg.scm
new file mode 100644
index 0000000..abddcad
--- /dev/null
+++ b/tests/cmsg.scm
@@ -0,0 +1,406 @@
+;;   This file is part of scheme-GNUnet, a partial Scheme port of GNUnet.
+;;   Copyright (C) 2021 Maxime Devos <maximedevos@telenet.be>
+;;
+;;   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.
+;;
+;;   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: AGPL-3.0-or-later
+
+(import (quickcheck)
+       (quickcheck property)
+       (quickcheck arbitrary)
+       (quickcheck generator)
+       (bytestructures guile)
+       (srfi srfi-1)
+       (srfi srfi-26)
+       (ice-9 binary-ports)
+       (ice-9 control)
+       (ice-9 receive)
+       (rnrs bytevectors)
+       (rnrs conditions)
+       (gnu gnunet util cmsg)
+       (gnu gnunet utils bv-slice))
+
+(define lcov? #f)
+
+(define (slice->bv x)
+  (let ((new (make-bytevector (slice-length x))))
+    (slice-copy! x (bv-slice/read-write new))
+    new))
+
+(define (slice-contents-equal? x y)
+  (bytevector=? (slice->bv x)
+               (slice->bv y)))
+
+(define (a-equal? a b)
+  (let-syntax ((tx (syntax-rules ()
+                    ((_ (eq proj) ...)
+                     (and (eq (proj a) (proj b))
+                          ...)))))
+    (tx (= ancillary:protocol)
+       (= ancillary:type)
+       (slice-contents-equal? ancillary:data))))
+
+(define (al-equal? a b)
+  (every a-equal? a b))
+
+(define (av-equal? a b)
+  (al-equal? (vector->list a) (vector->list b)))
+
+(if lcov?
+    ;; Less tests, so the tests don't take too long to finish.
+    (configure-quickcheck
+     (stop? (lambda (success-count _)
+             (>= success-count 10)))
+     (size (lambda (test-number)
+            (if (zero? test-number) 0
+                (+ 3 (quotient test-number 1))))))
+    ;; Likewise
+    (configure-quickcheck
+     (stop? (lambda (success-count _)
+             (>= success-count 100)))
+     (size (lambda (test-number)
+            (if (zero? test-number) 0 ; <-- I don't know what I'm doing
+                (1+ (quotient test-number 6)))))))
+
+
+;; Generate control data.
+
+(define choose-ancillary-slice-or-bogus
+  (generator-let*
+   ((len (choose-one/weighted
+         ;; overly small
+         `((1 . ,(choose-integer 0 (@@ (gnu gnunet util cmsg)
+                                       cmsghdr:size)))
+           ;; perfectly aligned
+           (1 . ,(generator-lift
+                  (cute * (@@ (gnu gnunet util cmsg) cmsghdr:size) <>)
+                  (choose-integer 0 5)))
+           ;; other
+           (1 . ,(choose-integer (@@ (gnu gnunet util cmsg)
+                                     cmsghdr:size)
+                                 90)))))
+    ;; not very interesting
+    (level choose-byte)
+    (type choose-byte)
+    ;; Apparently len can be shorter
+    ;; than the control message and even shorter than the message header,
+    ;; see comment in glibc.  (Please do not spread this practice.)
+    (padding (choose-one/weighted
+             `((3 . ,(generator-return 0))
+               (1 . ,(choose-integer (- len) 17)))))
+    ;; ! there is no guarantee padding bytes will be zero.
+    (padding-bytes (choose-bytevector (max padding 0))))
+   (let* ((bv (make-bytevector (+ len (max padding 0))))
+         (header (make-bytevector (@@ (gnu gnunet util cmsg)
+                                      cmsghdr:size))))
+     ;; ^ on some architectures, this may already contain some padding
+     ;; zero bytes at the end due to alignment.  These will be overwritten 
later.
+     (let-syntax ((set (syntax-rules ()
+                        ((_ field val)
+                         (bytestructure-set!* header 0
+                                              (@@ (gnu gnunet util cmsg)
+                                                  cmsghdr)
+                                              'field val)))))
+       (set len len)
+       (set level level)
+       (set type type))
+     (bytevector-copy! header 0
+                      bv 0
+                      (min (bytevector-length header)
+                           (bytevector-length bv)))
+     (if (<= 0 padding)
+        (bytevector-copy! padding-bytes 0
+                          bv len
+                          (bytevector-length padding-bytes)))
+     (generator-return (bv-slice/read-write bv 0 (+ len padding))))))
+
+;; Append multiple ancillary message slices into a single
+;; control data
+
+(define choose-control-data-bv
+  (sized-generator
+   (lambda (n-parts)
+     (generator-lift (lambda (parts)
+                      (receive (port get-bv)
+                          (open-bytevector-output-port)
+                        (for-each (lambda (part)
+                                    (put-bytevector port
+                                                    (slice-bv part)
+                                                    (slice-offset part)
+                                                    (slice-length part)))
+                          parts)
+                        (get-bv)))
+                    (choose-list choose-ancillary-slice-or-bogus n-parts)))))
+
+(define choose-control-data
+  (generator-lift (compose slice/read-only bv-slice/read-write)
+                 choose-control-data-bv))
+
+(define $control-data
+  (arbitrary
+   (gen choose-control-data)
+   (xform (lambda _ (throw 'oops)))))
+
+(define choose-slice/read-only
+  (generator-lift (compose slice/read-only bv-slice/read-write)
+                 (sized-generator choose-bytevector)))
+
+(define $ancillary
+  (arbitrary
+   (gen (generator-lift make-ancillary
+                       (choose-integer 0 65535)
+                       (choose-integer 0 65535)
+                       choose-slice/read-only))
+   (xform #f)))
+
+
+;; Tests
+;; Overview:
+;;  * count-ancillaries is a morphism
+;;  * control->ancillary-list & control->ancillary-vector
+;;    only differ in typing
+;;  * FAILS
+;;    control->ancillary-vector after ancillary-vector->bytevector
+;;    is identity (up to freshness, aside from bv -> slice mapping)
+;; * split-ancillary works as expected on a single, whole ancillary
+;; * align-len (private) satisties many nice properties
+;;   (idempotence, some kind of morphism, monotonity,
+;;   an alternative definition ...)
+
+(define (call-with-maximum proc)
+  (let ((n -1))
+    (proc (lambda (x)
+           (set! n (max x n))))
+    n))
+
+(define-syntax-rule (with-maximum increment body body* ...)
+  (call-with-maximum
+   (lambda (increment) body body* ...)))
+
+(define-syntax-rule (false-if-assertion exp exp* ...)
+  (with-exception-handler
+      (lambda (e) #f)
+    (lambda () exp exp* ...)
+    #:unwind? #t
+    #:unwind-for-type &assertion))
+
+(define (t)
+
+  ;; Make sure we generate a few ancillary messages
+  ;; and not just some random bytevectors.
+  ;; (disabled as it is nondeterministic).
+
+  #;
+  (test-assert "test case generator is not horribly broken"
+  (> (with-maximum consider
+  (quickcheck
+  (property ((cd $control-data))
+  (consider (count-ancillaries cd))
+  #t)))
+  2))
+
+  
+  ;; Verify count-ancillaries is a morphism,
+  ;; and control->ancillary-list & control->ancillary-vector and
+  ;; are more or less the same.
+  (test-assert "[prop] count-ancillaries & control->ancillary-list"
+    (quickcheck
+     (property ((cd $control-data))
+       (false-if-assertion
+       (= (count-ancillaries cd)
+          (length (control->ancillary-list cd)))))))
+
+  (test-assert "[prop] count-ancillaries & control->ancillary-vector"
+    (quickcheck
+     (property ((cd $control-data))
+       (false-if-assertion
+       (= (count-ancillaries cd)
+          (vector-length (control->ancillary-vector cd)))))))
+
+  (test-assert "[prop] control->ancillary-list & vector->list"
+    (quickcheck
+     (property ((cd $control-data))
+       (false-if-assertion
+       (al-equal? (control->ancillary-list cd)
+                  (vector->list (control->ancillary-vector cd)))))))
+
+  ;; ancillaries->bytevector & control->ancillary-list
+  (test-assert "[prop] control->ancillary-vector after 
ancillary-vector->bytevector"
+    (quickcheck
+     (property ((acv ($vector $ancillary)))
+       (false-if-assertion
+       (av-equal? acv
+                  (control->ancillary-vector
+                   (slice/read-only
+                    (bv-slice/read-write
+                     (ancillary-vector->bytevector acv)))))))))
+
+  (test-assert "[prop] split-ancillary on whole ancillary"
+    (quickcheck
+     (property ((ac $ancillary))
+       (false-if-assertion
+       (receive (protocol type slice rest)
+            (split-ancillary (bv-slice/read-write
+                             (ancillary-vector->bytevector (vector ac))))
+          (and (= (slice-length rest) 0)
+               (slice-readable? rest)
+               (a-equal? (make-ancillary protocol type slice) ac)))))))
+
+  (define-syntax-rule (case-values exp case ...)
+    (call-with-values (lambda () exp)
+      (case-lambda case ...)))
+
+
+  
+  ;; Verify the alignment function works as expected.
+  (define align-len (@@ (gnu gnunet util cmsg) align-len))
+  (define (aligned? n)
+    (= (align-len n) n))
+
+  (test-assert "0 is aligned" (aligned? 0))
+  (test-assert "size_t is aligned"
+    (aligned? (bytestructure-descriptor-size size_t)))
+  (test-assert "[prop] multiples of aligned data are aligned"
+    (quickcheck
+     (property ((n $natural)
+               (m $natural))
+       (aligned? (* n (align-len m))))))
+  (test-assert "[prop] aligned -> positive"
+    (quickcheck
+     (property ((n $natural))
+       (<= 0 (align-len n)))))
+  (test-assert "[prop] aligning is monotonuous"
+    (quickcheck
+     (property ((n $natural)
+               (delta $natural))
+       (<= (align-len n)
+          (align-len (+ n delta))))))
+  (test-assert "[prop] aligned > unaligned"
+    (quickcheck
+     (property ((n $natural))
+       (<= n (align-len n)))))
+  (test-assert "[prop] align-len is idempotent"
+    (quickcheck
+     (property ((n $natural))
+       (= (align-len (align-len n)) (align-len n)))))
+  (test-assert "[prop] align-len & addition (one part aligned)"
+    (quickcheck
+     (property ((n $natural)
+               (m $natural))
+       (let ((n (align-len n)))
+        (= (align-len (+ n m))
+           (+ n (align-len m)))))))
+  (test-assert "[prop] align-len in terms of modulo, + and min"
+    (let ((s (bytestructure-descriptor-size size_t)))
+      (quickcheck
+       (property ((n $natural))
+        (= (align-len n)
+           (let ((m (modulo n s)))
+             (if (= m 0)
+                 n ; <-- already aligned
+                 (+ s (- n m)))))))))
+
+  
+  ;; control-size is well-behaving
+  (test-assert "[prop] control-size length is aligned"
+    (quickcheck
+     (property ((s ($list $natural)))
+       (aligned? (apply control-size s)))))
+
+  (test-equal "control-size of empty list"
+    0
+    (control-size))
+
+  (test-assert "[prop] control-size is a morphism (append & +)"
+    (quickcheck
+     (property ((n ($list ($list $natural))))
+       (= (apply control-size (apply append n))
+         (apply + (map (lambda (l) (apply control-size l)) n))))))
+
+  ;; control-size is sufficient
+  (test-assert "[prop] length of ancillary->bytevector is control-size"
+    (quickcheck
+     (property ((ac $ancillary))
+       (let* ((bv (ancillary-vector->bytevector (vector ac)))
+             (bv-len (bytevector-length bv)))
+        (= bv-len (control-size (slice-length (ancillary:data ac))))))))
+
+  (test-assert "[prop] data written by write-ancillary->control! is 
control-size"
+    (quickcheck
+     (property ((ac $ancillary))
+       (let ((dest (make-slice/read-write
+                   (control-size (slice-length (ancillary:data ac))))))
+        (case-values
+         (write-ancillary->control! dest ac)
+         (() #f) ; <-- there should be plenty of space
+         ((n) (= n (slice-length dest))))))))
+
+  (test-assert "[prop] ... even if more bytes are writable"
+    (quickcheck
+     (property ((ac $ancillary)
+               (extra $byte))
+       (let ((dest (make-slice/read-write
+                   (control-size (slice-length (ancillary:data ac))
+                                 (floor/ extra 4)))))
+        (case-values
+         (write-ancillary->control! dest ac)
+         (() #f) ; <-- there should be plenty of space (too much, actually)
+         ((n) (= n (control-size (slice-length (ancillary:data ac))))))))))
+
+  
+  ;; control-size is required
+  (test-assert "[prop] write-ancillary->control! fails when too little space 
(incl. unaligned)"
+    (quickcheck
+     (property ((ac $ancillary)
+               (less $byte))
+       (let* ((bv (ancillary-vector->bytevector (vector ac)))
+             (plenty-of-space (bytevector-length bv))
+             (less (floor/ less 16)) ; Otherwise we see ‘Gave up! Passed only 
1 est’.
+             (too-small (slice/write-only
+                         (make-slice/read-write
+                          (max 0 (min (- plenty-of-space 1) less))))))
+        (test-when (< less plenty-of-space)
+                   (case-values
+                    (write-ancillary->control! too-small ac)
+                    (() #t)
+                    ((n) #f)))))))
+
+  (test-assert "[prop] write-ancillary-vector->control! fails when too little 
space is passed"
+    (quickcheck
+     (property ((ac ($vector $ancillary))
+               (less $byte))
+       (let* ((bv (ancillary-vector->bytevector ac))
+             (plenty-of-space (bytevector-length bv))
+             (less (floor/ less 16)) ; Otherwise we see ‘Gave up! Passed only 
1 est’.
+             (too-small (slice/write-only
+                         (make-slice/read-write
+                          (max 0 (min (- plenty-of-space 1) less))))))
+        (test-when (< less plenty-of-space)
+                   (with-exception-handler
+                       (lambda (e) #t)
+                     (lambda ()
+                       (write-ancillary-vector->control! too-small ac)
+                       #f)
+                     #:unwind? #t
+                     #:unwind-for-type &control-data-too-small)))))))
+
+(use-modules (system vm coverage))
+
+(if lcov?
+    (call-with-values (lambda () (with-code-coverage t))
+      (lambda (data)
+       (let ((port (open-output-file "lcov.info")))
+         (coverage-data->lcov data port)
+         (close port))))
+    (t))

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