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