1 ! Copyright (C) 2019 John Benediktsson
2 ! See http://factorcode.org/license.txt for BSD license
3 USING: base64.private byte-arrays combinators endian io
4 io.encodings.binary io.streams.byte-array kernel kernel.private
5 literals math namespaces sequences ;
8 ERROR: malformed-base32 ;
10 ! XXX: Optional map 0 as O
11 ! XXX: Optional map 1 as L or I
12 ! XXX: Optional handle lower-case input
17 CONSTANT: alphabet $[ "ABCDEFGHIJKLMNOPQRSTUVWXYZ234567" >byte-array ]
20 : ch>base32 ( ch -- ch )
23 : base32>ch ( ch -- ch )
24 $[ alphabet alphabet-inverse 0 CHAR: = pick set-nth ] nth
25 [ malformed-base32 ] unless* { fixnum } declare ; inline
27 : encode5 ( seq -- byte-array )
28 be> { -35 -30 -25 -20 -15 -10 -5 0 } '[
29 shift 0x1f bitand ch>base32
30 ] with B{ } map-as ; inline
32 : encode-pad ( seq n -- byte-array )
33 [ 5 0 pad-tail encode5 ] [ B{ 0 2 4 5 7 } nth ] bi* head-slice
34 8 CHAR: = pad-tail ; inline
36 : (encode-base32) ( stream column -- )
37 5 pick stream-read dup length {
39 { 5 [ encode5 write-lines (encode-base32) ] }
40 [ encode-pad write-lines (encode-base32) ]
45 : encode-base32 ( -- )
46 input-stream get f (encode-base32) ;
48 : encode-base32-lines ( -- )
49 input-stream get 0 (encode-base32) ;
54 [ 0 [ base32>ch swap 5 shift bitor ] reduce 5 >be ]
55 [ [ CHAR: = = ] count ] bi
56 [ write ] [ B{ 0 4 0 3 2 0 1 } nth head-slice write ] if-zero ; inline
58 : (decode-base32) ( stream -- )
59 8 "\n\r" pick read-ignoring dup length {
61 { 8 [ decode8 (decode-base32) ] }
62 [ drop 8 CHAR: = pad-tail decode8 (decode-base32) ]
67 : decode-base32 ( -- )
68 input-stream get (decode-base32) ;
70 : >base32 ( seq -- base32 )
71 binary [ binary [ encode-base32 ] with-byte-reader ] with-byte-writer ;
73 : base32> ( base32 -- seq )
74 binary [ binary [ decode-base32 ] with-byte-reader ] with-byte-writer ;
76 : >base32-lines ( seq -- base32 )
77 binary [ binary [ encode-base32-lines ] with-byte-reader ] with-byte-writer ;