[gnunet-scheme] 02/08: data-string: Raise exceptions in case of bogus input.

[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 1bd999f1afa084ab253f95e0c5d9edf1dd890124
Author: Maxime Devos <maximedevos@telenet.be>
AuthorDate: Sun Aug 28 22:27:01 2022 +0200

    data-string: Raise exceptions in case of bogus input.
    
    This seems to have accidentally addressed a test failure in
    tests/crypto.scm, maybe fixing a bug? IMO individual exceptions
    types make cleaner backtraces than type errors caused by forgetting
    the #false case.
    
    * gnu/gnunet/config/data-string.scm
    (&bogus-crockford-base32hex): New exception type.
    (raise-bogus-crockford-base32hex): New helper procedure.
    (get-value): Raise exceptions instead of returning #false.
    (string->data): Likwise.
    * gnu/gnunet/config/crypto.scm: Adjust to new API.
    * gnu/gnunet/hashcode-ascii.scm: Adjust to new API.
    * tests/crypto.scm
    ("string->eddsa-public-key, bogus character (invalid)"):
    Expect success.
---
 gnu/gnunet/crypto.scm         | 10 ++++---
 gnu/gnunet/data-string.scm    | 61 +++++++++++++++++++++++++++----------------
 gnu/gnunet/hashcode-ascii.scm |  3 ++-
 tests/crypto.scm              |  1 -
 4 files changed, 47 insertions(+), 28 deletions(-)

diff --git a/gnu/gnunet/crypto.scm b/gnu/gnunet/crypto.scm
index df6af3b..04d5b28 100644
--- a/gnu/gnunet/crypto.scm
+++ b/gnu/gnunet/crypto.scm
@@ -29,7 +29,7 @@
          (only (gnu gnunet crypto struct)
                /eddsa-public-key /ecdsa-public-key)
          (only (gnu gnunet data-string)
-               string->data)
+               string->data bogus-crockford-base32hex?)
          (only (gnu gnunet netstruct syntactic)
                sizeof)
          (only (gnu gnunet utils hat-let)
@@ -45,7 +45,7 @@
          (only (rnrs conditions)
                define-condition-type &violation)
          (only (rnrs exceptions)
-               raise))
+               raise guard))
   (begin
     ;; TODO: Extend bytevector-hash with offset + length.
     (define (hash-slice/bytevector algorithm slice)
@@ -99,8 +99,10 @@ fresh readable bytevector slice with the hash."
             (! key-length/characters (ceiling-quotient key-length/bits 5))
             (? (not (= key-length/characters (string-length string)))
                (raise-invalid-public-key-encoding)))
-           (or (string->data string key-length/bytes)
-               (raise-invalid-public-key-encoding))))
+           (guard (c ((bogus-crockford-base32hex? c)
+                      ;; TODO: maybe add c to &irritants
+                      (raise-invalid-public-key-encoding)))
+                  (string->data string key-length/bytes))))
 
     ;; TODO: find some test cases
     (define (string->eddsa-public-key string)
diff --git a/gnu/gnunet/data-string.scm b/gnu/gnunet/data-string.scm
index 8464d3d..df32ff5 100644
--- a/gnu/gnunet/data-string.scm
+++ b/gnu/gnunet/data-string.scm
@@ -23,11 +23,18 @@
 ;;     (The alternative encodings aren't generated by GNUnet anyway)
 ;;     TODO: perhaps reject alternate encodings (e.g. "00" and "01" both
 ;;     decode to 0 currently)
+;;
+;; Mini-changelog:
+;;   * (2 0): Instead of returning #false, raise an exception, in string->data.
 
-(library (gnu gnunet data-string (1 1))
-  (export data->string string->data)
+(library (gnu gnunet data-string (2 0))
+  (export data->string string->data
+         &bogus-crockford-base32hex
+         make-bogus-crockford-base32hex bogus-crockford-base32hex?)
   (import (rnrs base)
           (rnrs control)
+          (rnrs conditions)
+          (rnrs exceptions)
          (rnrs bytevectors)
          (rnrs arithmetic bitwise))
 
@@ -66,9 +73,19 @@ of the C implementation.
              (begin (assert (= 0 vbit))
                     (apply string (reverse accumulated))))))))
 
+  ;; TODO: appropriate supertype
+  ;; TODO: fields!
+  ;; TODO: &who
+  (define-condition-type &bogus-crockford-base32hex &condition
+    make-bogus-crockford-base32hex bogus-crockford-base32hex?)
+
+  (define (raise-bogus-crockford-base32hex)
+    (raise (make-bogus-crockford-base32hex)))
+
   (define (get-value ch)
     "Get the decoded value corresponding to a character according to Crockford
-Base32 encoding."
+Base32 encoding.  If @var{ch} does not correspond to anything, raise a
+@code{&bogus-crockford-base32hex} instead."
     (cond ((and (char<=? #\0 ch) (char<=? ch #\9))
           (- (char->integer ch) (char->integer #\0)))
          ((and (char<=? #\A ch) (char<=? ch #\H))
@@ -81,7 +98,7 @@ Base32 encoding."
           (- (char->integer ch) (char->integer #\P) -22))
          ((and (char<=? #\V ch) (char<=? ch #\Z))
           (- (char->integer ch) (char->integer #\V) -27))
-         (else #f)))
+         (else (raise-bogus-crockford-base32hex))))
 
   (define string->data
     (lambda (enc out-size)
@@ -90,8 +107,8 @@ Base32 encoding."
 This corresponds with the @code{GNUNET_STRINGS_string_to_data} function
 of the C implementation.
 
-Return the data as a bytevector on success, or return #f
-if result has the wrong encoding.
+Return the data as a bytevector on success, or raise a
+@code{&bogus-crockford-base32hex} if result has the wrong encoding.
 @var{out-size} must exactly match the size of the data before it was encoded.
 
 @var{enc} the encoding
@@ -106,7 +123,7 @@ if result has the wrong encoding.
        (if (= 0 (string-length enc))
            (if (= 0 out-size)
                #vu8()
-               #f)
+               (raise-bogus-crockford-base32hex))
            (begin
              (if (< 0 (mod encoded-len 5))
                  (begin ; padding!
@@ -123,9 +140,9 @@ if result has the wrong encoding.
                    (set! bits ret)))
              (cond ((not (= (/ (+ encoded-len shift) 5)
                             (string-length enc)))
-                    #f)
+                    (raise-bogus-crockford-base32hex))
                    ((not ret)
-                    #f)
+                    (raise-bogus-crockford-base32hex))
                    (else
                     (let loop ((wpos out-size))
                       (if (> wpos 0)
@@ -137,18 +154,18 @@ if result has the wrong encoding.
                                         (bitwise-arithmetic-shift-left
                                          ret vbit)
                                         bits))
-                            (and ret
-                                 (begin
-                                   (set! vbit (+ vbit 5))
-                                   (when (>= vbit 8)
-                                     (set! wpos (- wpos 1))
-                                     (bytevector-u8-set! uout wpos
-                                                         (bitwise-and bits
-                                                                      255))
-                                     (set! bits
-                                       (bitwise-arithmetic-shift-right bits 8))
-                                     (set! vbit (- vbit 8)))
-                                   (loop wpos))))
+                            (unless ret
+                              (raise-bogus-crockford-base32hex))
+                            (set! vbit (+ vbit 5))
+                            (when (>= vbit 8)
+                              (set! wpos (- wpos 1))
+                              (bytevector-u8-set! uout wpos
+                                                  (bitwise-and bits
+                                                               255))
+                              (set! bits
+                                    (bitwise-arithmetic-shift-right bits 8))
+                              (set! vbit (- vbit 8)))
+                            (loop wpos))
                           (if (and (= 0 rpos) (= 0 vbit))
                               uout
-                              #f)))))))))))
+                              (raise-bogus-crockford-base32hex))))))))))))
diff --git a/gnu/gnunet/hashcode-ascii.scm b/gnu/gnunet/hashcode-ascii.scm
index ca5c125..4ad98fb 100644
--- a/gnu/gnunet/hashcode-ascii.scm
+++ b/gnu/gnunet/hashcode-ascii.scm
@@ -48,5 +48,6 @@ characters.
 
 @var{ascii} the encoding
 Return @lisp{#f} in case of an encoding error."
-    (let ((bv (string->data ascii hashcode-u8-length)))
+    (let ((bv (guard (c ((bogus-crockford-base32hex? c) #false))
+                    (string->data ascii hashcode-u8-length))))
       (and bv (bv->hashcode bv)))))
diff --git a/tests/crypto.scm b/tests/crypto.scm
index 26d6b5b..b355532 100644
--- a/tests/crypto.scm
+++ b/tests/crypto.scm
@@ -101,7 +101,6 @@
                    (string->eddsa-public-key "")
                    #false))
 
-(test-expect-fail 1) ; TODO
 (test-assert "string->eddsa-public-key, bogus character (invalid)"
             (guard (c ((invalid-public-key-encoding? c) #true))
                    (string->eddsa-public-key 
"@7SWVEMER2PPF11VTD737PQA2QAWVXA967EB6YFBHR5Z2J7AJ7E0")

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