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 [ 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-ignoring ( n ignoring stream -- sbuf )
73 [ [ <sbuf> ] keep ] 2dip
74 '[ _ _ read1-ignoring push-ignoring ] times ; inline
77 [ 0 [ base64>ch swap 6 shift bitor ] reduce 3 >be ]
78 [ [ CHAR: = = ] count ] bi
79 [ write ] [ head-slice* write ] if-zero ; inline
81 : (decode-base64) ( stream -- )
82 4 "\n\r" pick read-ignoring dup length {
84 { 4 [ decode4 (decode-base64) ] }
90 : decode-base64 ( -- )
91 input-stream get (decode-base64) ;
93 : >base64 ( seq -- base64 )
94 binary [ binary [ encode-base64 ] with-byte-reader ] with-byte-writer ;
96 : base64> ( base64 -- seq )
97 binary [ binary [ decode-base64 ] with-byte-reader ] with-byte-writer ;
99 : >base64-lines ( seq -- base64 )
100 binary [ binary [ encode-base64-lines ] with-byte-reader ] with-byte-writer ;