1#lang racket/base 2(require racket/fixnum) 3 4;; Unsafe mode can be worth a factor of 2 to 4 5;; on byte-string encoding/decoding: 6(#%declare #:unsafe) 7 8(provide base64-encode-stream 9 base64-decode-stream 10 base64-encode 11 base64-decode) 12 13(define ranges '([#"AZ" 0] [#"az" 26] [#"09" 52] [#"++" 62] [#"//" 63])) 14 15(define-values (base64-digit digit-base64) 16 (let ([bd (make-vector 256 #f)] [db (make-vector 64 #f)]) 17 (for ([r ranges] #:when #t 18 [i (in-range (bytes-ref (car r) 0) (add1 (bytes-ref (car r) 1)))] 19 [n (in-naturals (cadr r))]) 20 (vector-set! bd i n) 21 (vector-set! db n i)) 22 (values (vector->immutable-vector bd) (vector->immutable-vector db)))) 23 24(define (base64-decode-stream in out) 25 (unless (input-port? in) (raise-argument-error 'base64-decode-stream "input-port?" in)) 26 (unless (output-port? out) (raise-argument-error 'base64-decode-stream "output-port?" out)) 27 (let loop ([data 0] [bits 0]) 28 (cond 29 [(bits . fx>= . 8) 30 (let ([bits (fx- bits 8)]) 31 (write-byte (fxrshift data bits) out) 32 (loop (fxand data (fx- (fxlshift 1 bits) 1)) bits))] 33 [else 34 (define c (read-byte in)) 35 (unless (or (eof-object? c) (fx= c (char->integer #\=))) 36 (let ([v (vector*-ref base64-digit c)]) 37 (if v 38 (loop (fx+ (fxlshift data 6) v) (fx+ bits 6)) 39 (loop data bits))))]))) 40 41(define (base64-encode-stream in out [linesep #"\n"]) 42 (unless (input-port? in) (raise-argument-error 'base64-encode-stream "input-port?" in)) 43 (unless (output-port? out) (raise-argument-error 'base64-encode-stream "output-port?" out)) 44 ;; Each set of three input bytes turns into four output bytes. 45 ;; It might be nice to actually write the bytes as a 4-byte string, 46 ;; but this way preserves fine-grained streaming. 47 (define (o! c) (write-byte (vector*-ref digit-base64 c) out)) 48 (define (fill!) (write-byte (char->integer #\=) out)) 49 (define (line!) (display linesep out)) 50 (let loop ([width 0]) 51 (define b1 (read-byte in)) 52 (cond 53 [(eof-object? b1) 54 (unless (eqv? width 0) 55 (line!))] 56 [else 57 (o! (fxrshift b1 2)) 58 (define b2 (read-byte in)) 59 (cond 60 [(eof-object? b2) 61 (o! (fxlshift (fxand b1 #b11) 4)) 62 (fill!) 63 (fill!) 64 (line!)] 65 [else 66 (o! (fxior (fxlshift (fxand b1 #b11) 4) 67 (fxrshift b2 4))) 68 (define b3 (read-byte in)) 69 (cond 70 [(eof-object? b3) 71 (o! (fxlshift (fxand b2 #b1111) 2)) 72 (fill!) 73 (line!)] 74 [else 75 (o! (fxior (fxlshift (fxand b2 #b1111) 2) 76 (fxrshift b3 6))) 77 (o! (fxand b3 #b111111)) 78 (let ([width (if (eqv? width 68) 79 (begin 80 (display linesep out) 81 0) 82 (fx+ width 4))]) 83 (loop width))])])]))) 84 85;; ---------------------------------------- 86 87(define (base64-decode src) 88 (unless (bytes? src) (raise-argument-error 'base64-decode "bytes?" src)) 89 ;; Loop through bytes to handle non-encoding characters and stop at `=` 90 (define-values (src-len in-len) 91 (let loop ([i 0] [len 0]) 92 (cond 93 [(fx= i (bytes-length src)) (values i len)] 94 [else 95 (define c (bytes-ref src i)) 96 (cond 97 [(fx= c (char->integer #\=)) (values i len)] 98 [(vector*-ref base64-digit c) (loop (fx+ i 1) (fx+ len 1))] 99 [else (loop (fx+ i 1) len)])]))) 100 (define out-len (fx+ (fx* (fxrshift in-len 2) 3) 101 (fxmax 0 (fx- (fxand in-len 3) 1)))) 102 (define out (make-bytes out-len)) 103 (let loop1 ([i 0] [j 0]) 104 (unless (fx= i src-len) 105 (define c1 (bytes-ref src i)) 106 (let ([v1 (vector*-ref base64-digit c1)] 107 [i (fx+ i 1)]) 108 (cond 109 [(not v1) (loop1 i j)] 110 [else 111 (let loop2 ([i i] [j j]) 112 (unless (fx= i src-len) 113 (define c2 (bytes-ref src i)) 114 (let ([v2 (vector*-ref base64-digit c2)] 115 [i (fx+ i 1)]) 116 (cond 117 [(not v2) (loop2 i j)] 118 [else 119 (bytes-set! out j (fxior (fxlshift v1 2) 120 (fxrshift v2 4))) 121 (let loop3 ([i i] [j (fx+ j 1)]) 122 (unless (fx= i src-len) 123 (define c3 (bytes-ref src i)) 124 (let ([v3 (vector*-ref base64-digit c3)] 125 [i (fx+ i 1)]) 126 (cond 127 [(not v3) (loop3 i j)] 128 [else 129 (bytes-set! out j (fxior (fxlshift (fxand v2 #b1111) 4) 130 (fxrshift v3 2))) 131 (let loop4 ([i i] [j (fx+ j 1)]) 132 (unless (fx= i src-len) 133 (define c4 (bytes-ref src i)) 134 (let ([v4 (vector*-ref base64-digit c4)] 135 [i (fx+ i 1)]) 136 (cond 137 [(not v4) (loop4 i j)] 138 [else 139 (bytes-set! out j (fxior (fxlshift (fxand v3 #b11) 6) 140 v4)) 141 (loop1 i (fx+ j 1))]))))]))))]))))])))) 142 out) 143 144(define (base64-encode src [linesep #"\r\n"]) 145 (unless (bytes? src) (raise-argument-error 'base64-encode "bytes?" src)) 146 (cond 147 [(and (bytes? src) (bytes? linesep)) 148 (define in-len (bytes-length src)) 149 (cond 150 [(eqv? 0 in-len) #""] 151 [else 152 (define out-payload-len (fx* (fxquotient (fx+ in-len 2) 3) 4)) 153 (define out-len (fx+ out-payload-len 154 (fx* (fxquotient (fx+ out-payload-len 71) 72) 155 (bytes-length linesep)))) 156 (define out (make-bytes out-len (char->integer #\=))) 157 (define (out! j c) (bytes-set! out j (vector*-ref digit-base64 c))) 158 (let loop ([i 0] [j 0] [width 0]) 159 (cond 160 [((fx+ i 3) . fx<= . in-len) 161 (define b1 (bytes-ref src i)) 162 (define b2 (bytes-ref src (fx+ i 1))) 163 (define b3 (bytes-ref src (fx+ i 2))) 164 (out! j (fxrshift b1 2)) 165 (out! (fx+ j 1) (fxior (fxlshift (fxand b1 #b11) 4) 166 (fxrshift b2 4))) 167 (out! (fx+ j 2) (fxior (fxlshift (fxand b2 #b1111) 2) 168 (fxrshift b3 6))) 169 (out! (fx+ j 3) (fxand b3 #b111111)) 170 (let ([width (fx+ width 4)] 171 [i (fx+ i 3)] 172 [j (fx+ j 4)]) 173 (cond 174 [(and (eqv? width 72) 175 (i . fx< . in-len)) 176 (bytes-copy! out j linesep) 177 (loop i (fx+ j (bytes-length linesep)) 0)] 178 [else 179 (loop i j width)]))] 180 [((fx+ i 2) . fx<= . in-len) 181 (define b1 (bytes-ref src i)) 182 (define b2 (bytes-ref src (fx+ i 1))) 183 (out! j (fxrshift b1 2)) 184 (out! (fx+ j 1) (fxior (fxlshift (fxand b1 #b11) 4) 185 (fxrshift b2 4))) 186 (out! (fx+ j 2) (fxlshift (fxand b2 #b1111) 2)) 187 (bytes-copy! out (fx+ j 4) linesep)] 188 [((fx+ i 1) . fx<= . in-len) 189 (define b1 (bytes-ref src i)) 190 (out! j (fxrshift b1 2)) 191 (out! (fx+ j 1) (fxlshift (fxand b1 #b11) 4)) 192 (bytes-copy! out (fx+ j 4) linesep)] 193 [else 194 (bytes-copy! out j linesep)])) 195 out])] 196 [else 197 (let ([s (open-output-bytes)]) 198 (base64-encode-stream (open-input-bytes src) s linesep) 199 (get-output-bytes s))])) 200