[gnunet-scheme] 152/324: utils: tokeniser: Implement 'add-from-port!'.

[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 487512e032f74f0ec4d6be21e190158c1bb09e8a
Author: Maxime Devos <maximedevos@telenet.be>
AuthorDate: Sat Jul 3 22:49:01 2021 +0200

    utils: tokeniser: Implement 'add-from-port!'.
    
    This will be used in the generic message queue implementation.
    
    * gnu/gnunet/utils/tokeniser.scm
      (add-from-port!): New procedure.
    * tests/tokeniser.scm
      (no-return/done-eof, no-return/premature-eof): New procedures for
      tests.
      ("eof detected", "eof detected (complete data)")
      ("premature eof detected")
      ("add-from-port! and partial messages (split at header)")
      ("kaput tokeniser and add-from-port!"): New tests for new procedure.
---
 gnu/gnunet/utils/tokeniser.scm | 49 ++++++++++++++++++++++++--
 tests/tokeniser.scm            | 78 ++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 125 insertions(+), 2 deletions(-)

diff --git a/gnu/gnunet/utils/tokeniser.scm b/gnu/gnunet/utils/tokeniser.scm
index ff4b4ef..64ac723 100644
--- a/gnu/gnunet/utils/tokeniser.scm
+++ b/gnu/gnunet/utils/tokeniser.scm
@@ -45,7 +45,8 @@
          make-kaput-tokeniser-error
          kaput-tokeniser-error?
 
-         add-bytevector!)
+         add-bytevector!
+         add-from-port!)
   (import (only (rnrs base)
                define and < assert begin quote lambda
                >= integer? exact? <= expt = cond
@@ -63,6 +64,8 @@
                define-record-type)
          (only (srfi srfi-26) cut)
          (only (guile) lambda*)
+         (only (ice-9 binary-ports) get-bytevector-some!)
+         (only (ice-9 ports) eof-object?)
          (only (gnu gnunet util struct)
                /:message-header)
          (only (gnu gnunet netstruct syntactic)
@@ -282,4 +285,46 @@ at least size @var{minimal-size}.  Avoid allocations."
            ;; The buffer will be restored at the call to
            ;; 'return/done' or 'return/overly-small'.
            (set-buffer! #f)
-           (continue buffer position bv offset length)))))
+           (continue buffer position bv offset length)))
+
+    (define (add-from-port! tok port handle/message return/overly-small
+                           return/done-eof return/premature-eof)
+      "Keep reading data from the input port @var{port}, feeding them
+to the tokeniser @var{tok}.
+
+The procedures @var{handle/message}, and @var{return/overly-small} are used
+as in @code{add-bytevector!}.  When the end of file has been reached, and
+@var{tok} doesn't hold a partial message, the thunk @var{return/done-eof}
+is called in tail position.  When the end of file has been reached, and
+@var{tok} does still hold a partial message, the thunk
+@var{return/premature-eof} is instead called in tail position.
+
+As with @ode{add-bytevector!}, @code{&kaput-tokeniser-error} and
+@code{&interrupted-tokeniser-violation} can be raised.
+
+This is a blocking operation!."
+      ;; Cheaty, but it works!  I'd presume Guile or glibc have an
+      ;; optimisation for copying a memory region to itself.  Also,
+      ;; this saves a buffer allocation.
+      (let^ ((! buffer (tokeniser-buffer tok))
+            (! position (tokeniser-position tok))
+            (? (eq? buffer #t)
+               (raise (condition
+                       (make-who-condition 'add-from-port!)
+                       (make-kaput-tokeniser-error))))
+            (? (eq? buffer #f)
+               (raise (condition
+                       (make-who-condition 'add-from-port!)
+                       (make-interrupted-tokeniser-violation))))
+            (! length (- (bytevector-length buffer) position))
+            (! n/read (get-bytevector-some! port buffer position length))
+            (? (eof-object? n/read)
+               ;; If 'position' is 0, then there was no incomplete
+               ;; message in the tokeniser.
+               ((if (= position 0) return/done-eof return/premature-eof)))
+            (! (return/add-bytevector!-done)
+               (add-from-port! tok port handle/message return/overly-small
+                               return/done-eof return/premature-eof)))
+           (add-bytevector! tok buffer position n/read handle/message
+                            return/add-bytevector!-done
+                            return/overly-small)))))
diff --git a/tests/tokeniser.scm b/tests/tokeniser.scm
index c26d272..a18a85d 100644
--- a/tests/tokeniser.scm
+++ b/tests/tokeniser.scm
@@ -33,6 +33,8 @@
        (only (rnrs exceptions) guard)
        (only (rnrs conditions)
              assertion-violation? condition-who)
+       (only (rnrs io ports)
+             open-bytevector-input-port)
        (rnrs bytevectors)
         (gnu gnunet netstruct syntactic)
        (gnu gnunet util struct))
@@ -58,6 +60,12 @@
 (define (no-return/done . _)
   (error "unexpected call to return/done"))
 
+(define (no-return/done-eof . _)
+  (error "unexpected call to return/done-eof"))
+
+(define (no-return/premature-eof . _)
+  (error "unexpected call to return/premature-eof"))
+
 (define (no-handle/message . _)
   (error "unexpected call to handle/message"))
 
@@ -468,4 +476,74 @@
                        no-return/overly-small)
        (error "unreachable")))))
 
+(test-equal "eof detected"
+  '(#t)
+  (receive result
+      (calls-in-tail-position?
+       (lambda (return/done-eof)
+        (add-from-port! (make-tokeniser) (%make-void-port "r")
+                        no-handle/message no-return/overly-small
+                        return/done-eof no-return/premature-eof)))
+    result))
+
+(test-equal "eof detected (complete data)"
+  '(#t)
+  (receive result
+      (calls-in-tail-position?
+       (lambda (return/done-eof)
+        (define handled? #f)
+        (define (handle/message bv offset length)
+          (assert (= length 4))
+          ;; Verify the received message is correct
+          (assert (= (bytevector-u32-ref bv offset (endianness big))
+                     (bytevector-u32-ref #vu8(0 4 0 0) 0 (endianness big))))
+          (assert (not handled?))
+          (set! handled? #t))
+        (add-from-port! (make-tokeniser)
+                        (open-bytevector-input-port #vu8(0 4 0 0))
+                        handle/message no-return/overly-small return/done-eof
+                        no-return/done-eof)))
+    result))
+
+(test-equal "premature eof detected"
+  '(#t)
+  (receive result
+      (calls-in-tail-position?
+       (lambda (return/premature-eof)
+        ;; 4 bytes are expected, but only the stream only has 3.
+        (add-from-port! (make-tokeniser) (open-bytevector-input-port #vu8(0 4 
0))
+                        no-handle/message no-return/overly-small 
no-return/done-eof
+                        return/premature-eof)))
+    result))
+
+(test-equal "add-from-port! and partial messages (split at header)"
+  #vu8(0 8 2 3 4 5 6 7)
+  (let ((tok (make-tokeniser))
+       (message #f))
+    (add-bytevector! tok #vu8(0 8 2 3) 0 4 no-handle/message
+                    (const #t) no-return/overly-small)
+    (add-from-port! tok (open-bytevector-input-port #vu8(4 5 6 7))
+                   (lambda (bv offset length)
+                     (assert (not message))
+                     (let ((bv2 (make-bytevector length)))
+                       (bytevector-copy! bv offset bv2 0 length)
+                       (set! message bv2)))
+                   no-return/overly-small (lambda () message)
+                   no-return/premature-eof)))
+
+(test-equal "kaput tokeniser and add-from-port!"
+  '(add-from-port! . kaput)
+  (let ((tok (make-tokeniser))
+       (bv #vu8(0 3 4 5)))
+    ;; Make the tokeniser kaput (overly small message size)
+    (add-bytevector! tok bv 0 4 no-handle/message no-return/done
+                    (const #t))
+    ;; And feed it some bytes (with add-from-port!) anyway.
+    (catch-errors
+     (lambda ()
+       (add-from-port! tok (open-bytevector-input-port #vu8(1 2 3 4))
+                      no-handle/message no-return/overly-small
+                      no-return/done-eof no-return/premature-eof)
+       (error "unreachable")))))
+
 (test-end "tokeniser")

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