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 growable io
4 io.encodings.binary io.streams.byte-array kernel kernel.private
5 literals math math.bitwise namespaces sbufs sequences
9 ERROR: malformed-base64 ;
15 "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
19 : alphabet-inverse ( alphabet -- seq )
20 dup supremum 1 + f <array> [
21 '[ swap _ set-nth ] each-index
25 : ch>base64 ( ch -- ch )
28 : base64>ch ( ch -- ch )
29 $[ alphabet alphabet-inverse 0 CHAR: = pick set-nth ] nth
30 [ malformed-base64 ] unless* { fixnum } declare ; inline
32 : encode3 ( x y z -- a b c d )
33 { fixnum fixnum fixnum } declare {
34 [ [ -2 shift ch>base64 ] [ 2 bits 4 shift ] bi ]
35 [ [ -4 shift bitor ch>base64 ] [ 4 bits 2 shift ] bi ]
36 [ [ -6 shift bitor ch>base64 ] [ 6 bits ch>base64 ] bi ]
39 :: (stream-write-lines) ( column data stream -- column' )
40 column data over 71 > [
42 stream stream-write1 1 + dup 76 = [
44 B{ CHAR: \r CHAR: \n } stream stream-write
48 stream stream-write 4 +
51 : stream-write-lines ( column data stream -- column' )
52 pick [ (stream-write-lines) ] [ stream-write ] if ; inline
54 : write-lines ( column data -- column' )
55 output-stream get stream-write-lines ; inline
57 :: (encode-base64) ( input output column -- )
58 4 <byte-array> :> data
59 column [ input stream-read1 dup ] [
62 [ [ 0 or ] bi@ encode3 ] 2keep [ 0 1 ? ] bi@ + {
64 { 1 [ drop CHAR: = ] }
65 { 2 [ 2drop CHAR: = CHAR: = ] }
66 } case data (4sequence) output stream-write-lines
67 ] while 2drop ; inline
71 : encode-base64 ( -- )
72 input-stream get output-stream get f (encode-base64) ;
74 : encode-base64-lines ( -- )
75 input-stream get output-stream get 0 (encode-base64) ;
79 : read1-ignoring ( ignoring stream -- ch )
80 dup stream-read1 pick dupd member-eq?
81 [ drop read1-ignoring ] [ 2nip ] if ; inline recursive
83 : read-ignoring ( n ignoring stream -- accum )
85 '[ _ _ read1-ignoring [ ] _ push-if ] times
88 : decode4 ( a b c d -- x y z )
89 { fixnum fixnum fixnum fixnum } declare {
91 [ base64>ch [ -4 shift bitor ] [ 4 bits 4 shift ] bi ]
92 [ base64>ch [ -2 shift bitor ] [ 2 bits 6 shift ] bi ]
96 :: (decode-base64) ( input output -- )
97 3 <byte-array> :> data
98 [ B{ CHAR: \n CHAR: \r } input read1-ignoring dup ] [
99 B{ CHAR: \n CHAR: \r } input read1-ignoring CHAR: = or
100 B{ CHAR: \n CHAR: \r } input read1-ignoring CHAR: = or
101 B{ CHAR: \n CHAR: \r } input read1-ignoring CHAR: = or
102 [ decode4 data (3sequence) ] 3keep
103 [ CHAR: = eq? 1 0 ? ] tri@ + +
104 [ head-slice* ] unless-zero
110 : decode-base64 ( -- )
111 input-stream get output-stream get (decode-base64) ;
115 : ensure-encode-length ( base64 -- base64 )
116 dup length 3 /mod zero? [ 1 + ] unless 4 *
117 output-stream get expand ;
119 : ensure-decode-length ( seq -- seq )
120 dup length 4 /mod zero? [ 1 + ] unless 3 *
121 output-stream get expand ;
125 : >base64 ( seq -- base64 )
128 binary [ encode-base64 ] with-byte-reader
131 : base64> ( base64 -- seq )
134 binary [ decode-base64 ] with-byte-reader
137 : >base64-lines ( seq -- base64 )
140 binary [ encode-base64-lines ] with-byte-reader
143 : >urlsafe-base64 ( seq -- base64 )
149 : urlsafe-base64> ( base64 -- seq )
153 } substitute base64> ;
155 : >urlsafe-base64-lines ( seq -- base64 )