1 ! Copyright (C) 2008 Doug Coleman, Daniel Ehrenberg.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: arrays combinators fry io io.binary io.encodings.binary
4 io.streams.byte-array kernel literals math namespaces sbufs
8 ERROR: malformed-base64 ;
14 "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
16 : alphabet-inverse ( alphabet -- seq )
17 dup supremum 1 + f <array> [
18 '[ swap _ set-nth ] each-index
22 : ch>base64 ( ch -- ch )
25 : base64>ch ( ch -- ch )
26 $[ alphabet alphabet-inverse 0 CHAR: = pick set-nth ] nth
27 [ throw-malformed-base64 ] unless* ; inline
29 : (write-lines) ( column byte-array -- column' )
30 output-stream get dup '[
31 _ stream-write1 1 + dup 76 = [
32 drop B{ CHAR: \r CHAR: \n } _ stream-write 0
36 : write-lines ( column byte-array -- column' )
37 over [ (write-lines) ] [ write ] if ; inline
39 : encode3 ( seq -- byte-array )
40 be> { -18 -12 -6 0 } '[
41 shift 0x3f bitand ch>base64
42 ] with B{ } map-as ; inline
44 : encode-pad ( seq n -- byte-array )
45 [ 3 0 pad-tail encode3 ] [ 1 + ] bi* head-slice
46 4 CHAR: = pad-tail ; inline
48 : (encode-base64) ( stream column -- )
49 3 pick stream-read dup length {
51 { 3 [ encode3 write-lines (encode-base64) ] }
52 [ encode-pad write-lines (encode-base64) ]
57 : encode-base64 ( -- )
58 input-stream get f (encode-base64) ;
60 : encode-base64-lines ( -- )
61 input-stream get 0 (encode-base64) ;
65 : read1-ignoring ( ignoring stream -- ch )
66 dup stream-read1 pick dupd member?
67 [ drop read1-ignoring ] [ 2nip ] if ; inline recursive
69 : push-ignoring ( accum ch -- accum )
70 dup { f 0 } member-eq? [ drop ] [ suffix! ] if ; inline
72 : read-into-ignoring ( accum n ignoring stream -- accum )
73 '[ _ _ read1-ignoring push-ignoring ] times ; inline
75 : read-ignoring ( n ignoring stream -- accum )
76 [ [ <sbuf> ] keep ] 2dip read-into-ignoring ; inline
79 [ 0 [ base64>ch swap 6 shift bitor ] reduce 3 >be ]
80 [ [ CHAR: = = ] count ] bi
81 [ write ] [ head-slice* write ] if-zero ; inline
83 : (decode-base64) ( stream -- )
84 4 "\n\r" pick read-ignoring dup length {
86 { 4 [ decode4 (decode-base64) ] }
87 [ throw-malformed-base64 ]
92 : decode-base64 ( -- )
93 input-stream get (decode-base64) ;
95 : >base64 ( seq -- base64 )
96 binary [ binary [ encode-base64 ] with-byte-reader ] with-byte-writer ;
98 : base64> ( base64 -- seq )
99 binary [ binary [ decode-base64 ] with-byte-reader ] with-byte-writer ;
101 : >base64-lines ( seq -- base64 )
102 binary [ binary [ encode-base64-lines ] with-byte-reader ] with-byte-writer ;