1 ! Copyright (C) 2008 Doug Coleman, Daniel Ehrenberg.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: combinators fry io io.binary io.encodings.binary
4 io.streams.byte-array kernel math namespaces
8 ERROR: malformed-base64 ;
12 : read1-ignoring ( ignoring stream -- ch )
13 dup stream-read1 pick dupd member?
14 [ drop read1-ignoring ] [ 2nip ] if ;
16 : read-ignoring ( n ignoring stream -- str )
17 '[ _ _ read1-ignoring ] replicate
18 [ { f 0 } member-eq? not ] "" filter-as
21 : ch>base64 ( ch -- ch )
22 "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
25 : base64>ch ( ch -- ch )
27 f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f
28 f f f f f f f f f f 62 f f f 63 52 53 54 55 56 57 58 59 60 61 f f
29 f 0 f f f 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21
30 22 23 24 25 f f f f f f 26 27 28 29 30 31 32 33 34 35 36 37 38 39
31 40 41 42 43 44 45 46 47 48 49 50 51
32 } nth [ malformed-base64 ] unless* ; inline
36 : write1-lines ( column/f ch stream -- column' )
37 [ stream-write1 ] keep swap [
39 '[ 76 = [ B{ CHAR: \r CHAR: \n } _ stream-write ] when ]
43 : write-lines ( str -- )
44 column output-stream get '[
45 swap [ _ write1-lines ] each
49 column output-stream get '[
50 swap be> { 3 2 1 0 } [
51 -6 * shift 0x3f bitand ch>base64 _ write1-lines
55 : encode-pad ( seq n -- )
56 [ 3 0 pad-tail binary [ encode3 ] with-byte-writer ]
57 [ 1 + ] bi* head-slice 4 CHAR: = pad-tail write-lines ; inline
60 [ 0 [ base64>ch swap 6 shift bitor ] reduce 3 >be ]
61 [ [ CHAR: = = ] count ] bi head-slice*
62 output-stream get '[ _ stream-write1 ] each ; inline
64 : (encode-base64) ( stream -- )
65 3 over stream-read dup length {
67 { 3 [ encode3 (encode-base64) ] }
68 [ encode-pad (encode-base64) ]
73 : encode-base64 ( -- )
74 input-stream get (encode-base64) ;
76 : encode-base64-lines ( -- )
77 0 column [ encode-base64 ] with-variable ;
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 ;