Merge pull request #10 from cgay/dev

Modernize to match RFC 4648

Author: cgay

base64.dylan

@@ -1,112 +1,144 @@
 Module:    base64
-Synopsis:  Base64 encoding/decoding
-Author:    Carl Gay
+Synopsis:  Base64 encoding/decoding as defined in RFC 4648
 License:   This code is in the public domain
 Warranty:  Distributed WITHOUT WARRANTY OF ANY KIND
 
 
-// This file implements the Base64 transfer encoding algorithm as
-// defined in RFC 1521 by Borensten & Freed, September 1993.
-//
-// Original version written in Common Lisp by Juri Pakaste <[email protected]>.
-// Converted to Dylan by Carl Gay, July 2002.
+// TODO:
+//   * support line breaks
+//   * streaming / chunking a la CL's qbase64
 
-define constant $standard-encoding-vector :: <byte-string>
-  = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/=";
 
-define constant $http-encoding-vector :: <byte-string>
-  = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789$!@";
+define constant $standard-scheme = #"_base64";
+define constant $url-scheme      = #"_base64url";
+define constant <scheme>         = one-of($standard-scheme, $url-scheme);
 
-// ---TODO: line breaks?
-//define constant $base64-line-break :: <byte-string> = "\n";
+define constant $pad-char :: <character> = '=';
 
-// I thought FunDev had <integer-vector> built in, but apparently not.
-//
-define constant <int-vector> = limited(<vector>, of: <integer>);
+// Base 64 Encoding
+// https://datatracker.ietf.org/doc/html/rfc4648#section-4
+define constant $standard-encoding :: <byte-string>
+  = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/";
+
+// Base 64 Encoding with URL and Filename Safe Alphabet
+// https://datatracker.ietf.org/doc/html/rfc4648#section-5
+define constant $url-encoding :: <byte-string>
+  = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-_";
+
+define constant $standard-decoding :: <byte-vector>
+  = make-decoding-vector($standard-encoding);
+
+define constant $url-decoding :: <byte-vector>
+  = make-decoding-vector($url-encoding);
 
 define function make-decoding-vector
-    (encoding-vector) => (v :: <int-vector>)
-  let v = make(<int-vector>, size: 256, fill: -1);
-  for (index from 0 below v.size,
+    (encoding-vector :: <byte-string>) => (v :: <byte-vector>)
+  let v = make(<byte-vector>, size: 128);
+  for (i from 0,
        char in encoding-vector)
-    v[as(<integer>, char)] := index;
+    let code = as(<integer>, char);
+    v[code] := i;
   end;
   v
-end;
+end function;
 
-define constant $standard-decoding-vector :: <int-vector>
-  = make-decoding-vector($standard-encoding-vector);
+define inline function encoded-length
+    (input-length :: <integer>, pad? :: <boolean>)
+ => (encoded-length :: <integer>)
+  if (pad?)
+    // Four chars for every group of 3 bytes including the final group.
+    ceiling/(input-length, 3) * 4
+  else
+    // One char for every 6 bits in the total bits.
+    ceiling/(input-length * 8, 6)
+  end
+end function;
 
-define constant $http-decoding-vector :: <int-vector>
-  = make-decoding-vector($http-encoding-vector);
+define inline function decoded-length
+    (input :: <byte-string>) => (decoded-length :: <integer>)
+  let len = input.size;
+  // Discard at most two trailing pad chars from the length.
+  if (len - 2 >= 2 & input[len - 2] == $pad-char)
+    len := len - 2;
+  elseif (len - 1 >= 3 & input[len - 1] == $pad-char)
+    len := len - 1
+  end;
+  floor/(len * 6, 8)
+end function;
 
+// Encode `bytes` into base 64 in a <byte-string> using the character set specified by
+// `scheme`. If `pad?` is true the returned string will be a multiple of 4 characters in
+// length, padded with 0 to 2 '=' characters.
 define function base64-encode
-    (string :: <byte-string>, #key encoding :: <symbol> = #"standard")
- => (s :: <byte-string>)
+    (bytes :: <sequence>,
+     #key scheme :: <scheme> = $standard-scheme, pad? :: <boolean> = #t)
+ => (string :: <byte-string>)
   let encoding-vector :: <byte-string>
-    = select (encoding)
-        #"standard" => $standard-encoding-vector;
-        #"http"     => $http-encoding-vector;
-      end;
-  let result = make(<byte-string>, size: 4 * floor/(2 + string.size, 3));
-  for (sidx from 0 by 3,
-       didx from 0 by 4,
-       while: sidx < string.size)
-    let chars = 2;
-    let value = ash(logand(#xFF, as(<integer>, string[sidx])), 8);
-    for (n from 1 to 2)
-      when (sidx + n < string.size)
-        let char-code :: <integer> = as(<integer>, string[sidx + n]);
-        value := logior(value, logand(#xFF, char-code));
-        chars := chars + 1;
-      end;
-      when (n = 1)
-        value := ash(value, 8);
+    = select (scheme)
+        $standard-scheme => $standard-encoding;
+        $url-scheme      => $url-encoding;
       end;
+  let convert = if (instance?(bytes, <string>))
+                  curry(as, <integer>)
+                else
+                  identity
+                end;
+  let nbytes :: <integer> = bytes.size;
+  let nchars :: <integer> = encoded-length(nbytes, pad?);
+  let result = make(<byte-string>, size: nchars);
+  let bi :: <integer> = 0;      // bytes index
+  let ri :: <integer> = 0;      // result index
+  while (bi < nbytes)
+    let b1 :: <byte> = convert(bytes[bi]);
+    let b2 :: <byte> = if (bi + 1 < nbytes) convert(bytes[bi + 1]) else 0 end;
+    let b3 :: <byte> = if (bi + 2 < nbytes) convert(bytes[bi + 2]) else 0 end;
+    let n :: <integer> = ash(b1, 16) + ash(b2, 8) + b3;
+    for (shift from -18 to 0 by 6,
+         while: ri < nchars)    // can happen for pad?: #f
+      let index = logand(ash(n, shift), #b111111);
+      result[ri] := encoding-vector[index];
+      ri := ri + 1;
+    end;
+    bi := bi + 3;
+  end while;
+  if (pad?)
+    let len :: <integer> = encoded-length(nbytes, #f);
+    for (i from len below nchars)
+      result[i] := $pad-char;
     end;
-    result[didx + 3] := encoding-vector[if (chars > 3) logand(value, #x3F) else 64 end];
-    value := ash(value, -6);
-    result[didx + 2] := encoding-vector[if (chars > 2) logand(value, #x3F) else 64 end];
-    value := ash(value, -6);
-    result[didx + 1] := encoding-vector[logand(value, #x3F)];
-    value := ash(value, -6);
-    result[didx + 0] := encoding-vector[logand(value, #x3F)];
   end;
   result
-end;
-    
+end function;
+
 define function base64-decode
-    (string :: <byte-string>, #key encoding :: <symbol> = #"standard")
- => (s :: <byte-string>)
-  let result = make(<byte-string>, size: 3 * floor/(string.size, 4));
-  let ridx :: <integer> = 0;
-  block (exit-block)
-    let decoding-vector :: <int-vector>
-      = select (encoding)
-          #"standard" => $standard-decoding-vector;
-          #"http"     => $http-decoding-vector;
-        end;
-    let bitstore :: <integer> = 0;
-    let bitcount :: <integer> = 0;
-    for (char :: <byte-character> in string)
-      let value = decoding-vector[as(<integer>, char)];
-      unless (value == -1 | value == 64)
-        bitstore := logior(ash(bitstore, 6), value);
-        bitcount := bitcount + 6;
-        when (bitcount >= 8)
-          bitcount := bitcount - 8;
-          let code = logand(ash(bitstore, 0 - bitcount), #xFF);
-          if (zero?(code))
-            exit-block();
-          else
-            result[ridx] := as(<byte-character>, code);
-            ridx := ridx + 1;
-            bitstore := logand(bitstore, #xFF);
-          end;
-        end;
+    (string :: <byte-string>, #key scheme :: <scheme> = $standard-scheme)
+ => (bytes :: <byte-vector>)
+  let decoding-vector :: <byte-vector>
+    = select (scheme)
+        $standard-scheme => $standard-decoding;
+        $url-scheme      => $url-decoding;
       end;
+  let nchars :: <integer> = string.size;
+  let nbytes :: <integer> = decoded-length(string);
+  let bytes = make(<byte-vector>, size: nbytes);
+  let bi :: <integer> = 0;
+  let si :: <integer> = 0;
+  while (si < nchars)
+    let c1 = as(<integer>, string[si]);                si := si + 1;
+    let c2 = si < nchars & as(<integer>, string[si]);  si := si + 1;
+    let c3 = si < nchars & as(<integer>, string[si]);  si := si + 1;
+    let c4 = si < nchars & as(<integer>, string[si]);  si := si + 1;
+    let d1 :: <byte> =         decoding-vector[c1];
+    let d2 :: <byte> = if (c2) decoding-vector[c2] else 0 end;
+    let d3 :: <byte> = if (c3) decoding-vector[c3] else 0 end;
+    let d4 :: <byte> = if (c4) decoding-vector[c4] else 0 end;
+    let n :: <integer> = ash(d1, 18) + ash(d2, 12) + ash(d3, 6) + d4;
+    for (shift from -16 to 0 by 8,
+         while: bi < nbytes)
+      bytes[bi] := logand(ash(n, shift), #xff);
+      bi := bi + 1;
     end;
-  end block;
-  copy-sequence(result, start: 0, end: ridx)
-end;
+  end while;
+  bytes
+end function;
 

documentation/source/author.rst

@@ -1,21 +1,102 @@
+******
 Base64
-======
+******
+
+.. current-library:: base64
+.. current-module:: base64
+
+This library implements the Base64 encoding algorithm as defined in `RFC 4648
+<https://datatracker.ietf.org/doc/html/rfc4648>`_.
 
 .. toctree::
    :maxdepth: 3
    :hidden:
 
-   usage
-   reference
-   author
+Usage
+=====
+
+Add ``"base64"`` to the dependencies listed in your project's "dylan-package.json" file
+and run ``deft update`` to install the base64 package and update your workspace
+registry.  Add ``use base64;`` to your library and module definitions.
+
+The ``base64`` library exports two functions:
+
+-  :func:`base64-encode`
+-  :func:`base64-decode`
+
+Both of these function accept a ``scheme:`` keyword argument of type :type:`<scheme>`
+which may be one of the following constants:
+
+- :const:`$standard-scheme` - the standard base64 character set including ``+`` and
+   ``/``.
+- :const:`$url-scheme` - a character set safe for use in URLs and filenames, in which
+  ``+`` is replaced by ``-`` and ``/`` is replaced by ``_``.
+
+.. note:: There is currently no support for line breaks or whitespace in the
+          input/output, nor for base64 streams. Pull requests welcome.
+
+
+The base64 Module
+=================
+
+.. type:: <scheme>
+
+   Equivalent to ``one-of($standard-scheme, $url-scheme)``.
+
+.. constant:: $standard-scheme
+
+   An instance of :type:`<scheme>` indicating to use the `standard base64 encoding
+   character set <https://datatracker.ietf.org/doc/html/rfc4648#section-4>`_.
+
+.. constant:: $url-scheme
+
+   An instance of :type:`<scheme>` indicating to use the `URL and filename safe base64
+   character set <https://datatracker.ietf.org/doc/html/rfc4648#section-5>`_.
+
+.. function:: base64-encode
+
+   Encode a byte sequence as a base 64 byte string as defined by `RFC 4648
+   <https://datatracker.ietf.org/doc/html/rfc4648>`_.
+
+   :signature: base64-encode (bytes, #key scheme, pad?) => (byte-string)
+   :parameter bytes: An instance of :drm:`<sequence>`.  An error is signaled if the
+      elements of this sequence are not either integers in the range 0 - 255 or byte
+      characters.
+   :parameter #key scheme: An instance of :type:`<scheme>`.  May be either
+      :const:`$standard-scheme` (the default) or :const:`$url-scheme`.
+   :parameter #key pad?: An instance of :drm:`<boolean>`. If true (the default) the
+      returned byte string is padded with "=" to a multiple of 4 characters in
+      length.  This results in 0, 1, or 2 "=" characters at the end of the string.
+   :value string: An instance of :drm:`<byte-string>`.
+
+   :example:
+
+      .. code-block:: dylan
+
+        base64-encode("foo") => "Zm9v"
+        base64-encode(#(251, 252, 253, 254, 255)) => "+/z9/v8="
+        base64-encode(#(251, 252, 253, 254, 255), scheme: $url-scheme) => "-_z9_v8="
+
+.. function:: base64-decode
+
+   Decode a base 64 encoded string into a byte sequence as defined by `RFC 4648
+   <https://datatracker.ietf.org/doc/html/rfc4648>`_.
+
+   :signature: base64-decode (string, #key scheme) => (bytes)
+   :parameter string: An instance of :drm:`<byte-string>`.
+   :parameter #key scheme: An instance of :type:`<scheme>`.  May be either
+      :const:`$standard-scheme` (the default) or :const:`$url-scheme`.
+   :value bytes: An instance of :class:`<byte-vector>`.
+   :example:
+
+   :description:
 
-Base64 implementation for Dylan
+      Padding characters ("=") at the end of the input string are automatically detected
+      and ignored.
 
-This library implements the Base64 transfer encoding algorithm as
-defined in `RFC 1521 <https://datatracker.ietf.org/doc/html/rfc1521>`__
-by Borensten & Freed, September 1993.
+   :example:
 
-Indices and tables
-------------------
+      .. code-block:: dylan
 
-* :ref:`genindex`
+        base64-decode("Zm8=") => {<simple-byte-vector>: 102, 111}
+        base64-decode("Zm8") => {<simple-byte-vector>: 102, 111}