base32: change to RFC 3548 version.

diff --git a/extra/base32/base32-tests.factor b/extra/base32/base32-tests.factor
index c77d0f214777f1f038000b3eb661c845565f079b..b44dc7b7515d823f634e98dab991ed2e9f6460a9 100644 (file)
--- a/extra/base32/base32-tests.factor
+++ b/extra/base32/base32-tests.factor
@@ -1,20 +1,22 @@
 ! Copyright (C) 2019 John Benediktsson
 ! See http://factorcode.org/license.txt for BSD license
 
-USING: base32 tools.test ;
+USING: base32 sequences tools.test ;
 
-{ "16J" } [ 1234 base32> ] unit-test
-{ "16JD" } [ 1234 base32-checksum> ] unit-test
-{ "0" } [ 0 base32> ] unit-test
-{ "00" } [ 0 base32-checksum> ] unit-test
-[ -1 base32> ] must-fail
-[ 1.0 base32> ] must-fail
+{ B{ } } [ f >base32 ] unit-test
+{ B{ } } [ B{ } >base32 ] unit-test
+{ "AA======" } [ "\0" >base32 "" like ] unit-test
+{ "ME======" } [ "a" >base32 "" like ] unit-test
+{ "MFRA====" } [ "ab" >base32 "" like ] unit-test
+{ "MFRGG===" } [ "abc" >base32 "" like ] unit-test
+{ "MFRGGZA=" } [ "abcd" >base32 "" like ] unit-test
+{ "MFRGGZDF" } [ "abcde" >base32 "" like ] unit-test
 
-{ 1234 } [ "16J" >base32 ] unit-test
-{ 1234 } [ "I6J" >base32 ] unit-test
-{ 1234 } [ "i6J" >base32 ] unit-test
-{ 1234 } [ "16JD" >base32-checksum ] unit-test
-{ 1234 } [ "I6JD" >base32-checksum ] unit-test
-{ 1234 } [ "i6JD" >base32-checksum ] unit-test
-{ 0 } [ "0" >base32 ] unit-test
-{ 0 } [ "00" >base32-checksum ] unit-test
+{ B{ } } [ f base32> ] unit-test
+{ B{ } } [ B{ } base32> ] unit-test
+{ "\0" } [ "AA======" base32> "" like ] unit-test
+{ "a" } [ "ME======" base32> "" like ] unit-test
+{ "ab" } [ "MFRA====" base32> "" like ] unit-test
+{ "abc" } [ "MFRGG===" base32> "" like ] unit-test
+{ "abcd" } [ "MFRGGZA=" base32> "" like ] unit-test
+{ "abcde" } [ "MFRGGZDF" base32> "" like ] unit-test

diff --git a/extra/base32/base32.factor b/extra/base32/base32.factor
index ae9bf3e43bbc85489efebbd794cdd28d1036f2f9..b0681488de31196765e17bbc53097f6a843dea65 100644 (file)
--- a/extra/base32/base32.factor
+++ b/extra/base32/base32.factor
@@ -1,42 +1,77 @@
 ! Copyright (C) 2019 John Benediktsson
 ! See http://factorcode.org/license.txt for BSD license
+USING: base64.private byte-arrays combinators fry io io.binary
+io.encodings.binary io.streams.byte-array kernel literals math
+namespaces sequences ;
+IN: base32
 
-USING: ascii assocs byte-arrays kernel literals math sequences ;
+ERROR: malformed-base32 ;
 
-IN: base32
+! XXX: Optional map 0 as O
+! XXX: Optional map 1 as L or I
+! XXX: Optional handle lower-case input
 
 <PRIVATE
 
 <<
-CONSTANT: ALPHABET $[ "0123456789ABCDEFGHJKMNPQRSTVWXYZ" >byte-array ]
+CONSTANT: alphabet $[ "ABCDEFGHIJKLMNOPQRSTUVWXYZ234567" >byte-array ]
 >>
-CONSTANT: INVERSE $[ 256 [ ALPHABET index 0xff or ] B{ } map-integers ]
-CONSTANT: CHECKSUM $[ ALPHABET "*~$=U" append ]
 
-: normalize-base32 ( seq -- seq' )
-    CHAR: - swap remove >upper H{
-        { CHAR: I CHAR: 1 }
-        { CHAR: L CHAR: 1 }
-        { CHAR: O CHAR: 0 }
-    } substitute ;
+: ch>base32 ( ch -- ch )
+    alphabet nth ; inline
+
+: base32>ch ( ch -- ch )
+    $[ alphabet alphabet-inverse 0 CHAR: = pick set-nth ] nth
+    [ malformed-base32 ] unless* ; inline
+
+: encode5 ( seq -- byte-array )
+    be> { -35 -30 -25 -20 -15 -10 -5 0 } '[
+        shift 0x1f bitand ch>base32
+    ] with B{ } map-as ; inline
 
-: parse-base32 ( seq -- base32 )
-    0 swap [ [ 32 * ] [ INVERSE nth + ] bi* ] each ;
+: encode-pad ( seq n -- byte-array )
+    [ 5 0 pad-tail encode5 ] [ B{ 0 2 4 5 7 } nth ] bi* head-slice
+    8 CHAR: = pad-tail ; inline
+
+: (encode-base32) ( stream column -- )
+    5 pick stream-read dup length {
+        { 0 [ 3drop ] }
+        { 5 [ encode5 write-lines (encode-base32) ] }
+        [ encode-pad write-lines (encode-base32) ]
+    } case ;
 
 PRIVATE>
 
+: encode-base32 ( -- )
+    input-stream get f (encode-base32) ;
+
+: encode-base32-lines ( -- )
+    input-stream get 0 (encode-base32) ;
+
+<PRIVATE
+
+: decode8 ( seq -- )
+    [ 0 [ base32>ch swap 5 shift bitor ] reduce 5 >be ]
+    [ [ CHAR: = = ] count ] bi
+    [ write ] [ B{ 0 4 0 3 2 0 1 } nth head-slice write ] if-zero ; inline
+
+: (decode-base32) ( stream -- )
+    8 "\n\r" pick read-ignoring dup length {
+        { 0 [ 2drop ] }
+        { 8 [ decode8 (decode-base32) ] }
+        [ drop 8 CHAR: = pad-tail decode8 (decode-base32) ]
+    } case ;
+
+PRIVATE>
+
+: decode-base32 ( -- )
+    input-stream get (decode-base32) ;
+
 : >base32 ( seq -- base32 )
-    normalize-base32 parse-base32 ;
+    binary [ binary [ encode-base32 ] with-byte-reader ] with-byte-writer ;
 
 : base32> ( base32 -- seq )
-    dup 0 < [ non-negative-integer-expected ] when
-    [ dup 0 > ] [
-        32 /mod ALPHABET nth
-    ] "" produce-as nip [ "0" ] when-empty reverse! ;
-
-: >base32-checksum ( seq -- base32 )
-    normalize-base32 unclip-last [ parse-base32 ] dip
-    CHECKSUM index over 37 mod assert= ;
+    binary [ binary [ decode-base32 ] with-byte-reader ] with-byte-writer ;
 
-: base32-checksum> ( base32 -- seq )
-    [ base32> ] keep 37 mod CHECKSUM nth suffix ;
+: >base32-lines ( seq -- base32 )
+    binary [ binary [ encode-base32-lines ] with-byte-reader ] with-byte-writer ;

diff --git a/extra/base32/summary.txt b/extra/base32/summary.txt
index 97327ad8207e613f701bd771f14b9d5b6111121f..509166d694a22e72df9831179bd1c50633ebf678 100644 (file)
--- a/extra/base32/summary.txt
+++ b/extra/base32/summary.txt
@@ -1 +1 @@
-Douglas Crockford's Base 32 encoding/decoding
+Base 32 encoding/decoding (RFC 3548)