commit 81a6480a4fdcbfd7a9da57a7b55e6a69c7779015
parent c7164a6f4a971a55ab3dd8aaf1c5c6904c681316
Author: Daniel Barlow <dan@telent.net>
Date: Tue, 27 Aug 2024 22:42:03 +0100
anoia add base64 deode
Diffstat:
2 files changed, 95 insertions(+), 24 deletions(-)
diff --git a/pkgs/anoia/Makefile b/pkgs/anoia/Makefile
@@ -2,8 +2,11 @@ servicedir:=$(shell mktemp -d)
default: fs.lua init.lua nl.lua svc.lua net/constants.lua
+CHECK=fs.fnl init.fnl svc.fnl
+
check:
ln -s . anoia
+ fennel ./run-tests.fnl $(CHECK)
fennel test.fnl
fennel test-svc.fnl $(servicedir)
test -f $(servicedir)/fish
diff --git a/pkgs/anoia/init.fnl b/pkgs/anoia/init.fnl
@@ -1,3 +1,9 @@
+;; importing assert.fnl macros here would be circular, so we can't use
+;; the full test functionality
+(macro define-tests [& body]
+ (when _G.RUNNING_TESTS
+ `(do ,(unpack body))))
+
(fn assoc [tbl k v & more]
(tset tbl k v)
(case more
@@ -52,7 +58,7 @@
;; there are no keys in b which are not also in a
(and present (. a k))))))
-(comment
+(define-tests
(assert (table= {:a 1 :b 2} {:b 2 :a 1}))
(assert (not (table= {:a 1 :b 2 :k :l} {:b 2 :a 1})))
(assert (not (table= {:a 1 :b 2} {:b 2 :a 1 :k :l})))
@@ -68,32 +74,32 @@
[el] (. tree el)
[] tree))
-(local
- base64-indices
- (doto [
- "B" "C" "D" "E" "F" "G" "H" "I" "J" "K" "L" "M" "N" "O" "P"
- "Q" "R" "S" "T" "U" "V" "W" "X" "Y" "Z" "a" "b" "c" "d" "e" "f"
- "g" "h" "i" "j" "k" "l" "m" "n" "o" "p" "q" "r" "s" "t" "u" "v"
- "w" "x" "y" "z" "0" "1" "2" "3" "4" "5" "6" "7" "8" "9" "-" "_"
- ]
- (tset 0 "A")))
-
-;; local function base64(s)
-;; local byte, rep = string.byte, string.rep
-;; local pad = 2 - ((#s-1) % 3)
-;; s = (s..rep('\0', pad)):gsub("...", function(cs)
-;; local a, b, c = byte(cs, 1, 3)
-;; return bs[a>>2] .. bs[(a&3)<<4|b>>4] .. bs[(b&15)<<2|c>>6] .. bs[c&63]
-;; end)
-;; return s:sub(1, #s-pad) .. rep('=', pad)
-;; end
-
(fn %% [fmt ...] (string.format fmt ...))
-(fn base64url [s]
- "URL-safe Base64-encoded form of s (no trailing padding)"
+(local
+ base64-indices
+ (let [base [
+ "B" "C" "D" "E" "F" "G" "H" "I" "J" "K" "L" "M" "N" "O" "P"
+ "Q" "R" "S" "T" "U" "V" "W" "X" "Y" "Z" "a" "b" "c" "d" "e" "f"
+ "g" "h" "i" "j" "k" "l" "m" "n" "o" "p" "q" "r" "s" "t" "u" "v"
+ "w" "x" "y" "z" "0" "1" "2" "3" "4" "5" "6" "7" "8" "9"
+ ]]
+ {
+ :url
+ (merge (dup base)
+ { 0 "A"
+ 62 "-"
+ 63 "_" })
+ :standard
+ (merge (dup base)
+ { 0 "A"
+ 62 "+"
+ 63 "/" })
+ }))
+
+
+(fn base64-encode [s bs]
(let [pad (- 2 (% (- (# s) 1) 3))
- bs base64-indices
blank (string.rep "\0" pad)
s (-> (.. s blank)
(: :gsub
@@ -106,9 +112,71 @@
(. bs (band c 63)))))))]
(s:sub 1 (- (# s) pad))))
+(fn base64-decode [input rindices]
+ ;; take groups of 4 characters, reverse-look them up in base64-indices,
+ ;; convert to 24 bit number,
+ ;; convert to three characters
+ (let [padding (if (= (string.sub input -2 -1) "==") -3
+ (= (string.sub input -1 -1) "=") -2
+ -1)
+ input (string.sub (.. input "===") 1 (* (/ (# input) 4) 4))]
+ (->
+ (icollect [s (string.gmatch input "(....)")]
+ (let [(a b c d) (string.byte s 1 4)
+ ri (fn [x] (assert (. rindices x) (.. "invalid " x)))
+ n (bor (ri d)
+ (lshift (ri c) 6)
+ (lshift (ri b) 12)
+ (lshift (ri a) 18))]
+
+
+ (string.pack "bbb"
+ (rshift (band 0xff0000 n) 16)
+ (rshift (band 0x00ff00 n) 8)
+ (band 0x0000ff n))))
+ (table.concat "")
+ (string.sub 1 padding)
+ )))
+
+(fn base64 [alphabet-des]
+ (let [alphabet (or (. base64-indices alphabet-des) alphabet-des (. base64-indices :standard) )
+ ralphabet (doto
+ (collect [k v (pairs alphabet)]
+ (values (string.byte v) k))
+ (tset (string.byte "=") 0))]
+ {
+ :encode (fn [_ str] (base64-encode str alphabet))
+ :decode (fn [_ str] (base64-decode str ralphabet))
+ }))
+
+(fn base64url [str] (: (base64 :url) :encode str))
+
+
+
+(define-tests
+ (let [{: view} (require :fennel)
+ b64 (base64 :url)]
+
+ (let [a (b64:decode "YWxsIHlvdXIgYmFzZQ==")]
+ (assert (= a "all your base") (view a)))
+ (let [a (b64:decode "ZmVubmVsIHRoaW5n")]
+ (assert (= a "fennel thing") a))
+ (let [a (b64:decode "TWFueSBoYW5kcyBtYWtlIGxpZ2h0IHdvcms=")]
+ (assert (= a "Many hands make light work") (view a)))
+ (let [a (b64:encode "hello world")]
+ (assert (= a "aGVsbG8gd29ybGQ") a))))
+
+
+ ;; doesn't work if the padding is missing
+ ;; (let [a (from-base64 "TWFueSBoYW5kcyBtYWtlIGxpZ2h0IHdvcms")]
+ ;; (assert (= a "Many hands make light work") (view a)))
+; ))
+
+
{
: assoc
+ : base64
: base64url
: basename
: dig
