init.fnl (8426B)
1 (import-macros { : define-tests : expect : expect= } :anoia.assert) 2 3 (fn assoc [tbl k v & more] 4 (tset tbl k v) 5 (case more 6 [k v] (assoc tbl k v) 7 _ tbl)) 8 9 (fn merge [table1 table2] 10 (collect [k v (pairs table2) &into table1] 11 k v)) 12 13 (fn dup [table] 14 (collect [k v (pairs table)] k v)) 15 16 (fn split [sep string] 17 (icollect [v (string.gmatch string (.. "([^" sep "]+)"))] 18 v)) 19 20 (fn file-exists? [name] 21 (match (io.open name :r) 22 f (do (f:close) true) 23 _ false)) 24 25 (fn basename [path] 26 (string.match path ".*/([^/]-)$")) 27 28 29 (fn dirname [path] 30 (let [stripped (string.match path "(.-)/*$")] 31 (pick-values 32 1 33 (if (not path) "." 34 (= path "") "." 35 (not stripped) "." 36 (= stripped "") "/" 37 (string.match stripped ".+/.-") (stripped:gsub "(.*)(/.*)" "%1") 38 (string.match stripped "/") "/" 39 ".")))) 40 41 (define-tests 42 ;; these are examples from dirname(3) 43 (expect= (dirname "/usr/lib") "/usr") 44 (expect= (dirname "/usr/") "/") 45 (expect= (dirname "usr") ".") 46 (expect= (dirname "/") "/") 47 (expect= (dirname ".") ".") 48 (expect= (dirname "..") ".")) 49 50 (fn append-path [dirname filename] 51 (let [base (or (string.match dirname "(.*)/$") dirname) 52 result []] 53 (each [component (string.gmatch filename "([^/]+)")] 54 (if (and (= component "..") (> (# result) 0)) 55 (table.remove result) 56 (= component "..") 57 (error "path traversal attempt") 58 true 59 (table.insert result component))) 60 (.. base "/" (table.concat result "/")))) 61 62 (fn system [s] 63 (match (os.execute s) 64 res (do (print (.. "Executed \"" s "\", exit code " (tostring res))) res) 65 (nil err) (error (.. "Error executing \"" s "\" (" err ")")))) 66 67 (fn hash [str] 68 (accumulate [h 5381 69 c (str:gmatch ".")] 70 (+ (* h 33) (string.byte c)))) 71 72 (fn table= [a b] 73 (if (= a b) 74 true 75 (and (= (type a) :table) (= (type b) :table) 76 (accumulate [equal true 77 k v1 (pairs a) 78 &until (not equal)] 79 ;; all keys in a have the same value in a and b 80 (and equal 81 (let [v2 (. b k)] (and v2 (table= v1 v2))))) 82 (accumulate [present true 83 k _ (pairs b) 84 &until (not present)] 85 ;; there are no keys in b which are not also in a 86 (and present (. a k)))))) 87 88 (define-tests 89 (expect (table= {:a 1 :b 2} {:b 2 :a 1})) 90 (expect (not (table= {:a 1 :b 2 :k :l} {:b 2 :a 1}))) 91 (expect (not (table= {:a 1 :b 2} {:b 2 :a 1 :k :l}))) 92 93 (expect (table= {:a 1 :b {:l 17}} {:b {:l 17} :a 1})) 94 (expect (table= {:a [4 5 6 7] } {:a [4 5 6 7]})) 95 (expect (not (table= {:a [4 5 6 7] } {:a [4 5 6 7 8]}))) 96 (expect (not (table= {:a [4 5 7 6] } {:a [4 5 6 7 ]}))) 97 98 (expect (table= {} {})) 99 100 (let [traps (fn [b p] 101 (match (pcall append-path b p) 102 (true f) (error "didn't trap path traversal") 103 (false err) (expect (string.match err "path traversal"))))] 104 (expect= (append-path "/tmp" "hello") "/tmp/hello") 105 (expect= (append-path "/tmp/" "hello") "/tmp/hello") 106 (expect= (append-path "/tmp/" "///hello") "/tmp/hello") 107 (expect= (append-path "/tmp/" "///hello/../fish") "/tmp/fish") 108 (traps "/tmp/" "../hello") 109 (expect= (append-path "/tmp/" "hello/../goodbye") "/tmp/goodbye") 110 (traps "/tmp/" "hello/../../goodbye")) 111 ) 112 113 (fn dig [tree path] 114 (match path 115 [el & more] (dig (. tree el) more) 116 [el] (. tree el) 117 [] tree)) 118 119 (fn %% [fmt ...] (string.format fmt ...)) 120 121 (local 122 base64-indices 123 (let [base [ 124 "B" "C" "D" "E" "F" "G" "H" "I" "J" "K" "L" "M" "N" "O" "P" 125 "Q" "R" "S" "T" "U" "V" "W" "X" "Y" "Z" "a" "b" "c" "d" "e" "f" 126 "g" "h" "i" "j" "k" "l" "m" "n" "o" "p" "q" "r" "s" "t" "u" "v" 127 "w" "x" "y" "z" "0" "1" "2" "3" "4" "5" "6" "7" "8" "9" 128 ]] 129 { 130 :url 131 (merge (dup base) 132 { 0 "A" 133 62 "-" 134 63 "_" }) 135 :standard 136 (merge (dup base) 137 { 0 "A" 138 62 "+" 139 63 "/" }) 140 })) 141 142 143 (fn base64-encode [s bs] 144 (let [pad (- 2 (% (- (# s) 1) 3)) 145 blank (string.rep "\0" pad) 146 s (-> (.. s blank) 147 (: :gsub 148 "..." 149 (fn [cs] 150 (let [(a b c) (string.byte cs 1 3)] 151 (.. (. bs (rshift a 2)) 152 (. bs (bor (lshift (band a 3) 4) (rshift b 4))) 153 (. bs (bor (lshift (band b 15) 2) (rshift c 6))) 154 (. bs (band c 63)))))))] 155 (.. (s:sub 1 (- (# s) pad)) 156 (string.rep "=" pad)))) 157 158 159 (fn base64-decode [input rindices] 160 ;; take groups of 4 characters, reverse-look them up in base64-indices, 161 ;; convert to 24 bit number, 162 ;; convert to three characters 163 164 ;; things that might happen at the end of the string: 165 ;; 1) if the input string length was n * 3, it will have been 166 ;; encoded as n * 4 base64 digits, no special handling required 167 ;; 2) if the input string length was (n * 3) + 2, the last 16 bits 168 ;; are encoded into 3 base64 digits which are followed by an '=' 169 ;; 3) if the input string length was (n * 3) + 1, the last 8 bits 170 ;; are encoded into 2 base64 digits which are followed by '==' 171 ;; 0) there is never an '===' padding, because an 8 bit byte 172 ;; can never be encoded into a single 6 bit base64 digit 173 174 (let [input (.. input (string.rep "=" (% (- 4 (# input)) 4))) 175 pad-chars (# (or (string.match input "(=+)$") "")) 176 trim-index (case pad-chars 177 0 -1 178 1 -2 179 2 -3 180 3 (assert nil "3 pad bytes??"))] 181 (-> 182 (icollect [s (string.gmatch input "(....)")] 183 (let [(a b c d) (string.byte s 1 4) 184 ri (fn [x] (assert (. rindices x) (.. "invalid " x))) 185 n (bor (ri d) 186 (lshift (ri c) 6) 187 (lshift (ri b) 12) 188 (lshift (ri a) 18))] 189 (string.pack "bbb" 190 (rshift (band 0xff0000 n) 16) 191 (rshift (band 0x00ff00 n) 8) 192 (band 0x0000ff n)))) 193 (table.concat "") 194 (string.sub 1 trim-index) 195 ))) 196 197 (fn base64 [alphabet-des] 198 (let [alphabet (or (. base64-indices alphabet-des) alphabet-des (. base64-indices :standard) ) 199 ralphabet (doto 200 (collect [k v (pairs alphabet)] 201 (values (string.byte v) k)) 202 (tset (string.byte "=") 0))] 203 { 204 :encode (fn [_ str] (base64-encode str alphabet)) 205 :decode (fn [_ str] (base64-decode str ralphabet)) 206 })) 207 208 (fn base64url [str] 209 ;; for backward-compatibility, this does not pad the encoded string 210 (let [encoded (: (base64 :url) :encode str)] 211 (pick-values 1 (string.gsub encoded "=+$" "")))) 212 213 214 (define-tests 215 (let [{: view} (require :fennel) 216 b64 (base64 :url)] 217 218 (let [a (b64:decode "YWxsIHlvdXIgYmFzZQ==")] 219 (expect= a "all your base")) 220 (let [a (b64:decode "ZmVubmVsIHRoaW5n")] 221 (expect= a "fennel thing")) 222 (let [a (b64:decode "TWFueSBoYW5kcyBtYWtlIGxpZ2h0IHdvcms=")] 223 (expect= a "Many hands make light work")) 224 (let [a (b64:encode "hello world")] 225 (expect= a "aGVsbG8gd29ybGQ=")) 226 227 (fn check [plain enc] 228 (let [a (b64:encode plain)] (expect (= a enc) (.. "encode " a))) 229 (let [a (b64:decode enc)] (expect (= a plain) (.. "decode " a)))) 230 231 (check "" "") 232 (check "f" "Zg==") 233 (check "fo" "Zm8=") 234 (check "foo" "Zm9v") 235 (check "foob" "Zm9vYg==") 236 (check "fooba" "Zm9vYmE=") 237 (check "foobar" "Zm9vYmFy") 238 239 (let [x (b64:decode "REtOdUtNS05BNEJWLXdfcUhtNU9YV2liOUxkX3RTdVJTQWVUR0dkWldBdVEyaURObDZ2b3pSbEJwMzlzOEltdkhWdmpzZmMiLCJ5IjoiQVlDY1QwOGZrNFZWZ2lZSVIxbkU4UlJGaGZOSGdBUEFzckRITmJtRGNfUGtWZmdDR0xTMTIweU5SNncwdjd5RUY4WDN1OGpvazhkU0pqN0hnWjZCZHAzcSJ9LCJraWQiOiJlalVDaXBCUE9BeDRWQ1dQdUtkVGlYNDNadW5XTDNjSWN6V1h1RVZyTVNFIn0")] 240 (expect (string.match x "}$") x)) 241 242 )) 243 244 ;; doesn't work if the padding is missing 245 ;; (let [a (from-base64 "TWFueSBoYW5kcyBtYWtlIGxpZ2h0IHdvcms")] 246 ;; (assert (= a "Many hands make light work") (view a))) 247 ; )) 248 249 250 251 { 252 : append-path 253 : assoc 254 : base64 255 : base64url 256 : basename 257 : dig 258 : dirname 259 : dup 260 : file-exists? 261 : hash 262 : merge 263 : split 264 : system 265 : table= 266 : %% 267 }