Author: wmb
Date: 2007-07-22 03:17:56 +0200 (Sun, 22 Jul 2007)
New Revision: 482
Added:
forth/lib/base64decode.fth
forth/lib/base64encode.fth
Log:
Added base64 encoding and decoding functions.
Added: forth/lib/base64decode.fth
===================================================================
--- forth/lib/base64decode.fth (rev 0)
+++ forth/lib/base64decode.fth 2007-07-22 01:17:56 UTC (rev 482)
@@ -0,0 +1,127 @@
+purpose: Decode base64 (RFC 1341)
+\ See license at end of file
+
+0 [if]
+\ Constructing the map on the fly takes almost as much space as including
+\ it verbatim. The verbatim copy is probably smaller when compressed.
+
+h# 100 buffer: base64-map
+
+: ?make-map ( -- )
+ base64-map c@ h# ff <> if
+ base64-map h# 100 h# ff fill
+ " ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
+ bounds ?do i base64-map i c@ + c! loop
+ h# fe base64-map [char] = + c!
+ then
+;
+
+[else]
+
+base @ hex
+create base64-map
+ff c, ff c, ff c, ff c, ff c, ff c, ff c, ff c,
+ff c, ff c, ff c, ff c, ff c, ff c, ff c, ff c,
+ff c, ff c, ff c, ff c, ff c, ff c, ff c, ff c,
+ff c, ff c, ff c, ff c, ff c, ff c, ff c, ff c,
+ff c, ff c, ff c, ff c, ff c, ff c, ff c, ff c,
+ff c, ff c, ff c, 3e c, ff c, ff c, ff c, 3f c, \ + /
+34 c, 35 c, 36 c, 37 c, 38 c, 39 c, 3a c, 3b c, \ 0-7
+3c c, 3d c, ff c, ff c, ff c, fe c, ff c, ff c, \ 89=
+ff c, 0 c, 1 c, 2 c, 3 c, 4 c, 5 c, 6 c, \ A-G
+ 7 c, 8 c, 9 c, a c, b c, c c, d c, e c, \ H-O
+ f c, 10 c, 11 c, 12 c, 13 c, 14 c, 15 c, 16 c, \ P-W
+17 c, 18 c, 19 c, ff c, ff c, ff c, ff c, ff c, \ X-Z
+ff c, 1a c, 1b c, 1c c, 1d c, 1e c, 1f c, 20 c, \ a-g
+21 c, 22 c, 23 c, 24 c, 25 c, 26 c, 27 c, 28 c, \ h-o
+29 c, 2a c, 2b c, 2c c, 2d c, 2e c, 2f c, 30 c, \ p-w
+31 c, 32 c, 33 c, ff c, ff c, ff c, ff c, ff c, \ x-z
+ff c, ff c, ff c, ff c, ff c, ff c, ff c, ff c,
+ff c, ff c, ff c, ff c, ff c, ff c, ff c, ff c,
+ff c, ff c, ff c, ff c, ff c, ff c, ff c, ff c,
+ff c, ff c, ff c, ff c, ff c, ff c, ff c, ff c,
+ff c, ff c, ff c, ff c, ff c, ff c, ff c, ff c,
+ff c, ff c, ff c, ff c, ff c, ff c, ff c, ff c,
+ff c, ff c, ff c, ff c, ff c, ff c, ff c, ff c,
+ff c, ff c, ff c, ff c, ff c, ff c, ff c, ff c,
+ff c, ff c, ff c, ff c, ff c, ff c, ff c, ff c,
+ff c, ff c, ff c, ff c, ff c, ff c, ff c, ff c,
+ff c, ff c, ff c, ff c, ff c, ff c, ff c, ff c,
+ff c, ff c, ff c, ff c, ff c, ff c, ff c, ff c,
+ff c, ff c, ff c, ff c, ff c, ff c, ff c, ff c,
+ff c, ff c, ff c, ff c, ff c, ff c, ff c, ff c,
+ff c, ff c, ff c, ff c, ff c, ff c, ff c, ff c,
+ff c, ff c, ff c, ff c, ff c, ff c, ff c, ff c,
+base !
+[then]
+
+variable base64-buf \ Bit buffer, collects 6-bit groups into 3 bytes
+variable base64-nbits \ Number of bits currently in bit buffer
+variable base64-trim \ Number of bytes to trim at the end
+\needs base64-outp variable base64-outp \ Output buffer pointer
+
+: base64-bits ( 6bits -- )
+ base64-buf @ 6 lshift or base64-buf !
+ 6 base64-nbits +!
+ base64-nbits @ d# 24 = if
+ base64-buf @ lbsplit drop ( b2 b1 b0 )
+ base64-outp @ tuck c! 1+ tuck c! 1+ tuck c! 1+ ( adr' )
+ base64-outp !
+ base64-nbits off
+ then
+;
+
+\ where must be large enough to hold the result including up to 2 padding bytes
+\ Trivially, ( inlen ) 3 + 4 / 3 * ( outlen )
+\ but that ignores the fact that, in practice, the line length is limited to
+\ to 76 characters, so some embedded newlines are skipped. That makes the
+\ actual output length smaller than the calculation above, so the above is safe.
+\ In-place decoding is possible, since the output pointer can never catch up
+\ to the input pointer.
+
+: decode-base64 ( adr len where -- len' )
+[ifdef] ?make-map ?make-map [then]
+ base64-nbits off 0 base64-trim ! ( adr len where )
+ dup base64-outp ! -rot ( where adr len )
+
+ bounds ?do ( where )
+ i c@ base64-map + c@ ( where sym )
+ dup h# ff = if ( where sym )
+ drop ( where )
+ else ( where sym )
+ dup h# fe = if ( where sym )
+ 1 base64-trim +! ( where sym )
+ base64-trim @ 2 > abort" Bad base64 input"
+ drop 0 base64-bits ( where )
+ else ( where sym )
+ base64-trim @ 0<> abort" Bad base64 input"
+ base64-bits ( where )
+ then ( where )
+ then ( where )
+ loop ( where )
+ base64-outp @ swap - base64-trim @ - ( len )
+;
+
+\ LICENSE_BEGIN
+\ Copyright (c) 2007 FirmWorks
+\
+\ Permission is hereby granted, free of charge, to any person obtaining
+\ a copy of this software and associated documentation files (the
+\ "Software"), to deal in the Software without restriction, including
+\ without limitation the rights to use, copy, modify, merge, publish,
+\ distribute, sublicense, and/or sell copies of the Software, and to
+\ permit persons to whom the Software is furnished to do so, subject to
+\ the following conditions:
+\
+\ The above copyright notice and this permission notice shall be
+\ included in all copies or substantial portions of the Software.
+\
+\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
+\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
+\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+\
+\ LICENSE_END
Added: forth/lib/base64encode.fth
===================================================================
--- forth/lib/base64encode.fth (rev 0)
+++ forth/lib/base64encode.fth 2007-07-22 01:17:56 UTC (rev 482)
@@ -0,0 +1,118 @@
+purpose: Encode in base64 (RFC 1341)
+\ See license at end of file
+
+variable base64-linelen
+
+defer base64-emit
+
+: base64-putcr ( -- )
+ carret base64-emit linefeed base64-emit
+ base64-linelen off
+;
+
+: base64-putb ( char -- )
+ base64-emit 1 base64-linelen +!
+ base64-linelen @ d# 72 = if base64-putcr then
+;
+
+: base64-out ( 6bits -- )
+ h# 3f and ( bits )
+ " ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/" ( bits adr len )
+ drop + c@ ( char )
+ base64-putb ( )
+;
+
+: base64-put= ( -- ) [char] = base64-putb debug-me ;
+
+: base64-encbyte ( adr bits #rshift -- adr' bits' )
+ >r ( adr bits' r: #rshift )
+ 8 lshift over c@ or ( adr bits' r: #rshift ) \ Get 8 new bits
+ swap 1+ swap ( adr bits' r: #rshift ) \ Increment address
+ dup r> rshift base64-out ( adr bits' ) \ Output 6 high bits
+;
+
+: encode-base64 ( adr len -- )
+ base64-linelen off ( adr len )
+ bounds ( endadr adr )
+ begin 2dup 3 + >= while ( endadr adr )
+ 0 ( endadr adr 0bits )
+ 2 base64-encbyte ( endadr adr' 2bits )
+ 4 base64-encbyte ( endadr adr' 4bits )
+ 6 base64-encbyte ( endadr adr' 6bits )
+ base64-out ( endadr adr )
+ repeat ( endadr adr )
+
+ tuck - case ( adr )
+ 1 of ( adr )
+ 0 ( adr 0bits )
+ 2 base64-encbyte ( adr' 2bits )
+ 4 lshift base64-out ( adr )
+ base64-put= base64-put= ( adr )
+ endof
+
+ 2 of ( adr )
+ 0 ( adr 0bits )
+ 2 base64-encbyte ( adr' 2bits )
+ 4 base64-encbyte ( adr' 4bits )
+ 2 lshift base64-out ( adr )
+ base64-put= ( adr )
+ endof
+ endcase ( adr )
+
+ drop ( )
+
+ base64-linelen @ if base64-putcr then ( )
+;
+
+: stream-encode-base64 ( adr len -- )
+ ['] emit to base64-emit
+ encode-base64
+;
+
+\ "where" must have enough space to hold the result
+\
+\ : outlen ( inlen -- outlen )
+\ \ Account for symbol expansion
+\ 2 + 3 / 4 * ( #6bit-symbols )
+\ \ Account for CR-LFs
+\ d# 72 /mod d# 74 * ( lastline-symbols fullline-bytes )
+\ \ CR-LF on possible short last line
+\ swap ?dup if + 2+ then
+\ ;
+
+\needs base64-outp variable base64-outp \ Output buffer pointer
+variable base64-outbase
+: base64-memout ( char -- ) base64-outp @ c! 1 base64-outp +! ;
+
+: mem-encode-base64 ( adr len where -- outlen )
+ dup base64-outp ! base64-outbase !
+ ['] base64-memout to base64-emit
+
+ encode-base64
+
+ base64-outp @ base64-outbase @ -
+;
+
+\ LICENSE_BEGIN
+\ Copyright (c) 2007 FirmWorks
+\
+\ Permission is hereby granted, free of charge, to any person obtaining
+\ a copy of this software and associated documentation files (the
+\ "Software"), to deal in the Software without restriction, including
+\ without limitation the rights to use, copy, modify, merge, publish,
+\ distribute, sublicense, and/or sell copies of the Software, and to
+\ permit persons to whom the Software is furnished to do so, subject to
+\ the following conditions:
+\
+\ The above copyright notice and this permission notice shall be
+\ included in all copies or substantial portions of the Software.
+\
+\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
+\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
+\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+\
+\ LICENSE_END
