From 6d62043459088784a17eb007ce2c465b74d4bff5 Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson2@worcester.edu>
Date: Tue, 12 Nov 2024 11:09:19 -0500
Subject: base64: Make padding characters optional.

---
 chickadee/base64.scm | 33 +++++++++++++++++++++------------
 1 file changed, 21 insertions(+), 12 deletions(-)

diff --git a/chickadee/base64.scm b/chickadee/base64.scm
index 6575785..b15fec6 100644
--- a/chickadee/base64.scm
+++ b/chickadee/base64.scm
@@ -57,15 +57,21 @@
                        alphabet)
     bv))
 
-(define* (base64-decode str #:optional (alphabet base64-alphabet))
+(define* (base64-decode str #:key (alphabet base64-alphabet) (padding? #t))
   "Decode the base64 encoded string @var{str} using @var{alphabet} and
-return a bytevector containing the decoded data."
+return a bytevector containing the decoded data.  If @var{padding?} is
+@code{#t} then trailing padding characters are expected in the input."
   (define decoder (alphabet->decoder alphabet))
+  (define (fail) (error "invalid base64" str))
   (define (decode char)
+    (unless (char? char) (fail))
     (let ((x (bytevector-s8-ref decoder (char->integer char))))
-      (when (eq? x -1)
-        (error "invalid base64 character" char))
+      (when (eq? x -1) (fail))
       x))
+  (define pad?
+    (if padding?
+        (lambda (x) (eq? x #\=))
+        eof-object?))
   (call-with-input-string str
     (lambda (in)
       (call-with-output-bytevector
@@ -77,8 +83,8 @@ return a bytevector containing the decoded data."
                     (c (read-char in))
                     (d (read-char in)))
                (cond
-                ((eq? d #\=)
-                 (if (eq? c #\=)
+                ((pad? d)
+                 (if (pad? c)
                      ;; 2 bytes of padding.
                      (let ((x (logior (ash (decode a) 6) (decode b))))
                        (put-u8 out (ash (logand x #xff0) -4)))
@@ -89,8 +95,7 @@ return a bytevector containing the decoded data."
                        (put-u8 out (ash (logand x #x3fc00) -10))
                        (put-u8 out (ash (logand x #x3fc) -2))))
                  ;; Input should be fully consumed at this point.
-                 (unless (eof-object? (peek-char in))
-                   (error "invalid base64 string" str)))
+                 (unless (eof-object? (peek-char in)) (fail)))
                 (else
                  (let ((x (logior (ash (decode a) 18)
                                   (ash (decode b) 12)
@@ -108,9 +113,11 @@ return a bytevector containing the decoded data."
                        alphabet)
     bv))
 
-(define* (base64-encode bv #:optional (alphabet base64-alphabet))
+(define* (base64-encode bv #:key (alphabet base64-alphabet) (padding? #t))
   "Encode the bytevector @var{bv} as base64 using
-@var{alphabet} and return a string containing the encoded data."
+@var{alphabet} and return a string containing the encoded data.  If
+@var{padding?} is @code{#t} then trailing padding characters are
+included in the output."
   (define encoder (alphabet->encoder alphabet))
   (define len (bytevector-length bv))
   (define groups (quotient len 3))
@@ -133,9 +140,11 @@ return a bytevector containing the decoded data."
               (put-char port (encode (ash (logand x #xfc00) -10)))
               (put-char port (encode (ash (logand x #x03f0) -4)))
               (put-char port (encode (ash (logand x #x000f) 2)))
-              (put-char port #\=)))
+              (when padding?
+                (put-char port #\=))))
            ((eq? padding 2)
             (let ((x (bytevector-u8-ref bv offset)))
               (put-char port (encode (ash (logand x #xfc) -2)))
               (put-char port (encode (ash (logand x #x03) 4)))
-              (put-string port "==")))))))))
+              (when padding?
+                (put-string port "=="))))))))))
-- 
cgit v1.2.3