160 lines
4.3 KiB
Factor
160 lines
4.3 KiB
Factor
! Copyright (C) 2008 Doug Coleman, Daniel Ehrenberg.
|
|
! See http://factorcode.org/license.txt for BSD license.
|
|
USING: arrays assocs byte-arrays combinators fry growable io
|
|
io.encodings.binary io.streams.byte-array kernel kernel.private
|
|
literals locals math math.bitwise namespaces sbufs sequences
|
|
sequences.private ;
|
|
IN: base64
|
|
|
|
ERROR: malformed-base64 ;
|
|
|
|
<PRIVATE
|
|
|
|
<<
|
|
CONSTANT: alphabet $[
|
|
"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
|
|
>byte-array
|
|
]
|
|
|
|
: alphabet-inverse ( alphabet -- seq )
|
|
dup supremum 1 + f <array> [
|
|
'[ swap _ set-nth ] each-index
|
|
] keep ;
|
|
>>
|
|
|
|
: ch>base64 ( ch -- ch )
|
|
alphabet nth ; inline
|
|
|
|
: base64>ch ( ch -- ch )
|
|
$[ alphabet alphabet-inverse 0 CHAR: = pick set-nth ] nth
|
|
[ malformed-base64 ] unless* { fixnum } declare ; inline
|
|
|
|
: encode3 ( x y z -- a b c d )
|
|
{ fixnum fixnum fixnum } declare {
|
|
[ [ -2 shift ch>base64 ] [ 2 bits 4 shift ] bi ]
|
|
[ [ -4 shift bitor ch>base64 ] [ 4 bits 2 shift ] bi ]
|
|
[ [ -6 shift bitor ch>base64 ] [ 6 bits ch>base64 ] bi ]
|
|
} spread ; inline
|
|
|
|
:: (stream-write-lines) ( column data stream -- column' )
|
|
column data over 71 > [
|
|
[
|
|
stream stream-write1 1 + dup 76 = [
|
|
drop 0
|
|
B{ CHAR: \r CHAR: \n } stream stream-write
|
|
] when
|
|
] each
|
|
] [
|
|
stream stream-write 4 +
|
|
] if ; inline
|
|
|
|
: stream-write-lines ( column data stream -- column' )
|
|
pick [ (stream-write-lines) ] [ stream-write ] if ; inline
|
|
|
|
: write-lines ( column data -- column' )
|
|
output-stream get stream-write-lines ; inline
|
|
|
|
:: (encode-base64) ( input output column -- )
|
|
4 <byte-array> :> data
|
|
column [ input stream-read1 dup ] [
|
|
input stream-read1
|
|
input stream-read1
|
|
[ [ 0 or ] bi@ encode3 ] 2keep [ 0 1 ? ] bi@ + {
|
|
{ 0 [ ] }
|
|
{ 1 [ drop CHAR: = ] }
|
|
{ 2 [ 2drop CHAR: = CHAR: = ] }
|
|
} case data (4sequence) output stream-write-lines
|
|
] while 2drop ; inline
|
|
|
|
PRIVATE>
|
|
|
|
: encode-base64 ( -- )
|
|
input-stream get output-stream get f (encode-base64) ;
|
|
|
|
: encode-base64-lines ( -- )
|
|
input-stream get output-stream get 0 (encode-base64) ;
|
|
|
|
<PRIVATE
|
|
|
|
: read1-ignoring ( ignoring stream -- ch )
|
|
dup stream-read1 pick dupd member-eq?
|
|
[ drop read1-ignoring ] [ 2nip ] if ; inline recursive
|
|
|
|
: read-ignoring ( n ignoring stream -- accum )
|
|
pick <sbuf> [
|
|
'[ _ _ read1-ignoring [ ] _ push-if ] times
|
|
] keep ;
|
|
|
|
: decode4 ( a b c d -- x y z )
|
|
{ fixnum fixnum fixnum fixnum } declare {
|
|
[ base64>ch 2 shift ]
|
|
[ base64>ch [ -4 shift bitor ] [ 4 bits 4 shift ] bi ]
|
|
[ base64>ch [ -2 shift bitor ] [ 2 bits 6 shift ] bi ]
|
|
[ base64>ch bitor ]
|
|
} spread ; inline
|
|
|
|
:: (decode-base64) ( input output -- )
|
|
3 <byte-array> :> data
|
|
[ B{ CHAR: \n CHAR: \r } input read1-ignoring dup ] [
|
|
B{ CHAR: \n CHAR: \r } input read1-ignoring CHAR: = or
|
|
B{ CHAR: \n CHAR: \r } input read1-ignoring CHAR: = or
|
|
B{ CHAR: \n CHAR: \r } input read1-ignoring CHAR: = or
|
|
[ decode4 data (3sequence) ] 3keep
|
|
[ CHAR: = eq? 1 0 ? ] tri@ + +
|
|
[ head-slice* ] unless-zero
|
|
output stream-write
|
|
] while drop ;
|
|
|
|
PRIVATE>
|
|
|
|
: decode-base64 ( -- )
|
|
input-stream get output-stream get (decode-base64) ;
|
|
|
|
<PRIVATE
|
|
|
|
: ensure-encode-length ( base64 -- base64 )
|
|
dup length 3 /mod zero? [ 1 + ] unless 4 *
|
|
output-stream get expand ;
|
|
|
|
: ensure-decode-length ( seq -- seq )
|
|
dup length 4 /mod zero? [ 1 + ] unless 3 *
|
|
output-stream get expand ;
|
|
|
|
PRIVATE>
|
|
|
|
: >base64 ( seq -- base64 )
|
|
binary [
|
|
ensure-encode-length
|
|
binary [ encode-base64 ] with-byte-reader
|
|
] with-byte-writer ;
|
|
|
|
: base64> ( base64 -- seq )
|
|
binary [
|
|
ensure-decode-length
|
|
binary [ decode-base64 ] with-byte-reader
|
|
] with-byte-writer ;
|
|
|
|
: >base64-lines ( seq -- base64 )
|
|
binary [
|
|
ensure-encode-length
|
|
binary [ encode-base64-lines ] with-byte-reader
|
|
] with-byte-writer ;
|
|
|
|
: >urlsafe-base64 ( seq -- base64 )
|
|
>base64 H{
|
|
{ CHAR: + CHAR: - }
|
|
{ CHAR: / CHAR: _ }
|
|
} substitute ;
|
|
|
|
: urlsafe-base64> ( base64 -- seq )
|
|
H{
|
|
{ CHAR: - CHAR: + }
|
|
{ CHAR: _ CHAR: / }
|
|
} substitute base64> ;
|
|
|
|
: >urlsafe-base64-lines ( seq -- base64 )
|
|
>base64-lines H{
|
|
{ CHAR: + CHAR: - }
|
|
{ CHAR: / CHAR: _ }
|
|
} substitute ;
|