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

more base64-related changes

Browse Source 
svn: r11470

original commit: 20e96730286af60a5d5ded2fb64980221974d3b2
This commit is contained in:
Eli Barzilay 2008-08-28 21:00:53 +00:00
parent 840bc6be51
commit 4257833e1e
1 changed files with 33 additions and 49 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -17,58 +17,42 @@
(values (vector->immutable-vector bd) (vector->immutable-vector db))))
(define =byte (bytes-ref #"=" 0))
(define ones
(vector->immutable-vector
(list->vector (for/list ([i (in-range 9)]) (sub1 (arithmetic-shift 1 i))))))
(define (base64-decode-stream in out)
(let loop ([waiting 0] [waiting-bits 0])
(if (>= waiting-bits 8)
(begin
(write-byte (arithmetic-shift waiting (- 8 waiting-bits)) out)
(let ([waiting-bits (- waiting-bits 8)])
(loop (bitwise-and waiting (sub1 (arithmetic-shift 1 waiting-bits)))
waiting-bits)))
(let* ([c (read-byte in)]
[c (if (eof-object? c) =byte c)]
[v (vector-ref base64-digit c)])
(cond [v (loop (+ (arithmetic-shift waiting 6) v)
(+ waiting-bits 6))]
[(eq? c =byte) (void)] ; done
[else (loop waiting waiting-bits)])))))
(let loop ([data 0] [bits 0])
(if (>= bits 8)
(let ([bits (- bits 8)])
(write-byte (arithmetic-shift data (- bits)) out)
(loop (bitwise-and data (vector-ref ones bits)) bits))
(let ([c (read-byte in)])
(unless (or (eof-object? c) (eq? c =byte))
(let ([v (vector-ref base64-digit c)])
(if v
(loop (+ (arithmetic-shift data 6) v) (+ bits 6))
(loop data bits))))))))
(define base64-encode-stream
(case-lambda
[(in out) (base64-encode-stream in out #"\n")]
[(in out linesep)
;; 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 3.
(let ([three (make-bytes 3)]
[outc (lambda (n)
(write-byte (vector-ref digit-base64 n) out))]
[done (lambda (fill)
(for ([i (in-range 0 fill)]) (write-byte =byte out))
(display linesep out))])
(let loop ([pos 0])
(if (= pos 72)
;; Insert newline
(begin (display linesep out) (loop 0))
;; Next group of 3
(let ([n (read-bytes! three in)])
(if (eof-object? n)
(unless (= pos 0) (done 0))
(let ([a (bytes-ref three 0)]
[b (if (n . >= . 2) (bytes-ref three 1) 0)]
[c (if (n . >= . 3) (bytes-ref three 2) 0)])
(outc (arithmetic-shift a -2))
(outc (+ (bitwise-and #x3f (arithmetic-shift a 4))
(arithmetic-shift b -4)))
(if (n . < . 2)
(done 2)
(begin (outc (+ (bitwise-and #x3f (arithmetic-shift b 2))
(arithmetic-shift c -6)))
(if (n . < . 3)
(done 1)
(begin (outc (bitwise-and #x3f c))
(loop (+ pos 4))))))))))))]))
(define (base64-encode-stream in out [linesep #"\n"])
(let loop ([data 0] [bits 0] [width 0])
(define (write-char)
(let ([width (modulo (add1 width) 72)])
(when (zero? width) (display linesep out))
(write-byte (vector-ref digit-base64 (arithmetic-shift data (- 6 bits)))
out)
width))
(if (>= bits 6)
(let ([bits (- bits 6)])
(loop (bitwise-and data (vector-ref ones bits)) bits (write-char)))
(let ([c (read-byte in)])
(if (eof-object? c)
;; flush extra bits
(let ([width (if (> bits 0) (write-char) width)])
(when (> width 0)
(for ([i (in-range (modulo (- width) 4))]) (write-byte =byte out))
(display linesep out)))
(loop (+ (arithmetic-shift data 8) c) (+ bits 8) width))))))
(define (base64-decode src)
(let ([s (open-output-bytes)])