1 ! Copyright (C) 2008 Doug Coleman, Daniel Ehrenberg.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: arrays assocs byte-arrays combinators fry io io.binary
4 io.encodings.binary io.streams.byte-array kernel kernel.private
5 literals math namespaces sbufs sequences ;
8 ERROR: malformed-base64 ;
14 "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
18 : alphabet-inverse ( alphabet -- seq )
19 dup supremum 1 + f <array> [
20 '[ swap _ set-nth ] each-index
24 : ch>base64 ( ch -- ch )
27 : base64>ch ( ch -- ch )
28 $[ alphabet alphabet-inverse 0 CHAR: = pick set-nth ] nth
29 [ malformed-base64 ] unless* { fixnum } declare ; inline
31 : (write-lines) ( column byte-array -- column' )
32 output-stream get dup '[
33 _ stream-write1 1 + dup 76 = [
34 drop B{ CHAR: \r CHAR: \n } _ stream-write 0
38 : write-lines ( column byte-array -- column' )
39 over [ (write-lines) ] [ write ] if ; inline
41 : encode3 ( seq -- byte-array )
42 be> { -18 -12 -6 0 } '[
43 shift 0x3f bitand ch>base64
44 ] with B{ } map-as ; inline
46 : encode-pad ( seq n -- byte-array )
47 [ 3 0 pad-tail encode3 ] [ 1 + ] bi* head-slice
48 4 CHAR: = pad-tail ; inline
50 : (encode-base64) ( stream column -- )
51 3 pick stream-read dup length {
53 { 3 [ encode3 write-lines (encode-base64) ] }
54 [ encode-pad write-lines (encode-base64) ]
59 : encode-base64 ( -- )
60 input-stream get f (encode-base64) ;
62 : encode-base64-lines ( -- )
63 input-stream get 0 (encode-base64) ;
67 : read1-ignoring ( ignoring stream -- ch )
68 dup stream-read1 pick dupd member?
69 [ drop read1-ignoring ] [ 2nip ] if ; inline recursive
71 : push-ignoring ( accum ch -- accum )
72 dup { f 0 } member-eq? [ drop ] [ suffix! ] if ; inline
74 : read-into-ignoring ( accum n ignoring stream -- accum )
75 '[ _ _ read1-ignoring push-ignoring ] times ; inline
77 : read-ignoring ( n ignoring stream -- accum )
78 [ [ <sbuf> ] keep ] 2dip read-into-ignoring ; inline
81 [ 0 [ base64>ch swap 6 shift bitor ] reduce 3 >be ]
82 [ [ CHAR: = = ] count ] bi
83 [ write ] [ head-slice* write ] if-zero ; inline
85 : (decode-base64) ( stream -- )
86 4 "\n\r" pick read-ignoring dup length {
88 { 4 [ decode4 (decode-base64) ] }
89 [ drop 4 CHAR: = pad-tail decode4 (decode-base64) ]
94 : decode-base64 ( -- )
95 input-stream get (decode-base64) ;
97 : >base64 ( seq -- base64 )
98 binary [ binary [ encode-base64 ] with-byte-reader ] with-byte-writer ;
100 : base64> ( base64 -- seq )
101 binary [ binary [ decode-base64 ] with-byte-reader ] with-byte-writer ;
103 : >base64-lines ( seq -- base64 )
104 binary [ binary [ encode-base64-lines ] with-byte-reader ] with-byte-writer ;
106 : >urlsafe-base64 ( seq -- base64 )
112 : urlsafe-base64> ( base64 -- seq )
116 } substitute base64> ;
118 : >urlsafe-base64-lines ( seq -- base64 )