suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

* Improved precomputed vector genaration

Browse Source 
* Removed `base64-filename-safe'
* Much simplified code in ``base64-encode-stream''

svn: r11446
This commit is contained in:
Eli Barzilay 2008-08-27 03:54:57 +00:00
parent 2e8d5ed971
commit 0f1ac966f6
2 changed files with 55 additions and 109 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
collects/net/base64-sig.ss
View File

@ -1,6 +1,5 @@
#lang scheme/signature #lang scheme/signature
base64-filename-safe
base64-encode-stream base64-encode-stream
base64-decode-stream base64-decode-stream
base64-encode base64-encode

163
collects/net/base64-unit.ss
View File

@ -5,123 +5,70 @@
(import) (import)
(export base64^) (export base64^)
(define base64-digit (make-vector 256)) (define ranges '([#"AZ" 0] [#"az" 26] [#"09" 52] [#"++" 62] [#"//" 63]))
(let loop ([n 0])
(unless (= n 256)
(cond [(<= (char->integer #\A) n (char->integer #\Z))
(vector-set! base64-digit n (- n (char->integer #\A)))]
[(<= (char->integer #\a) n (char->integer #\z))
(vector-set! base64-digit n (+ 26 (- n (char->integer #\a))))]
[(<= (char->integer #\0) n (char->integer #\9))
(vector-set! base64-digit n (+ 52 (- n (char->integer #\0))))]
[(= (char->integer #\+) n)
(vector-set! base64-digit n 62)]
[(= (char->integer #\/) n)
(vector-set! base64-digit n 63)]
[else
(vector-set! base64-digit n #f)])
(loop (add1 n))))
(define digit-base64 (make-vector 64)) (define-values (base64-digit digit-base64)
(define (each-char s e pos) (let ([bd (make-vector 256 #f)] [db (make-vector 64 #f)])
(let loop ([i (char->integer s)][pos pos]) (for ([r ranges] #:when #t
(unless (> i (char->integer e)) [i (in-range (bytes-ref (car r) 0) (add1 (bytes-ref (car r) 1)))]
(vector-set! digit-base64 pos i) [n (in-naturals (cadr r))])
(loop (add1 i) (add1 pos))))) (vector-set! bd i n)
(each-char #\A #\Z 0) (vector-set! db n i))
(each-char #\a #\z 26) (values (vector->immutable-vector bd) (vector->immutable-vector db))))
(each-char #\0 #\9 52)
(each-char #\+ #\+ 62)
(each-char #\/ #\/ 63)
(define (base64-filename-safe) (define =byte (bytes-ref #"=" 0))
(vector-set! base64-digit (char->integer #\-) 62)
(vector-set! base64-digit (char->integer #\_) 63)
(each-char #\- #\- 62)
(each-char #\_ #\_ 63))
(define (base64-decode-stream in out) (define (base64-decode-stream in out)
(let loop ([waiting 0][waiting-bits 0]) (let loop ([waiting 0] [waiting-bits 0])
(if (>= waiting-bits 8) (if (>= waiting-bits 8)
(begin (begin
(write-byte (arithmetic-shift waiting (- 8 waiting-bits)) out) (write-byte (arithmetic-shift waiting (- 8 waiting-bits)) out)
(let ([waiting-bits (- waiting-bits 8)]) (let ([waiting-bits (- waiting-bits 8)])
(loop (bitwise-and waiting (sub1 (arithmetic-shift 1 waiting-bits))) (loop (bitwise-and waiting (sub1 (arithmetic-shift 1 waiting-bits)))
waiting-bits))) waiting-bits)))
(let* ([c0 (read-byte in)] (let* ([c (read-byte in)]
[c (if (eof-object? c0) (char->integer #\=) c0)] [c (if (eof-object? c) =byte c)]
[v (vector-ref base64-digit c)]) [v (vector-ref base64-digit c)])
(cond [v (loop (+ (arithmetic-shift waiting 6) v) (cond [v (loop (+ (arithmetic-shift waiting 6) v)
(+ waiting-bits 6))] (+ waiting-bits 6))]
[(eq? c (char->integer #\=)) (void)] ; done [(eq? c =byte) (void)] ; done
[else (loop waiting waiting-bits)]))))) [else (loop waiting waiting-bits)])))))
(define base64-encode-stream (define base64-encode-stream
(case-lambda (case-lambda
[(in out) (base64-encode-stream in out #"\n")] [(in out) (base64-encode-stream in out #"\n")]
[(in out linesep) [(in out linesep)
;; Process input 3 characters at a time, because 18 bits ;; Process input 3 characters at a time, because 18 bits
;; is divisible by both 6 and 8, and 72 (the line length) ;; is divisible by both 6 and 8, and 72 (the line length)
;; is divisible by 3. ;; is divisible by 3.
(let ([three (make-bytes 3)] (let ([three (make-bytes 3)]
[outc (lambda (n) [outc (lambda (n)
(write-byte (vector-ref digit-base64 n) out))] (write-byte (vector-ref digit-base64 n) out))]
[done (lambda (fill) [done (lambda (fill)
(let loop ([fill fill]) (for ([i (in-range 0 fill)]) (write-byte =byte out))
(unless (zero? fill) (display linesep out))])
(write-byte (char->integer #\=) out) (let loop ([pos 0])
(loop (sub1 fill)))) (if (= pos 72)
(display linesep out))]) ;; Insert newline
(let loop ([pos 0]) (begin (display linesep out) (loop 0))
(if (= pos 72) ;; Next group of 3
;; Insert newline (let ([n (read-bytes! three in)])
(begin (if (eof-object? n)
(display linesep out) (unless (= pos 0) (done 0))
(loop 0)) (let ([a (bytes-ref three 0)]
;; Next group of 3 [b (if (n . >= . 2) (bytes-ref three 1) 0)]
(let ([n (read-bytes-avail! three in)]) [c (if (n . >= . 3) (bytes-ref three 2) 0)])
(cond (outc (arithmetic-shift a -2))
[(eof-object? n) (outc (+ (bitwise-and #x3f (arithmetic-shift a 4))
(unless (= pos 0) (done 0))] (arithmetic-shift b -4)))
[(= n 3) (if (n . < . 2)
;; Easy case: (done 2)
(let ([a (bytes-ref three 0)] (begin (outc (+ (bitwise-and #x3f (arithmetic-shift b 2))
[b (bytes-ref three 1)]
[c (bytes-ref three 2)])
(outc (arithmetic-shift a -2))
(outc (+ (bitwise-and #x3f (arithmetic-shift a 4))
(arithmetic-shift b -4)))
(outc (+ (bitwise-and #x3f (arithmetic-shift b 2))
(arithmetic-shift c -6)))
(outc (bitwise-and #x3f c))
(loop (+ pos 4)))]
[else
;; Hard case: n is 1 or 2
(let ([a (bytes-ref three 0)])
(outc (arithmetic-shift a -2))
(let* ([next (if (= n 2)
(bytes-ref three 1)
(read-byte in))]
[b (if (eof-object? next)
0
next)])
(outc (+ (bitwise-and #x3f (arithmetic-shift a 4))
(arithmetic-shift b -4)))
(if (eof-object? next)
(done 2)
;; More to go
(let* ([next (read-byte in)]
[c (if (eof-object? next)
0
next)])
(outc (+ (bitwise-and #x3f (arithmetic-shift b 2))
(arithmetic-shift c -6))) (arithmetic-shift c -6)))
(if (eof-object? next) (if (n . < . 3)
(done 1) (done 1)
;; Finish c, loop (begin (outc (bitwise-and #x3f c))
(begin (loop (+ pos 4))))))))))))]))
(outc (bitwise-and #x3f c))
(loop (+ pos 4))))))))])))))]))
(define (base64-decode src) (define (base64-decode src)
(let ([s (open-output-bytes)]) (let ([s (open-output-bytes)])