sandi-0.2.3/0000755000175000001440000000000012200126151012011 5ustar magnususerssandi-0.2.3/bench-src/0000755000175000001440000000000012200126151013655 5ustar magnususerssandi-0.2.3/bench-src/Codec/0000755000175000001440000000000012200126151014672 5ustar magnususerssandi-0.2.3/bench-src/Codec/Binary/0000755000175000001440000000000012200126151016116 5ustar magnususerssandi-0.2.3/bench-src/Codec/Binary/Base32HexBench.hs0000644000175000001440000000067312200126151021104 0ustar magnususersmodule Codec.Binary.Base32HexBench where import Criterion.Main (bench, nf) import Codec.Binary.Base32Hex mkBenchs data1M data10M = let enc1M = encode data1M enc10M = encode data10M in [ bench "enc base 32 hex 1M" $ nf encode data1M , bench "dec base 32 hex 1M" $ nf decode enc1M , bench "enc base 32 hex 10M" $ nf encode data10M , bench "dec base 32 hex 10M" $ nf decode enc10M ] sandi-0.2.3/bench-src/Codec/Binary/XxBench.hs0000644000175000001440000000061112200126151020007 0ustar magnususersmodule Codec.Binary.XxBench where import Criterion.Main (bench, nf) import Codec.Binary.Xx mkBenchs data1M data10M = let enc1M = encode data1M enc10M = encode data10M in [ bench "enc xx 1M" $ nf encode data1M , bench "dec xx 1M" $ nf decode enc1M , bench "enc xx 10M" $ nf encode data10M , bench "dec xx 10M" $ nf decode enc10M ] sandi-0.2.3/bench-src/Codec/Binary/UuBench.hs0000644000175000001440000000061112200126151020001 0ustar magnususersmodule Codec.Binary.UuBench where import Criterion.Main (bench, nf) import Codec.Binary.Uu mkBenchs data1M data10M = let enc1M = encode data1M enc10M = encode data10M in [ bench "enc uu 1M" $ nf encode data1M , bench "dec uu 1M" $ nf decode enc1M , bench "enc uu 10M" $ nf encode data10M , bench "dec uu 10M" $ nf decode enc10M ] sandi-0.2.3/bench-src/Codec/Binary/Base85Bench.hs0000644000175000001440000000064512200126151020446 0ustar magnususersmodule Codec.Binary.Base85Bench where import Criterion.Main (bench, nf) import Codec.Binary.Base85 mkBenchs data1M data10M = let enc1M = encode data1M enc10M = encode data10M in [ bench "enc base 85 1M" $ nf encode data1M , bench "dec base 85 1M" $ nf decode enc1M , bench "enc base 85 10M" $ nf encode data10M , bench "dec base 85 10M" $ nf decode enc10M ] sandi-0.2.3/bench-src/Codec/Binary/Base64Bench.hs0000644000175000001440000000064512200126151020443 0ustar magnususersmodule Codec.Binary.Base64Bench where import Criterion.Main (bench, nf) import Codec.Binary.Base64 mkBenchs data1M data10M = let enc1M = encode data1M enc10M = encode data10M in [ bench "enc base 64 1M" $ nf encode data1M , bench "dec base 64 1M" $ nf decode enc1M , bench "enc base 64 10M" $ nf encode data10M , bench "dec base 64 10M" $ nf decode enc10M ] sandi-0.2.3/bench-src/Codec/Binary/QuotedPrintableBench.hs0000644000175000001440000000073312200126151022517 0ustar magnususersmodule Codec.Binary.QuotedPrintableBench where import Criterion.Main (bench, nf) import Codec.Binary.QuotedPrintable mkBenchs data1M data10M = let enc1M = encode data1M enc10M = encode data10M in [ bench "enc quoted printable 1M" $ nf encode data1M , bench "dec quoted printable 1M" $ nf decode enc1M , bench "enc quoted printable 10M" $ nf encode data10M , bench "dec quoted printable 10M" $ nf decode enc10M ] sandi-0.2.3/bench-src/Codec/Binary/YencBench.hs0000644000175000001440000000062512200126151020313 0ustar magnususersmodule Codec.Binary.YencBench where import Criterion.Main (bench, nf) import Codec.Binary.Yenc mkBenchs data1M data10M = let enc1M = encode data1M enc10M = encode data10M in [ bench "enc yenc 1M" $ nf encode data1M , bench "dec yenc 1M" $ nf decode enc1M , bench "enc yenc 10M" $ nf encode data10M , bench "dec yenc 10M" $ nf decode enc10M ] sandi-0.2.3/bench-src/Codec/Binary/Base16Bench.hs0000644000175000001440000000064512200126151020440 0ustar magnususersmodule Codec.Binary.Base16Bench where import Criterion.Main (bench, nf) import Codec.Binary.Base16 mkBenchs data1M data10M = let enc1M = encode data1M enc10M = encode data10M in [ bench "enc base 16 1M" $ nf encode data1M , bench "dec base 16 1M" $ nf decode enc1M , bench "enc base 16 10M" $ nf encode data10M , bench "dec base 16 10M" $ nf decode enc10M ] sandi-0.2.3/bench-src/Codec/Binary/Base64UrlBench.hs0000644000175000001440000000067312200126151021127 0ustar magnususersmodule Codec.Binary.Base64UrlBench where import Criterion.Main (bench, nf) import Codec.Binary.Base64Url mkBenchs data1M data10M = let enc1M = encode data1M enc10M = encode data10M in [ bench "enc base 64 url 1M" $ nf encode data1M , bench "dec base 64 url 1M" $ nf decode enc1M , bench "enc base 64 url 10M" $ nf encode data10M , bench "dec base 64 url 10M" $ nf decode enc10M ] sandi-0.2.3/bench-src/Codec/Binary/Base32Bench.hs0000644000175000001440000000064512200126151020436 0ustar magnususersmodule Codec.Binary.Base32Bench where import Criterion.Main (bench, nf) import Codec.Binary.Base32 mkBenchs data1M data10M = let enc1M = encode data1M enc10M = encode data10M in [ bench "enc base 32 1M" $ nf encode data1M , bench "dec base 32 1M" $ nf decode enc1M , bench "enc base 32 10M" $ nf encode data10M , bench "dec base 32 10M" $ nf decode enc10M ] sandi-0.2.3/bench-src/Main.hs0000644000175000001440000000223212200126151015074 0ustar magnususersmodule Main where import Criterion.Main (bench, defaultMain, nf) import qualified Data.ByteString as BS import System.IO import qualified Codec.Binary.Base16Bench as B16B import qualified Codec.Binary.Base32Bench as B32B import qualified Codec.Binary.Base32HexBench as B32HB import qualified Codec.Binary.Base64Bench as B64B import qualified Codec.Binary.Base64UrlBench as B64UB import qualified Codec.Binary.Base85Bench as B85B import qualified Codec.Binary.QuotedPrintableBench as QPB import qualified Codec.Binary.UuBench as UuB import qualified Codec.Binary.XxBench as XxB import qualified Codec.Binary.YencBench as YB main :: IO () main = do h <- openFile "/dev/urandom" ReadMode data1M <- BS.hGet h (1024 * 1024) data10M <- BS.hGet h (10 * 1024 * 1024) defaultMain $ B16B.mkBenchs data1M data10M ++ B32B.mkBenchs data1M data10M ++ B32HB.mkBenchs data1M data10M ++ B64B.mkBenchs data1M data10M ++ B64UB.mkBenchs data1M data10M ++ B85B.mkBenchs data1M data10M ++ QPB.mkBenchs data1M data10M ++ UuB.mkBenchs data1M data10M ++ XxB.mkBenchs data1M data10M ++ YB.mkBenchs data1M data10M sandi-0.2.3/LICENSE0000644000175000001440000000276112200126151013024 0ustar magnususersCopyright (c) 2012, Magnus Therning All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: - Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. - Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. - Neither the name of Magnus Therning nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. sandi-0.2.3/csrc/0000755000175000001440000000000012200126151012743 5ustar magnususerssandi-0.2.3/csrc/codec.h0000644000175000001440000000756012200126151014201 0ustar magnususers// Copyright: (c) Magnus Therning, 2012, 2013 // License: BSD3, found in the LICENSE file #ifndef _CODEC_H_ #define _CODEC_H_ #include #include void b16_enc(uint8_t const *src, size_t srclen, uint8_t *dst, size_t *dstlen, uint8_t const **rem, size_t *remlen); int b16_dec(uint8_t const *src, size_t srclen, uint8_t *dst, size_t *dstlen, uint8_t const **rem, size_t *remlen); void b32_enc_part(uint8_t const *src, size_t srclen, uint8_t *dst, size_t *dstlen, uint8_t const **rem, size_t *remlen); int b32_enc_final(uint8_t const *src, size_t srclen, uint8_t *dst, size_t *dstlen); int b32_dec_part(uint8_t const *src, size_t srclen, uint8_t *dst, size_t *dstlen, uint8_t const **rem, size_t *remlen); int b32_dec_final(uint8_t const *src, size_t srclen, uint8_t *dst, size_t *dstlen); void b32h_enc_part(uint8_t const *src, size_t srclen, uint8_t *dst, size_t *dstlen, uint8_t const **rem, size_t *remlen); int b32h_enc_final(uint8_t const *src, size_t srclen, uint8_t *dst, size_t *dstlen); int b32h_dec_part(uint8_t const *src, size_t srclen, uint8_t *dst, size_t *dstlen, uint8_t const **rem, size_t *remlen); int b32h_dec_final(uint8_t const *src, size_t srclen, uint8_t *dst, size_t *dstlen); void b64_enc_part(uint8_t const *src, size_t srclen, uint8_t *dst, size_t *dstlen, uint8_t const **rem, size_t *remlen); int b64_enc_final(uint8_t const *src, size_t srclen, uint8_t *dst, size_t *dstlen); int b64_dec_part(uint8_t const *src, size_t srclen, uint8_t *dst, size_t *dstlen, uint8_t const **rem, size_t *remlen); int b64_dec_final(uint8_t const *src, size_t srclen, uint8_t *dst, size_t *dstlen); void b64u_enc_part(uint8_t const *src, size_t srclen, uint8_t *dst, size_t *dstlen, uint8_t const **rem, size_t *remlen); int b64u_enc_final(uint8_t const *src, size_t srclen, uint8_t *dst, size_t *dstlen); int b64u_dec_part(uint8_t const *src, size_t srclen, uint8_t *dst, size_t *dstlen, uint8_t const **rem, size_t *remlen); int b64u_dec_final(uint8_t const *src, size_t srclen, uint8_t *dst, size_t *dstlen); void b85_enc_part(uint8_t const *src, size_t srclen, uint8_t *dst, size_t *dstlen, uint8_t const **rem, size_t *remlen); int b85_enc_final(uint8_t const *src, size_t srclen, uint8_t *dst, size_t *dstlen); int b85_dec_part(uint8_t const *src, size_t srclen, uint8_t *dst, size_t *dstlen, uint8_t const **rem, size_t *remlen); int b85_dec_final(uint8_t const *src, size_t srclen, uint8_t *dst, size_t *dstlen); void qp_enc(uint8_t const *src, size_t srclen, uint8_t *dst, size_t *dstlen, uint8_t const **rem, size_t *remlen); int qp_dec(uint8_t const *src, size_t srclen, uint8_t *dst, size_t *dstlen, uint8_t const **rem, size_t *remlen); void uu_enc_part(uint8_t const *src, size_t srclen, uint8_t *dst, size_t *dstlen, uint8_t const **rem, size_t *remlen); int uu_enc_final(uint8_t const *src, size_t srclen, uint8_t *dst, size_t *dstlen); int uu_dec_part(uint8_t const *src, size_t srclen, uint8_t *dst, size_t *dstlen, uint8_t const **rem, size_t *remlen); int uu_dec_final(uint8_t const *src, size_t srclen, uint8_t *dst, size_t *dstlen); void xx_enc_part(uint8_t const *src, size_t srclen, uint8_t *dst, size_t *dstlen, uint8_t const **rem, size_t *remlen); int xx_enc_final(uint8_t const *src, size_t srclen, uint8_t *dst, size_t *dstlen); int xx_dec_part(uint8_t const *src, size_t srclen, uint8_t *dst, size_t *dstlen, uint8_t const **rem, size_t *remlen); int xx_dec_final(uint8_t const *src, size_t srclen, uint8_t *dst, size_t *dstlen); void y_enc(uint8_t const *src, size_t srclen, uint8_t *dst, size_t *dstlen, uint8_t const **rem, size_t *remlen); int y_dec(uint8_t const *src, size_t srclen, uint8_t *dst, size_t *dstlen, uint8_t const **rem, size_t *remlen); #endif sandi-0.2.3/csrc/codec.c0000644000175000001440000014700012200126151014166 0ustar magnususers// Copyright: (c) Magnus Therning, 2012 // License: BSD3, found in the LICENSE file #include #include #include "codec.h" // {{{1 base16 static char const b16_encmap[] = "0123456789ABCDEF"; void b16_enc(uint8_t const *src, size_t srclen, uint8_t *dst, size_t *dstlen, uint8_t const **rem, size_t *remlen) { size_t od = *dstlen, i; assert(src || srclen == 0); assert(dst); assert(dstlen); assert(rem); assert(remlen); for(i = 0, *dstlen = 0; i < srclen && *dstlen + 1 < od; i++, *dstlen += 2) { uint8_t o0 = src[i] >> 4, o1 = src[i] & 0x0f; dst[*dstlen] = b16_encmap[o0]; dst[*dstlen + 1] = b16_encmap[o1]; } *rem = src + i; *remlen = srclen - i; } static uint8_t const b16_decmap[] = { 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x00, 0x01, 0x02, 0x03, 0x04, 0x05, 0x06, 0x07, 0x08, 0x09, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x0a, 0x0b, 0x0c, 0x0d, 0x0e, 0x0f, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x0a, 0x0b, 0x0c, 0x0d, 0x0e, 0x0f, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, }; int b16_dec(uint8_t const *src, size_t srclen, uint8_t *dst, size_t *dstlen, uint8_t const **rem, size_t *remlen) { size_t od = *dstlen, i; int res = 0; assert(src || srclen == 0); assert(dst); assert(dstlen); assert(rem); assert(remlen); for(i = 0, *dstlen = 0; i < srclen && *dstlen < od; i += 2, (*dstlen)++) { if(i + 1 >= srclen) { res = 0; break; } uint8_t o0 = b16_decmap[src[i]], o1 = b16_decmap[src[i + 1]]; if((o0 | o1) & 0xf0) { res = 1; break; } else dst[*dstlen] = o0 << 4 | o1; } *rem = src + i; *remlen = srclen - i; return(res); } // {{{1 base32 static char const b32_encmap[] = "ABCDEFGHIJKLMNOPQRSTUVWXYZ234567"; void b32_enc_part(uint8_t const *src, size_t srclen, uint8_t *dst, size_t *dstlen, uint8_t const **rem, size_t *remlen) { assert(src || 0 == srclen); assert(dst); assert(dstlen); assert(rem); assert(remlen); size_t od = *dstlen, i; for(i = 0, *dstlen = 0; i + 5 <= srclen && *dstlen + 8 <= od; i += 5, *dstlen += 8) { int32_t o0, o1, o2, o3, o4, o5, o6, o7; o0 = src[i] >> 3; o1 = ((src[i] << 2) | (src[i+1] >> 6)) & 0x1f; o2 = (src[i+1] >> 1) & 0x1f; o3 = ((src[i+1] << 4) | (src[i+2] >> 4)) & 0x1f; o4 = ((src[i+2] << 1) | (src[i+3] >> 7)) & 0x1f; o5 = (src[i+3] >>2) & 0x1f; o6 = ((src[i+3] << 3) | (src[i+4] >> 5)) & 0x1f; o7 = src[i+4] & 0x1f; *dst++ = b32_encmap[o0]; *dst++ = b32_encmap[o1]; *dst++ = b32_encmap[o2]; *dst++ = b32_encmap[o3]; *dst++ = b32_encmap[o4]; *dst++ = b32_encmap[o5]; *dst++ = b32_encmap[o6]; *dst++ = b32_encmap[o7]; } *rem = src + i; *remlen = srclen - i; } int b32_enc_final(uint8_t const *src, size_t srclen, uint8_t *dst, size_t *dstlen) { assert(src || 0 == srclen); assert(dst); assert(dstlen); switch(srclen) { int32_t o0, o1, o2, o3, o4, o5, o6; case 0: *dstlen = 0; return(0); break; case 1: o0 = src[0] >> 3; o1 = (src[0] << 2) & 0x1f; *dst++ = b32_encmap[o0]; *dst++ = b32_encmap[o1]; *dst++ = '='; *dst++ = '='; *dst++ = '='; *dst++ = '='; *dst++ = '='; *dst++ = '='; *dstlen = 8; return(0); break; case 2: o0 = src[0] >> 3; o1 = ((src[0] << 2) | (src[1] >> 6)) & 0x1f; o2 = (src[1] >> 1) & 0x1f; o3 = src[1] << 4 & 0x1f; *dst++ = b32_encmap[o0]; *dst++ = b32_encmap[o1]; *dst++ = b32_encmap[o2]; *dst++ = b32_encmap[o3]; *dst++ = '='; *dst++ = '='; *dst++ = '='; *dst++ = '='; *dstlen = 8; return(0); break; case 3: o0 = src[0] >> 3; o1 = ((src[0] << 2) | (src[1] >> 6)) & 0x1f; o2 = (src[1] >> 1) & 0x1f; o3 = ((src[1] << 4) | (src[2] >> 4)) & 0x1f; o4 = (src[2] << 1) & 0x1f; *dst++ = b32_encmap[o0]; *dst++ = b32_encmap[o1]; *dst++ = b32_encmap[o2]; *dst++ = b32_encmap[o3]; *dst++ = b32_encmap[o4]; *dst++ = '='; *dst++ = '='; *dst++ = '='; *dstlen = 8; return(0); break; case 4: o0 = src[0] >> 3; o1 = ((src[0] << 2) | (src[1] >> 6)) & 0x1f; o2 = (src[1] >> 1) & 0x1f; o3 = ((src[1] << 4) | (src[2] >> 4)) & 0x1f; o4 = ((src[2] << 1) | (src[3] >> 7)) & 0x1f; o5 = (src[3] >>2) & 0x1f; o6 = (src[3] << 3) & 0x1f; *dst++ = b32_encmap[o0]; *dst++ = b32_encmap[o1]; *dst++ = b32_encmap[o2]; *dst++ = b32_encmap[o3]; *dst++ = b32_encmap[o4]; *dst++ = b32_encmap[o5]; *dst++ = b32_encmap[o6]; *dst++ = '='; *dstlen = 8; return(0); break; default: return(1); break; } } // decode map, 0x80 = not allowed, 0x40 = end char static uint8_t const b32_decmap[] = { 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x1a, 0x1b, 0x1c, 0x1d, 0x1e, 0x1f, 0x80, 0x80, 0x80, 0x80, 0x80, 0x40, 0x80, 0x80, 0x80, 0x00, 0x01, 0x02, 0x03, 0x04, 0x05, 0x06, 0x07, 0x08, 0x09, 0x0a, 0x0b, 0x0c, 0x0d, 0x0e, 0x0f, 0x10, 0x11, 0x12, 0x13, 0x14, 0x15, 0x16, 0x17, 0x18, 0x19, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80 }; int b32_dec_part(uint8_t const *src, size_t srclen, uint8_t *dst, size_t *dstlen, uint8_t const **rem, size_t *remlen) { size_t od = *dstlen, i; int res = 0; assert(src || 0 == srclen); assert(dst); assert(dstlen); assert(rem); assert(remlen); for(i = 0, *dstlen = 0; i + 8 <= srclen && *dstlen + 5 <= od; i += 8, *dstlen += 5) { uint8_t o0, o1, o2, o3, o4, o5, o6, o7; o0 = b32_decmap[src[i]]; o1 = b32_decmap[src[i+1]]; o2 = b32_decmap[src[i+2]]; o3 = b32_decmap[src[i+3]]; o4 = b32_decmap[src[i+4]]; o5 = b32_decmap[src[i+5]]; o6 = b32_decmap[src[i+6]]; o7 = b32_decmap[src[i+7]]; if(!(0xc0 & (o0 | o1 | o2 | o3 | o4 | o5 | o6 | o7))) { // no illegal chars, and no '=' *dst++ = (o0 << 3) | (o1 >> 2); *dst++ = (o1 << 6) | (o2 << 1) | (o3 >> 4); *dst++ = (o3 << 4) | (o4 >> 1); *dst++ = (o4 << 7) | (o5 << 2) | (o6 >> 3); *dst++ = (o6 << 5) | o7; } else if((!(0xc0 & (o0 | o1)) && (0x40 & o2 & o3 & o4 & o5 & o6 & o7)) // two legal chars, six '=' || (!(0xc0 & (o0 | o1 | o2 | o3)) && (0x40 & o4 & o5 & o6 & o7)) // four legal chars, four '=' || (!(0xc0 & (o0 | o1 | o2 | o3 | o4)) && (0x40 & o5 & o6 & o7)) // five legal chars, three '=' || (!(0xc0 & (o0 | o1 | o2 | o3 | o4 | o5 | o6)) && (0x40 & o7))) { // seven legal chars, one '=' res = 0; break; } else { res = 1; break; } } *rem = src + i; *remlen = srclen - i; return(res); } int b32_dec_final(uint8_t const *src, size_t srclen, uint8_t *dst, size_t *dstlen) { uint8_t o0, o1, o2, o3, o4, o5, o6, o7; assert(src || 0 == srclen); assert(dst); assert(dstlen); if(0 == srclen) { *dstlen = 0; return(0); } o0 = b32_decmap[src[0]]; o1 = b32_decmap[src[1]]; o2 = b32_decmap[src[2]]; o3 = b32_decmap[src[3]]; o4 = b32_decmap[src[4]]; o5 = b32_decmap[src[5]]; o6 = b32_decmap[src[6]]; o7 = b32_decmap[src[7]]; if(!(0xc0 & (o0 | o1)) && (0x40 & o2 & o3 & o4 & o5 & o6 & o7)) { // two legal chars, six '=' *dst++ = (o0 << 3) | (o1 >> 2); *dst++ = (o1 << 6); *dstlen = 1; } else if(!(0xc0 & (o0 | o1 | o2 | o3)) && (0x40 & o4 & o5 & o6 & o7)) { // four legal chars, four '=' *dst++ = (o0 << 3) | (o1 >> 2); *dst++ = (o1 << 6) | (o2 << 1) | (o3 >> 4); *dst++ = (o3 << 4); *dstlen = 2; } else if(!(0xc0 & (o0 | o1 | o2 | o3 | o4)) && (0x40 & o5 & o6 & o7)) { // five legal chars, three '=' *dst++ = (o0 << 3) | (o1 >> 2); *dst++ = (o1 << 6) | (o2 << 1) | (o3 >> 4); *dst++ = (o3 << 4) | (o4 >> 1); *dst++ = (o4 << 7) | (o5 << 2) | (o6 >> 3); *dstlen = 3; } else if(!(0xc0 & (o0 | o1 | o2 | o3 | o4 | o5 | o6)) && (0x40 & o7)) { // seven legal chars, one '=' *dst++ = (o0 << 3) | (o1 >> 2); *dst++ = (o1 << 6) | (o2 << 1) | (o3 >> 4); *dst++ = (o3 << 4) | (o4 >> 1); *dst++ = (o4 << 7) | (o5 << 2) | (o6 >> 3); *dst++ = (o6 << 5); *dstlen = 4; } else return(1); return(0); } // {{{1 base32hex static char const b32h_encmap[] = "0123456789ABCDEFGHIJKLMNOPQRSTUV"; void b32h_enc_part(uint8_t const *src, size_t srclen, uint8_t *dst, size_t *dstlen, uint8_t const **rem, size_t *remlen) { size_t od = *dstlen, i; assert(src || 0 == srclen); assert(dst); assert(dstlen); assert(rem); assert(remlen); for(i = 0, *dstlen = 0; i + 5 <= srclen && *dstlen + 8 <= od; i += 5, *dstlen += 8) { int32_t o0, o1, o2, o3, o4, o5, o6, o7; o0 = src[i] >> 3; o1 = ((src[i] << 2) | (src[i+1] >> 6)) & 0x1f; o2 = (src[i+1] >> 1) & 0x1f; o3 = ((src[i+1] << 4) | (src[i+2] >> 4)) & 0x1f; o4 = ((src[i+2] << 1) | (src[i+3] >> 7)) & 0x1f; o5 = (src[i+3] >>2) & 0x1f; o6 = ((src[i+3] << 3) | (src[i+4] >> 5)) & 0x1f; o7 = src[i+4] & 0x1f; *dst++ = b32h_encmap[o0]; *dst++ = b32h_encmap[o1]; *dst++ = b32h_encmap[o2]; *dst++ = b32h_encmap[o3]; *dst++ = b32h_encmap[o4]; *dst++ = b32h_encmap[o5]; *dst++ = b32h_encmap[o6]; *dst++ = b32h_encmap[o7]; } *rem = src + i; *remlen = srclen - i; } int b32h_enc_final(uint8_t const *src, size_t srclen, uint8_t *dst, size_t *dstlen) { assert(src || 0 == srclen); assert(dst); assert(dstlen); switch(srclen) { int32_t o0, o1, o2, o3, o4, o5, o6; case 0: *dstlen = 0; return(0); break; case 1: o0 = src[0] >> 3; o1 = (src[0] << 2) & 0x1f; *dst++ = b32h_encmap[o0]; *dst++ = b32h_encmap[o1]; *dst++ = '='; *dst++ = '='; *dst++ = '='; *dst++ = '='; *dst++ = '='; *dst++ = '='; *dstlen = 8; return(0); break; case 2: o0 = src[0] >> 3; o1 = ((src[0] << 2) | (src[1] >> 6)) & 0x1f; o2 = (src[1] >> 1) & 0x1f; o3 = src[1] << 4 & 0x1f; *dst++ = b32h_encmap[o0]; *dst++ = b32h_encmap[o1]; *dst++ = b32h_encmap[o2]; *dst++ = b32h_encmap[o3]; *dst++ = '='; *dst++ = '='; *dst++ = '='; *dst++ = '='; *dstlen = 8; return(0); break; case 3: o0 = src[0] >> 3; o1 = ((src[0] << 2) | (src[1] >> 6)) & 0x1f; o2 = (src[1] >> 1) & 0x1f; o3 = ((src[1] << 4) | (src[2] >> 4)) & 0x1f; o4 = (src[2] << 1) & 0x1f; *dst++ = b32h_encmap[o0]; *dst++ = b32h_encmap[o1]; *dst++ = b32h_encmap[o2]; *dst++ = b32h_encmap[o3]; *dst++ = b32h_encmap[o4]; *dst++ = '='; *dst++ = '='; *dst++ = '='; *dstlen = 8; return(0); break; case 4: o0 = src[0] >> 3; o1 = ((src[0] << 2) | (src[1] >> 6)) & 0x1f; o2 = (src[1] >> 1) & 0x1f; o3 = ((src[1] << 4) | (src[2] >> 4)) & 0x1f; o4 = ((src[2] << 1) | (src[3] >> 7)) & 0x1f; o5 = (src[3] >>2) & 0x1f; o6 = (src[3] << 3) & 0x1f; *dst++ = b32h_encmap[o0]; *dst++ = b32h_encmap[o1]; *dst++ = b32h_encmap[o2]; *dst++ = b32h_encmap[o3]; *dst++ = b32h_encmap[o4]; *dst++ = b32h_encmap[o5]; *dst++ = b32h_encmap[o6]; *dst++ = '='; *dstlen = 8; return(0); break; default: return(1); break; } } // decode map, 0x80 = not allowed, 0x40 = end char static uint8_t const b32h_decmap[] = { 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x00, 0x01, 0x02, 0x03, 0x04, 0x05, 0x06, 0x07, 0x08, 0x09, 0x80, 0x80, 0x80, 0x40, 0x80, 0x80, 0x80, 0x0a, 0x0b, 0x0c, 0x0d, 0x0e, 0x0f, 0x10, 0x11, 0x12, 0x13, 0x14, 0x15, 0x16, 0x17, 0x18, 0x19, 0x1a, 0x1b, 0x1c, 0x1d, 0x1e, 0x1f, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80 }; int b32h_dec_part(uint8_t const *src, size_t srclen, uint8_t *dst, size_t *dstlen, uint8_t const **rem, size_t *remlen) { size_t od = *dstlen, i; int res = 0; assert(src || 0 == srclen); assert(dst); assert(dstlen); assert(rem); assert(remlen); for(i = 0, *dstlen = 0; i + 8 <= srclen && *dstlen + 5 <= od; i += 8, *dstlen += 5) { uint8_t o0, o1, o2, o3, o4, o5, o6, o7; o0 = b32h_decmap[src[i]]; o1 = b32h_decmap[src[i+1]]; o2 = b32h_decmap[src[i+2]]; o3 = b32h_decmap[src[i+3]]; o4 = b32h_decmap[src[i+4]]; o5 = b32h_decmap[src[i+5]]; o6 = b32h_decmap[src[i+6]]; o7 = b32h_decmap[src[i+7]]; if(!(0xc0 & (o0 | o1 | o2 | o3 | o4 | o5 | o6 | o7))) { // no illegal chars, and no '=' *dst++ = (o0 << 3) | (o1 >> 2); *dst++ = (o1 << 6) | (o2 << 1) | (o3 >> 4); *dst++ = (o3 << 4) | (o4 >> 1); *dst++ = (o4 << 7) | (o5 << 2) | (o6 >> 3); *dst++ = (o6 << 5) | o7; } else if((!(0xc0 & (o0 | o1)) && (0x40 & o2 & o3 & o4 & o5 & o6 & o7)) // two legal chars, six '=' || (!(0xc0 & (o0 | o1 | o2 | o3)) && (0x40 & o4 & o5 & o6 & o7)) // four legal chars, four '=' || (!(0xc0 & (o0 | o1 | o2 | o3 | o4)) && (0x40 & o5 & o6 & o7)) // five legal chars, three '=' || (!(0xc0 & (o0 | o1 | o2 | o3 | o4 | o5 | o6)) && (0x40 & o7))) { // seven legal chars, one '=' res = 0; break; } else { res = 1; break; } } *rem = src + i; *remlen = srclen - i; return(res); } int b32h_dec_final(uint8_t const *src, size_t srclen, uint8_t *dst, size_t *dstlen) { uint8_t o0, o1, o2, o3, o4, o5, o6, o7; assert(src || 0 == srclen); assert(dst); assert(dstlen); if(0 == srclen) { *dstlen = 0; return(0); } o0 = b32h_decmap[src[0]]; o1 = b32h_decmap[src[1]]; o2 = b32h_decmap[src[2]]; o3 = b32h_decmap[src[3]]; o4 = b32h_decmap[src[4]]; o5 = b32h_decmap[src[5]]; o6 = b32h_decmap[src[6]]; o7 = b32h_decmap[src[7]]; if(!(0xc0 & (o0 | o1)) && (0x40 & o2 & o3 & o4 & o5 & o6 & o7)) { // two legal chars, six '=' *dst++ = (o0 << 3) | (o1 >> 2); *dst++ = (o1 << 6); *dstlen = 1; } else if(!(0xc0 & (o0 | o1 | o2 | o3)) && (0x40 & o4 & o5 & o6 & o7)) { // four legal chars, four '=' *dst++ = (o0 << 3) | (o1 >> 2); *dst++ = (o1 << 6) | (o2 << 1) | (o3 >> 4); *dst++ = (o3 << 4); *dstlen = 2; } else if(!(0xc0 & (o0 | o1 | o2 | o3 | o4)) && (0x40 & o5 & o6 & o7)) { // five legal chars, three '=' *dst++ = (o0 << 3) | (o1 >> 2); *dst++ = (o1 << 6) | (o2 << 1) | (o3 >> 4); *dst++ = (o3 << 4) | (o4 >> 1); *dst++ = (o4 << 7) | (o5 << 2) | (o6 >> 3); *dstlen = 3; } else if(!(0xc0 & (o0 | o1 | o2 | o3 | o4 | o5 | o6)) && (0x40 & o7)) { // seven legal chars, one '=' *dst++ = (o0 << 3) | (o1 >> 2); *dst++ = (o1 << 6) | (o2 << 1) | (o3 >> 4); *dst++ = (o3 << 4) | (o4 >> 1); *dst++ = (o4 << 7) | (o5 << 2) | (o6 >> 3); *dst++ = (o6 << 5); *dstlen = 4; } else return(1); return(0); } // {{{1 base64 static char const b64_encmap[] = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"; void b64_enc_part(uint8_t const *src, size_t srclen, uint8_t *dst, size_t *dstlen, uint8_t const **rem, size_t *remlen) { assert(src || 0 == srclen); assert(dst); assert(dstlen); assert(rem); assert(remlen); size_t od = *dstlen, i; for(i = 0, *dstlen = 0; i + 3 <= srclen && *dstlen + 4 <= od; i += 3, *dstlen += 4) { int32_t o0, o1, o2, o3; o0 = src[i] >> 2; o1 = ((src[i] << 4) | (src[i+1] >> 4)) & 0x3f; o2 = ((src[i+1] << 2) | (src[i+2] >> 6)) & 0x3f; o3 = src[i+2] & 0x3f; *dst++ = b64_encmap[o0]; *dst++ = b64_encmap[o1]; *dst++ = b64_encmap[o2]; *dst++ = b64_encmap[o3]; } *rem = src + i; *remlen = srclen - i; } int b64_enc_final(uint8_t const *src, size_t srclen, uint8_t *dst, size_t *dstlen) { assert(src || 0 == srclen); assert(dst); assert(dstlen); switch(srclen) { int32_t o0, o1, o2; case 0: *dstlen = 0; return(0); break; case 1: o0 = src[0] >> 2; o1 = (src[0] << 4) & 0x3f; *dst++ = b64_encmap[o0]; *dst++ = b64_encmap[o1]; *dst++ = '='; *dst++ = '='; *dstlen = 4; return(0); break; case 2: o0 = src[0] >> 2; o1 = ((src[0] << 4) | (src[1] >> 4)) & 0x3f; o2 = (src[1] << 2) & 0x3f; *dst++ = b64_encmap[o0]; *dst++ = b64_encmap[o1]; *dst++ = b64_encmap[o2]; *dst++ = '='; *dstlen = 4; return(0); break; default: return(1); break; } } // decode map, 0x80 = not allowed, 0x40 = end char static uint8_t const b64_decmap[] = { 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x3e, 0x80, 0x80, 0x80, 0x3f, 0x34, 0x35, 0x36, 0x37, 0x38, 0x39, 0x3a, 0x3b, 0x3c, 0x3d, 0x80, 0x80, 0x80, 0x40, 0x80, 0x80, 0x80, 0x00, 0x01, 0x02, 0x03, 0x04, 0x05, 0x06, 0x07, 0x08, 0x09, 0x0a, 0x0b, 0x0c, 0x0d, 0x0e, 0x0f, 0x10, 0x11, 0x12, 0x13, 0x14, 0x15, 0x16, 0x17, 0x18, 0x19, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x1a, 0x1b, 0x1c, 0x1d, 0x1e, 0x1f, 0x20, 0x21, 0x22, 0x23, 0x24, 0x25, 0x26, 0x27, 0x28, 0x29, 0x2a, 0x2b, 0x2c, 0x2d, 0x2e, 0x2f, 0x30, 0x31, 0x32, 0x33, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80 }; int b64_dec_part(uint8_t const *src, size_t srclen, uint8_t *dst, size_t *dstlen, uint8_t const **rem, size_t *remlen) { assert(src || 0 == srclen); assert(dst); assert(dstlen); assert(rem); assert(remlen); size_t od = *dstlen, i; int res = 0; for(i = 0, *dstlen = 0; i + 4 <= srclen && *dstlen + 3 <= od; i += 4, *dstlen += 3) { uint8_t o0, o1, o2, o3; o0 = b64_decmap[src[i]]; o1 = b64_decmap[src[i+1]]; o2 = b64_decmap[src[i+2]]; o3 = b64_decmap[src[i+3]]; if(!(0xc0 & (o0 | o1 | o2 | o3))) { // no illegal chars, and no '=' *dst++ = (o0 << 2) | (o1 >> 4); *dst++ = (o1 << 4) | (o2 >> 2); *dst++ = (o2 << 6) | o3; } else if((!(0xc0 & (o0 | o1)) && (0x40 & o2 & o3)) // two legal chars, two '=' || (!(0xc0 & (o0 | o1 | o2)) && (0x40 & o3))) { // three legal chars, one '=' res = 0; break; } else { res = 1; break; } } *rem = src + i; *remlen = srclen - i; return(res); } int b64_dec_final(uint8_t const *src, size_t srclen, uint8_t *dst, size_t *dstlen) { assert(src || 0 == srclen); assert(dst); assert(dstlen); uint8_t o0, o1, o2, o3; if(0 == srclen) { *dstlen = 0; return(0); } o0 = b64_decmap[src[0]]; o1 = b64_decmap[src[1]]; o2 = b64_decmap[src[2]]; o3 = b64_decmap[src[3]]; if(!(0xc0 & (o0 | o1)) && (0x40 & o2 & o3)) { // two legal chars, two '=' *dst++ = (o0 << 2) | (o1 >> 4); *dstlen = 1; } else if(!(0xc0 & (o0 | o1 | o2)) && (0x40 & o3)) { // three legal chars, one '=' *dst++ = (o0 << 2) | (o1 >> 4); *dst++ = (o1 << 4) | (o2 >> 2); *dstlen = 2; } else return(1); return(0); } // {{{1 base64url static char const b64u_encmap[] = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-_"; void b64u_enc_part(uint8_t const *src, size_t srclen, uint8_t *dst, size_t *dstlen, uint8_t const **rem, size_t *remlen) { assert(src || 0 == srclen); assert(dst); assert(dstlen); assert(rem); assert(remlen); size_t od = *dstlen, i; for(i = 0, *dstlen = 0; i + 3 <= srclen && *dstlen + 4 <= od; i += 3, *dstlen += 4) { int32_t o0, o1, o2, o3; o0 = src[i] >> 2; o1 = ((src[i] << 4) | (src[i+1] >> 4)) & 0x3f; o2 = ((src[i+1] << 2) | (src[i+2] >> 6)) & 0x3f; o3 = src[i+2] & 0x3f; *dst++ = b64u_encmap[o0]; *dst++ = b64u_encmap[o1]; *dst++ = b64u_encmap[o2]; *dst++ = b64u_encmap[o3]; } *rem = src + i; *remlen = srclen - i; } int b64u_enc_final(uint8_t const *src, size_t srclen, uint8_t *dst, size_t *dstlen) { assert(src || 0 == srclen); assert(dst); assert(dstlen); switch(srclen) { int32_t o0, o1, o2; case 0: *dstlen = 0; return(0); break; case 1: o0 = src[0] >> 2; o1 = (src[0] << 4) & 0x3f; *dst++ = b64u_encmap[o0]; *dst++ = b64u_encmap[o1]; *dst++ = '='; *dst++ = '='; *dstlen = 4; return(0); break; case 2: o0 = src[0] >> 2; o1 = ((src[0] << 4) | (src[1] >> 4)) & 0x3f; o2 = (src[1] << 2) & 0x3f; *dst++ = b64u_encmap[o0]; *dst++ = b64u_encmap[o1]; *dst++ = b64u_encmap[o2]; *dst++ = '='; *dstlen = 4; return(0); break; default: return(1); break; } } // decode map, 0x80 = not allowed, 0x40 = end char static uint8_t const b64u_decmap[] = { 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x3e, 0x80, 0x80, 0x34, 0x35, 0x36, 0x37, 0x38, 0x39, 0x3a, 0x3b, 0x3c, 0x3d, 0x80, 0x80, 0x80, 0x40, 0x80, 0x80, 0x80, 0x00, 0x01, 0x02, 0x03, 0x04, 0x05, 0x06, 0x07, 0x08, 0x09, 0x0a, 0x0b, 0x0c, 0x0d, 0x0e, 0x0f, 0x10, 0x11, 0x12, 0x13, 0x14, 0x15, 0x16, 0x17, 0x18, 0x19, 0x80, 0x80, 0x80, 0x80, 0x3f, 0x80, 0x1a, 0x1b, 0x1c, 0x1d, 0x1e, 0x1f, 0x20, 0x21, 0x22, 0x23, 0x24, 0x25, 0x26, 0x27, 0x28, 0x29, 0x2a, 0x2b, 0x2c, 0x2d, 0x2e, 0x2f, 0x30, 0x31, 0x32, 0x33, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80 }; int b64u_dec_part(uint8_t const *src, size_t srclen, uint8_t *dst, size_t *dstlen, uint8_t const **rem, size_t *remlen) { assert(src || 0 == srclen); assert(dst); assert(dstlen); assert(rem); assert(remlen); size_t od = *dstlen, i; int res = 0; for(i = 0, *dstlen = 0; i + 4 <= srclen && *dstlen + 3 <= od; i += 4, *dstlen += 3) { uint8_t o0, o1, o2, o3; o0 = b64u_decmap[src[i]]; o1 = b64u_decmap[src[i+1]]; o2 = b64u_decmap[src[i+2]]; o3 = b64u_decmap[src[i+3]]; if(!(0xc0 & (o0 | o1 | o2 | o3))) { // no illegal chars, and no '=' *dst++ = (o0 << 2) | (o1 >> 4); *dst++ = (o1 << 4) | (o2 >> 2); *dst++ = (o2 << 6) | o3; } else if((!(0xc0 & (o0 | o1)) && (0x40 & o2 & o3)) // two legal chars, two '=' || (!(0xc0 & (o0 | o1 | o2)) && (0x40 & o3))) { // three legal chars, one '=' res = 0; break; } else { res = 1; break; } } *rem = src + i; *remlen = srclen - i; return(res); } int b64u_dec_final(uint8_t const *src, size_t srclen, uint8_t *dst, size_t *dstlen) { assert(src || 0 == srclen); assert(dst); assert(dstlen); uint8_t o0, o1, o2, o3; if(0 == srclen) { *dstlen = 0; return(0); } o0 = b64u_decmap[src[0]]; o1 = b64u_decmap[src[1]]; o2 = b64u_decmap[src[2]]; o3 = b64u_decmap[src[3]]; if(!(0xc0 & (o0 | o1)) && (0x40 & o2 & o3)) { // two legal chars, two '=' *dst++ = (o0 << 2) | (o1 >> 4); *dstlen = 1; } else if(!(0xc0 & (o0 | o1 | o2)) && (0x40 & o3)) { // three legal chars, one '=' *dst++ = (o0 << 2) | (o1 >> 4); *dst++ = (o1 << 4) | (o2 >> 2); *dstlen = 2; } else return(1); return(0); } // {{{1 base85 uint8_t b85_zeroes[] = { 0, 0, 0, 0 }; uint8_t b85_spaces[] = { 0x20, 0x20, 0x20, 0x20 }; void b85_enc_part(uint8_t const *src, size_t srclen, uint8_t *dst, size_t *dstlen, uint8_t const **rem, size_t *remlen) { assert(src || 0 == srclen); assert(dst); assert(dstlen); assert(rem); assert(remlen); size_t od = *dstlen, i; for(i = 0, *dstlen = 0; i + 4 <= srclen && *dstlen < od; i += 4) { if(memcmp(src + i, b85_zeroes, 4) == 0) { dst[*dstlen] = 'z'; *dstlen += 1; } else if(memcmp(src + i, b85_spaces, 4) == 0) { dst[*dstlen] = 'y'; *dstlen += 1; } else { if(od < *dstlen + 5) goto exit; uint32_t v = (src[i] << 24) | (src[i+1] << 16) | (src[i+2] << 8) | src[i+3]; dst[*dstlen + 4] = v % 85 + 33; v /= 85; dst[*dstlen + 3] = v % 85 + 33; v /= 85; dst[*dstlen + 2] = v % 85 + 33; v /= 85; dst[*dstlen + 1] = v % 85 + 33; v /= 85; dst[*dstlen] = v % 85 + 33; *dstlen += 5; } } exit: *rem = src + i; *remlen = srclen - i; } int b85_enc_final(uint8_t const *src, size_t srclen, uint8_t *dst, size_t *dstlen) { assert(src || 0 == srclen); assert(dst); assert(dstlen); switch(srclen) { uint32_t v; case 0: *dstlen = 0; return(0); break; case 1: v = (src[0] << 24) | 1; v /= 85; v /= 85; v /= 85; dst[1] = v % 85 + 33; v /= 85; dst[0] = v % 85 + 33; *dstlen = 2; return(0); break; case 2: v = (src[0] << 24) | (src[1] << 16) | 1; v /= 85; v /= 85; dst[2] = v % 85 + 33; v /= 85; dst[1] = v % 85 + 33; v /= 85; dst[0] = v % 85 + 33; *dstlen = 3; return(0); break; case 3: v = (src[0] << 24) | (src[1] << 16) |(src[2] << 8) | 1; v /= 85; dst[3] = v % 85 + 33; v /= 85; dst[2] = v % 85 + 33; v /= 85; dst[1] = v % 85 + 33; v /= 85; dst[0] = v % 85 + 33; *dstlen = 4; return(0); break; default: return(1); break; } } static uint8_t const b85_decmap[] = { 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x00, 0x01, 0x02, 0x03, 0x04, 0x05, 0x06, 0x07, 0x08, 0x09, 0x0a, 0x0b, 0x0c, 0x0d, 0x0e, 0x0f, 0x10, 0x11, 0x12, 0x13, 0x14, 0x15, 0x16, 0x17, 0x18, 0x19, 0x1a, 0x1b, 0x1c, 0x1d, 0x1e, 0x1f, 0x20, 0x21, 0x22, 0x23, 0x24, 0x25, 0x26, 0x27, 0x28, 0x29, 0x2a, 0x2b, 0x2c, 0x2d, 0x2e, 0x2f, 0x30, 0x31, 0x32, 0x33, 0x34, 0x35, 0x36, 0x37, 0x38, 0x39, 0x3a, 0x3b, 0x3c, 0x3d, 0x3e, 0x3f, 0x40, 0x41, 0x42, 0x43, 0x44, 0x45, 0x46, 0x47, 0x48, 0x49, 0x4a, 0x4b, 0x4c, 0x4d, 0x4e, 0x4f, 0x50, 0x51, 0x52, 0x53, 0x54, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, }; int b85_dec_part(uint8_t const *src, size_t srclen, uint8_t *dst, size_t *dstlen, uint8_t const **rem, size_t *remlen) { assert(src || 0 == srclen); assert(dst); assert(dstlen); assert(rem); assert(remlen); size_t od = *dstlen, i; int res = 0; for(i = 0, *dstlen = 0; i < srclen && *dstlen + 4 <= od; *dstlen += 4) { switch(src[i]) { uint32_t o0, o1, o2, o3, o4, v; case 'z': dst[*dstlen + 3] = dst[*dstlen + 2] = dst[*dstlen + 1] = dst[*dstlen] = 0; i++; break; case 'y': dst[*dstlen + 3] = dst[*dstlen + 2] = dst[*dstlen + 1] = dst[*dstlen] = 0x20; i++; break; default: if(srclen < i + 5) { res = 0; goto exit; } o0 = b85_decmap[src[i]]; o1 = b85_decmap[src[i + 1]]; o2 = b85_decmap[src[i + 2]]; o3 = b85_decmap[src[i + 3]]; o4 = b85_decmap[src[i + 4]]; if(0x80 & (o0 | o1 | o2 | o3 | o4)) { res = 1; goto exit; } v = o0 * 52200625; // 85 ** 4 v += o1 * 614125; // 85 ** 3 v += o2 * 7225; // 85 ** 2 v += o3 * 85; // 85 ** 1 v += o4; // 85 ** 0 dst[*dstlen + 3] = v & 0xff; v = v >> 8; dst[*dstlen + 2] = v & 0xff; v = v >> 8; dst[*dstlen + 1] = v & 0xff; v = v >> 8; dst[*dstlen + 0] = v & 0xff; i += 5; break; } } exit: *rem = src + i; *remlen = srclen - i; return(res); } int b85_dec_final(uint8_t const *src, size_t srclen, uint8_t *dst, size_t *dstlen) { assert(src || 0 == srclen); assert(dst); assert(dstlen); switch(srclen) { uint32_t o0, o1, o2, o3, o4, v; case 0: *dstlen = 0; return(0); break; case 2: o0 = b85_decmap[src[0]]; o1 = b85_decmap[src[1]]; o2 = b85_decmap[(uint8_t)'u']; o3 = b85_decmap[(uint8_t)'u']; o4 = b85_decmap[(uint8_t)'u']; if(0x80 & ( o0 | o1)) { return(1); } v = o0 * 52200625; // 85 ** 4 v += o1 * 614125; // 85 ** 3 v += o2 * 7225; // 85 ** 2 v += o3 * 85; // 85 ** 1 v += o4; // 85 ** 0 v = v >> 24; dst[0] = v & 0xff; *dstlen = 1; return(0); break; case 3: o0 = b85_decmap[src[0]]; o1 = b85_decmap[src[1]]; o2 = b85_decmap[src[2]]; o3 = b85_decmap[(uint8_t)'u']; o4 = b85_decmap[(uint8_t)'u']; if(0x80 & ( o0 | o1 | o2)) { return(1); } v = o0 * 52200625; // 85 ** 4 v += o1 * 614125; // 85 ** 3 v += o2 * 7225; // 85 ** 2 v += o3 * 85; // 85 ** 1 v += o4; // 85 ** 0 v = v >> 16; dst[1] = v & 0xff; v = v >> 8; dst[0] = v & 0xff; *dstlen = 2; return(0); break; case 4: o0 = b85_decmap[src[0]]; o1 = b85_decmap[src[1]]; o2 = b85_decmap[src[2]]; o3 = b85_decmap[src[3]]; o4 = b85_decmap[(uint8_t)'u']; if(0x80 & ( o0 | o1 | o2 | o3)) { return(1); } v = o0 * 52200625; // 85 ** 4 v += o1 * 614125; // 85 ** 3 v += o2 * 7225; // 85 ** 2 v += o3 * 85; // 85 ** 1 v += o4; // 85 ** 0 v = v >> 8; dst[2] = v & 0xff; v = v >> 8; dst[1] = v & 0xff; v = v >> 8; dst[0] = v & 0xff; *dstlen = 3; return(0); break; default: return(1); break; } } // {{{1 quoted-printable static char const qp_encmap[] = "0123456789ABCDEF"; void qp_enc(uint8_t const *src, size_t srclen, uint8_t *dst, size_t *dstlen, uint8_t const **rem, size_t *remlen) { assert(src || srclen == 0); assert(dst); assert(dstlen); assert(rem); assert(remlen); size_t od = *dstlen, i; for(i = 0, *dstlen = 0; i < srclen && *dstlen < od; i++, (*dstlen)++) { if((33 <= src[i] && src[i] <= 60) || (62 <= src[i] && src[i] <= 126)) { dst[*dstlen] = src[i]; } else { uint8_t o0 = src[i] >> 4, o1 = src[i] & 0x0f; if(*dstlen + 3 >= od) goto exit; dst[*dstlen] = '='; dst[*dstlen + 1] = qp_encmap[o0]; dst[*dstlen + 2] = qp_encmap[o1]; *dstlen += 2; } } exit: *rem = src + i; *remlen = srclen -i; } static uint8_t const qp_decmap[] = { 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x00, 0x01, 0x02, 0x03, 0x04, 0x05, 0x06, 0x07, 0x08, 0x09, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x0a, 0x0b, 0x0c, 0x0d, 0x0e, 0x0f, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x0a, 0x0b, 0x0c, 0x0d, 0x0e, 0x0f, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, }; int qp_dec(uint8_t const *src, size_t srclen, uint8_t *dst, size_t *dstlen, uint8_t const **rem, size_t *remlen) { assert(src || srclen == 0); assert(dst); assert(dstlen); assert(rem); assert(remlen); size_t od = *dstlen, i; int res = 0; for(i = 0, *dstlen = 0; i < srclen && *dstlen < od; i++, (*dstlen)++) { if((33 <= src[i] && src[i] <= 60) || (62 <= src[i] && src[i] <= 126)) { dst[*dstlen] = src[i]; } else if('=' == src[i]) { if(i + 2 >= srclen) { res = 0; goto exit; } uint8_t o0 = qp_decmap[src[i + 1]], o1 = qp_decmap[src[i + 2]]; if((o0 | o1) & 0xf0) { res = 1; break; } dst[*dstlen] = o0 << 4 | o1; i += 2; } else { res = 1; goto exit; } } exit: *rem = src + i; *remlen = srclen -i; return(res); } // {{{1 uu static char const uu_encmap[] = "`!\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_"; void uu_enc_part(uint8_t const *src, size_t srclen, uint8_t *dst, size_t *dstlen, uint8_t const **rem, size_t *remlen) { assert(src || 0 == srclen); assert(dst); assert(dstlen); assert(rem); assert(remlen); size_t od = *dstlen, i; for(i = 0, *dstlen = 0; i + 3 <= srclen && *dstlen + 4 <= od; i += 3, *dstlen += 4) { int32_t o0, o1, o2, o3; o0 = src[i] >> 2; o1 = ((src[i] << 4) | (src[i+1] >> 4)) & 0x3f; o2 = ((src[i+1] << 2) | (src[i+2] >> 6)) & 0x3f; o3 = src[i+2] & 0x3f; *dst++ = uu_encmap[o0]; *dst++ = uu_encmap[o1]; *dst++ = uu_encmap[o2]; *dst++ = uu_encmap[o3]; } *rem = src + i; *remlen = srclen - i; } int uu_enc_final(uint8_t const *src, size_t srclen, uint8_t *dst, size_t *dstlen) { assert(src || 0 == srclen); assert(dst); assert(dstlen); switch(srclen) { int32_t o0, o1, o2; case 0: *dstlen = 0; return(0); break; case 1: o0 = src[0] >> 2; o1 = (src[0] << 4) & 0x3f; *dst++ = uu_encmap[o0]; *dst++ = uu_encmap[o1]; *dstlen = 2; return(0); break; case 2: o0 = src[0] >> 2; o1 = ((src[0] << 4) | (src[1] >> 4)) & 0x3f; o2 = (src[1] << 2) & 0x3f; *dst++ = uu_encmap[o0]; *dst++ = uu_encmap[o1]; *dst++ = uu_encmap[o2]; *dstlen = 3; return(0); break; default: return(1); break; } } // decode map, 0x80 = not allowed, 0x40 = end char static uint8_t const uu_decmap[] = { 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x40, 0x01, 0x02, 0x03, 0x04, 0x05, 0x06, 0x07, 0x08, 0x09, 0x0a, 0x0b, 0x0c, 0x0d, 0x0e, 0x0f, 0x10, 0x11, 0x12, 0x13, 0x14, 0x15, 0x16, 0x17, 0x18, 0x19, 0x1a, 0x1b, 0x1c, 0x1d, 0x1e, 0x1f, 0x20, 0x21, 0x22, 0x23, 0x24, 0x25, 0x26, 0x27, 0x28, 0x29, 0x2a, 0x2b, 0x2c, 0x2d, 0x2e, 0x2f, 0x30, 0x31, 0x32, 0x33, 0x34, 0x35, 0x36, 0x37, 0x38, 0x39, 0x3a, 0x3b, 0x3c, 0x3d, 0x3e, 0x3f, 0x00, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80 }; int uu_dec_part(uint8_t const *src, size_t srclen, uint8_t *dst, size_t *dstlen, uint8_t const **rem, size_t *remlen) { assert(src || 0 == srclen); assert(dst); assert(dstlen); assert(rem); assert(remlen); size_t od = *dstlen, i; int res = 0; for(i = 0, *dstlen = 0; i + 4 <= srclen && *dstlen + 3 <= od; i += 4, *dstlen += 3) { uint8_t o0, o1, o2, o3; o0 = uu_decmap[src[i]]; o1 = uu_decmap[src[i+1]]; o2 = uu_decmap[src[i+2]]; o3 = uu_decmap[src[i+3]]; if(!(0xc0 & (o0 | o1 | o2 | o3))) { // no illegal chars, and no ' ' *dst++ = (o0 << 2) | (o1 >> 4); *dst++ = (o1 << 4) | (o2 >> 2); *dst++ = (o2 << 6) | o3; } else { res = 1; break; } } *rem = src + i; *remlen = srclen - i; return(res); } int uu_dec_final(uint8_t const *src, size_t srclen, uint8_t *dst, size_t *dstlen) { assert(src || 0 == srclen); assert(dst); assert(dstlen); uint8_t o0, o1, o2; switch(srclen) { case 0: *dstlen = 0; return(0); break; case 2: o0 = uu_decmap[src[0]]; o1 = uu_decmap[src[1]]; if(0xc0 & (o0 | o1)) goto error; dst[0] = (o0 << 2) | (o1 >> 4); *dstlen = 1; return(0); break; case 3: o0 = uu_decmap[src[0]]; o1 = uu_decmap[src[1]]; o2 = uu_decmap[src[2]]; if(0xc0 & (o0 | o1 | o2)) goto error; dst[0] = (o0 << 2) | (o1 >> 4); dst[1] = (o1 << 4) | (o2 >> 2); *dstlen = 2; return(0); break; } error: *dstlen = 0; return(1); } // {{{1 xx static char const xx_encmap[] = "+-0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"; void xx_enc_part(uint8_t const *src, size_t srclen, uint8_t *dst, size_t *dstlen, uint8_t const **rem, size_t *remlen) { assert(src || 0 == srclen); assert(dst); assert(dstlen); assert(rem); assert(remlen); size_t od = *dstlen, i; for(i = 0, *dstlen = 0; i + 3 <= srclen && *dstlen + 4 <= od; i += 3, *dstlen += 4) { int32_t o0, o1, o2, o3; o0 = src[i] >> 2; o1 = ((src[i] << 4) | (src[i+1] >> 4)) & 0x3f; o2 = ((src[i+1] << 2) | (src[i+2] >> 6)) & 0x3f; o3 = src[i+2] & 0x3f; *dst++ = xx_encmap[o0]; *dst++ = xx_encmap[o1]; *dst++ = xx_encmap[o2]; *dst++ = xx_encmap[o3]; } *rem = src + i; *remlen = srclen - i; } int xx_enc_final(uint8_t const *src, size_t srclen, uint8_t *dst, size_t *dstlen) { assert(src || 0 == srclen); assert(dst); assert(dstlen); switch(srclen) { int32_t o0, o1, o2; case 0: *dstlen = 0; return(0); break; case 1: o0 = src[0] >> 2; o1 = (src[0] << 4) & 0x3f; *dst++ = xx_encmap[o0]; *dst++ = xx_encmap[o1]; *dstlen = 2; return(0); break; case 2: o0 = src[0] >> 2; o1 = ((src[0] << 4) | (src[1] >> 4)) & 0x3f; o2 = (src[1] << 2) & 0x3f; *dst++ = xx_encmap[o0]; *dst++ = xx_encmap[o1]; *dst++ = xx_encmap[o2]; *dstlen = 3; return(0); break; default: return(1); break; } } // decode map, 0x80 = not allowed, 0x40 = end char static uint8_t const xx_decmap[] = { 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x40, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x00, 0x80, 0x01, 0x80, 0x80, 0x02, 0x03, 0x04, 0x05, 0x06, 0x07, 0x08, 0x09, 0x0a, 0x0b, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x0c, 0x0d, 0x0e, 0x0f, 0x10, 0x11, 0x12, 0x13, 0x14, 0x15, 0x16, 0x17, 0x18, 0x19, 0x1a, 0x1b, 0x1c, 0x1d, 0x1e, 0x1f, 0x20, 0x21, 0x22, 0x23, 0x24, 0x25, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x26, 0x27, 0x28, 0x29, 0x2a, 0x2b, 0x2c, 0x2d, 0x2e, 0x2f, 0x30, 0x31, 0x32, 0x33, 0x34, 0x35, 0x36, 0x37, 0x38, 0x39, 0x3a, 0x3b, 0x3c, 0x3d, 0x3e, 0x3f, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, }; int xx_dec_part(uint8_t const *src, size_t srclen, uint8_t *dst, size_t *dstlen, uint8_t const **rem, size_t *remlen) { assert(src || 0 == srclen); assert(dst); assert(dstlen); assert(rem); assert(remlen); size_t od = *dstlen, i; int res = 0; for(i = 0, *dstlen = 0; i + 4 <= srclen && *dstlen + 3 <= od; i += 4, *dstlen += 3) { uint8_t o0, o1, o2, o3; o0 = xx_decmap[src[i]]; o1 = xx_decmap[src[i+1]]; o2 = xx_decmap[src[i+2]]; o3 = xx_decmap[src[i+3]]; if(!(0xc0 & (o0 | o1 | o2 | o3))) { // no illegal chars, and no ' ' *dst++ = (o0 << 2) | (o1 >> 4); *dst++ = (o1 << 4) | (o2 >> 2); *dst++ = (o2 << 6) | o3; } else { res = 1; break; } } *rem = src + i; *remlen = srclen - i; return(res); } int xx_dec_final(uint8_t const *src, size_t srclen, uint8_t *dst, size_t *dstlen) { assert(src || 0 == srclen); assert(dst); assert(dstlen); uint8_t o0, o1, o2; switch(srclen) { case 0: *dstlen = 0; return(0); break; case 2: o0 = xx_decmap[src[0]]; o1 = xx_decmap[src[1]]; if(0xc0 & (o0 | o1)) goto error; dst[0] = (o0 << 2) | (o1 >> 4); *dstlen = 1; return(0); break; case 3: o0 = xx_decmap[src[0]]; o1 = xx_decmap[src[1]]; o2 = xx_decmap[src[2]]; if(0xc0 & (o0 | o1 | o2)) goto error; dst[0] = (o0 << 2) | (o1 >> 4); dst[1] = (o1 << 4) | (o2 >> 2); *dstlen = 2; return(0); break; } error: *dstlen = 0; return(1); } // {{{1 yenc void y_enc(uint8_t const *src, size_t srclen, uint8_t *dst, size_t *dstlen, uint8_t const **rem, size_t *remlen) { assert(src || 0 == srclen); assert(dst); assert(dstlen); assert(rem); assert(remlen); size_t od = *dstlen, i; for(i = 0, *dstlen = 0; i < srclen && *dstlen < od; i++, (*dstlen)++) { switch(src[i]) { case 19: case 214: case 224: case 227: if(*dstlen >= od - 1) goto exit; // is there room for 2 chars in dst? dst[(*dstlen)++] = 61; dst[*dstlen] = src[i] + 106; break; default: dst[*dstlen] = src[i] + 42; break; } } exit: *rem = src + i; *remlen = srclen - i; } int y_dec(uint8_t const *src, size_t srclen, uint8_t *dst, size_t *dstlen, uint8_t const **rem, size_t *remlen) { assert(src || 0 == srclen); assert(dst); assert(dstlen); assert(rem); assert(remlen); size_t od = *dstlen, i; for(i = 0, *dstlen = 0; i < srclen && *dstlen < od; i++, (*dstlen)++) { if(61 == src[i]) { if(srclen <= i + 1) goto exit; dst[*dstlen] = src[++i] - 106; } else dst[*dstlen] = src[i] - 42; } exit: *rem = src + i; *remlen = srclen - i; return(0); } sandi-0.2.3/src/0000755000175000001440000000000012200126151012600 5ustar magnususerssandi-0.2.3/src/Codec/0000755000175000001440000000000012200126151013615 5ustar magnususerssandi-0.2.3/src/Codec/Binary/0000755000175000001440000000000012200126151015041 5ustar magnususerssandi-0.2.3/src/Codec/Binary/Base85.hs0000644000175000001440000001574212200126151016435 0ustar magnususers{-# LANGUAGE ForeignFunctionInterface #-} -- | -- Module: Codec.Binary.Base85 -- Copyright: (c) 2012 Magnus Therning -- License: BSD3 -- -- Implemented as described at . module Codec.Binary.Base85 ( b85_encode_part , b85_encode_final , b85_decode_part , b85_decode_final , encode , decode ) where import qualified Data.ByteString as BS import Foreign import Foreign.C.Types import System.IO.Unsafe as U import Data.ByteString.Unsafe castEnum :: (Enum a, Enum b) => a -> b castEnum = toEnum . fromEnum foreign import ccall "static b85.h b85_enc_part" c_b85_enc_part :: Ptr Word8 -> CSize -> Ptr Word8 -> Ptr CSize -> Ptr (Ptr Word8) -> Ptr CSize -> IO () foreign import ccall "static b85.h b85_enc_final" c_b85_enc_final :: Ptr Word8 -> CSize -> Ptr Word8 -> Ptr CSize -> IO CInt foreign import ccall "static b85.h b85_dec_part" c_b85_dec_part :: Ptr Word8 -> CSize -> Ptr Word8 -> Ptr CSize -> Ptr (Ptr Word8) -> Ptr CSize -> IO CInt foreign import ccall "static b85.h b85_dec_final" c_b85_dec_final :: Ptr Word8 -> CSize -> Ptr Word8 -> Ptr CSize -> IO CInt -- | Encoding function. -- -- Encodes as large a part as possible of the indata. -- -- >>> b85_encode_part $ Data.ByteString.Char8.pack "foobar" -- ("AoDTs","ar") -- -- It supports special handling of both all-zero groups and all-space groups. -- -- >>> b85_encode_part $ Data.ByteString.Char8.pack " " -- ("y", "") -- >>> b85_encode_part $ Data.ByteString.Char8.pack "\0\0\0\0" -- ("z", "") b85_encode_part :: BS.ByteString -> (BS.ByteString, BS.ByteString) b85_encode_part bs = U.unsafePerformIO $ unsafeUseAsCStringLen bs $ \ (inBuf, inLen) -> do let maxOutLen = inLen `div` 4 * 5 outBuf <- mallocBytes maxOutLen alloca $ \ pOutLen -> alloca $ \ pRemBuf -> alloca $ \ pRemLen -> do poke pOutLen (castEnum maxOutLen) c_b85_enc_part (castPtr inBuf) (castEnum inLen) outBuf pOutLen pRemBuf pRemLen outLen <- peek pOutLen newOutBuf <- reallocBytes outBuf (castEnum outLen) remBuf <- peek pRemBuf remLen <- peek pRemLen remBs <- BS.packCStringLen (castPtr remBuf, castEnum remLen) outBs <- unsafePackCStringFinalizer newOutBuf (castEnum outLen) (free newOutBuf) return (outBs, remBs) -- | Encoding function for the final block. -- -- >>> b85_encode_final $ Data.ByteString.Char8.pack "ar" -- Just "@<)" b85_encode_final :: BS.ByteString -> Maybe BS.ByteString b85_encode_final bs = U.unsafePerformIO $ unsafeUseAsCStringLen bs $ \ (inBuf, inLen) -> do outBuf <- mallocBytes 5 alloca $ \ pOutLen -> do r <- c_b85_enc_final (castPtr inBuf) (castEnum inLen) outBuf pOutLen if r == 0 then do outLen <- peek pOutLen newOutBuf <- reallocBytes outBuf (castEnum outLen) outBs <- unsafePackCStringFinalizer newOutBuf (castEnum outLen) (free newOutBuf) return $ Just outBs else free outBuf >> return Nothing -- | Decoding function. -- -- Decode as large a portion of the input as possible. -- -- >>> b85_decode_part $ Data.ByteString.Char8.pack "AoDTs" -- Right ("foob","") -- >>> b85_decode_part $ Data.ByteString.Char8.pack "AoDTs@<)" -- Right ("foob","@<)") -- >>> b85_decode_part $ Data.ByteString.Char8.pack "@<)" -- Right ("","@<)") -- -- At least 512 bytes of data is allocated for the output, but because of the -- special handling of all-zero and all-space groups it is possible that the -- space won't be enough. (To be sure to always fit the output one would have -- to allocate 5 times the length of the input. It seemed a good trade-off to -- sometimes have to call the function more than once instead.) -- -- >>> either snd snd $ b85_decode_part $ Data.ByteString.Char8.pack $ Prelude.take 129 $ repeat 'y' -- "y" b85_decode_part :: BS.ByteString -> Either (BS.ByteString, BS.ByteString) (BS.ByteString, BS.ByteString) b85_decode_part bs = U.unsafePerformIO $ unsafeUseAsCStringLen bs $ \ (inBuf, inLen) -> do let maxOutLen = max 512 $ inLen `div` 5 * 4 outBuf <- mallocBytes maxOutLen alloca $ \ pOutLen -> alloca $ \ pRemBuf -> alloca $ \ pRemLen -> do poke pOutLen (castEnum maxOutLen) r <- c_b85_dec_part (castPtr inBuf) (castEnum inLen) outBuf pOutLen pRemBuf pRemLen outLen <- peek pOutLen newOutBuf <- reallocBytes outBuf (castEnum outLen) remBuf <- peek pRemBuf remLen <- peek pRemLen remBs <- BS.packCStringLen (castPtr remBuf, castEnum remLen) outBs <- unsafePackCStringFinalizer newOutBuf (castEnum outLen) (free newOutBuf) if r == 0 then return $ Right (outBs, remBs) else return $ Left (outBs, remBs) -- | Decoding function for the final block. -- -- >>> b85_decode_final $ Data.ByteString.Char8.pack "@<)" -- Just "ar" -- >>> b85_decode_final $ Data.ByteString.Char8.pack "" -- Just "" -- >>> b85_decode_final $ Data.ByteString.Char8.pack "AoDTs" -- Nothing b85_decode_final :: BS.ByteString -> Maybe BS.ByteString b85_decode_final bs = U.unsafePerformIO $ unsafeUseAsCStringLen bs $ \ (inBuf, inLen) -> do outBuf <- mallocBytes 4 alloca $ \ pOutLen -> do r <- c_b85_dec_final (castPtr inBuf) (castEnum inLen) outBuf pOutLen if r == 0 then do outLen <- peek pOutLen newOutBuf <- reallocBytes outBuf (castEnum outLen) outBs <- unsafePackCStringFinalizer newOutBuf (castEnum outLen) (free newOutBuf) return $ Just outBs else free outBuf >> return Nothing -- | Convenience function that combines 'b85_encode_part' and -- 'b85_encode_final' to encode a complete string. -- -- >>> encode $ Data.ByteString.Char8.pack "foob" -- "AoDTs" -- >>> encode $ Data.ByteString.Char8.pack "foobar" -- "AoDTs@<)" encode :: BS.ByteString -> BS.ByteString encode bs = let (first, rest) = b85_encode_part bs Just final = b85_encode_final rest in first `BS.append` final -- | Convenience function that combines 'b85_decode_part' and -- 'b85_decode_final' to decode a complete string. -- -- >>> decode $ Data.ByteString.Char8.pack "AoDTs" -- "foob" -- >>> encode $ Data.ByteString.Char8.pack "AoDTs@<)" -- "foobar" decode :: BS.ByteString -> Either (BS.ByteString, BS.ByteString) BS.ByteString decode bs = let iterateDecode bss re = case b85_decode_part re of Right (d, r) -> if BS.null d then Right (BS.concat (reverse bss), r) else iterateDecode (d : bss) r Left (d, r) -> Left (BS.concat $ reverse $ d : bss, r) handleFinal a@(first, rest) = maybe (Left a) (\ final -> Right (first `BS.append` final)) (b85_decode_final rest) in either Left handleFinal (iterateDecode [] bs) sandi-0.2.3/src/Codec/Binary/Xx.hs0000644000175000001440000001337412200126151016004 0ustar magnususers{-# LANGUAGE ForeignFunctionInterface #-} -- | -- Module: Codec.Binary.Xx -- Copyright: (c) 2012 Magnus Therning -- License: BSD3 -- -- Xxencoding is obsolete but still included for completeness. Further -- information on the encoding can be found at -- . It should be noted that this -- implementation performs no padding. -- -- This encoding is very similar to uuencoding, therefore further information -- regarding the functions can be found in the documentation of -- "Codec.Binary.Uu". module Codec.Binary.Xx ( xx_encode_part , xx_encode_final , xx_decode_part , xx_decode_final , encode , decode ) where import Data.ByteString.Unsafe import Foreign import Foreign.C.Types import System.IO.Unsafe as U import qualified Data.ByteString as BS castEnum :: (Enum a, Enum b) => a -> b castEnum = toEnum . fromEnum foreign import ccall "static uu.h xx_enc_part" c_xx_enc_part :: Ptr Word8 -> CSize -> Ptr Word8 -> Ptr CSize -> Ptr (Ptr Word8) -> Ptr CSize -> IO () foreign import ccall "static uu.h xx_enc_final" c_xx_enc_final :: Ptr Word8 -> CSize -> Ptr Word8 -> Ptr CSize -> IO CInt foreign import ccall "static uu.h xx_dec_part" c_xx_dec_part :: Ptr Word8 -> CSize -> Ptr Word8 -> Ptr CSize -> Ptr (Ptr Word8) -> Ptr CSize -> IO CInt foreign import ccall "static uu.h xx_dec_final" c_xx_dec_final :: Ptr Word8 -> CSize -> Ptr Word8 -> Ptr CSize -> IO CInt -- | Encoding function. -- -- >>> xx_encode_part $ Data.ByteString.Char8.pack "foo" -- ("Naxj","") -- >>> xx_encode_part $ Data.ByteString.Char8.pack "foob" -- ("Naxj","b") xx_encode_part :: BS.ByteString -> (BS.ByteString, BS.ByteString) xx_encode_part bs = U.unsafePerformIO $ unsafeUseAsCStringLen bs $ \ (inBuf, inLen) -> do let maxOutLen = inLen `div` 3 * 4 outBuf <- mallocBytes maxOutLen alloca $ \ pOutLen -> alloca $ \ pRemBuf -> alloca $ \ pRemLen -> do poke pOutLen (castEnum maxOutLen) c_xx_enc_part (castPtr inBuf) (castEnum inLen) outBuf pOutLen pRemBuf pRemLen outLen <- peek pOutLen remBuf <- peek pRemBuf remLen <- peek pRemLen remBs <- BS.packCStringLen (castPtr remBuf, castEnum remLen) outBs <- unsafePackCStringFinalizer outBuf (castEnum outLen) (free outBuf) return (outBs, remBs) -- | Encoding function for the final block. -- -- >>> xx_encode_final $ Data.ByteString.Char8.pack "r" -- Just "QU" -- >>> xx_encode_final $ Data.ByteString.Char8.pack "foo" -- Nothing xx_encode_final :: BS.ByteString -> Maybe BS.ByteString xx_encode_final bs = U.unsafePerformIO $ unsafeUseAsCStringLen bs $ \ (inBuf, inLen) -> do outBuf <- mallocBytes 4 alloca $ \ pOutLen -> do r <- c_xx_enc_final (castPtr inBuf) (castEnum inLen) outBuf pOutLen if r == 0 then do outLen <- peek pOutLen newOutBuf <- reallocBytes outBuf (castEnum outLen) outBs <- unsafePackCStringFinalizer newOutBuf (castEnum outLen) (free newOutBuf) return $ Just outBs else free outBuf >> return Nothing -- | Decoding function. -- -- >>> xx_decode_part $ Data.ByteString.Char8.pack "Naxj" -- Right ("foo","") -- >>> xx_decode_part $ Data.ByteString.Char8.pack "NaxjMa3" -- Right ("foo","Ma3") -- -- >>> xx_decode_part $ Data.ByteString.Char8.pack "Na j" -- Left ("","Na J") xx_decode_part :: BS.ByteString -> Either (BS.ByteString, BS.ByteString) (BS.ByteString, BS.ByteString) xx_decode_part bs = U.unsafePerformIO $ unsafeUseAsCStringLen bs $ \ (inBuf, inLen) -> do let maxOutLen = inLen `div` 4 * 3 outBuf <- mallocBytes maxOutLen alloca $ \ pOutLen -> alloca $ \ pRemBuf -> alloca $ \ pRemLen -> do poke pOutLen (castEnum maxOutLen) r <- c_xx_dec_part (castPtr inBuf) (castEnum inLen) outBuf pOutLen pRemBuf pRemLen outLen <- peek pOutLen newOutBuf <- reallocBytes outBuf (castEnum outLen) remBuf <- peek pRemBuf remLen <- peek pRemLen remBs <- BS.packCStringLen (castPtr remBuf, castEnum remLen) outBs <- unsafePackCStringFinalizer newOutBuf (castEnum outLen) (free newOutBuf) if r == 0 then return $ Right (outBs, remBs) else return $ Left (outBs, remBs) -- | Decoding function for the final block. -- -- >>> xx_decode_final $ Data.ByteString.Char8.pack "Naw" -- Just "fo" -- >>> xx_decode_final $ Data.ByteString.Char8.pack "" -- Just "" -- >>> xx_decode_final $ Data.ByteString.Char8.pack "Na " -- Nothing -- -- >>> xx_decode_final $ encode $ Data.ByteString.Char8.pack "foo" -- Nothing xx_decode_final :: BS.ByteString -> Maybe BS.ByteString xx_decode_final bs = U.unsafePerformIO $ unsafeUseAsCStringLen bs $ \ (inBuf, inLen) -> do outBuf <- mallocBytes 3 alloca $ \ pOutLen -> do r <- c_xx_dec_final (castPtr inBuf) (castEnum inLen) outBuf pOutLen if r == 0 then do outLen <- peek pOutLen newOutBuf <- reallocBytes outBuf (castEnum outLen) outBs <- unsafePackCStringFinalizer newOutBuf (castEnum outLen) (free newOutBuf) return $ Just outBs else free outBuf >> return Nothing encode :: BS.ByteString -> BS.ByteString encode bs = let (first, rest) = xx_encode_part bs Just final = xx_encode_final rest in first `BS.append` final decode :: BS.ByteString -> Either (BS.ByteString, BS.ByteString) BS.ByteString decode bs = either Left (\ (first, rest) -> maybe (Left (first, rest)) (\ fin -> Right (first `BS.append` fin)) (xx_decode_final rest)) (xx_decode_part bs) sandi-0.2.3/src/Codec/Binary/Base64.hs0000644000175000001440000001624512200126151016431 0ustar magnususers{-# LANGUAGE ForeignFunctionInterface #-} -- | -- Module: Codec.Binary.Base64 -- Copyright: (c) 2012 Magnus Therning -- License: BSD3 -- -- Implemented as specified in RFC 4648 (). -- -- Base64 encoding works by expanding blocks of 3 bytes of data into blocks of -- 4 bytes of data. Finally it also includes a well defined ending of the -- encoded data to make sure the size of the final block of encoded data is 4 -- bytes too. module Codec.Binary.Base64 ( b64_encode_part , b64_encode_final , b64_decode_part , b64_decode_final , encode , decode ) where import Foreign import Foreign.C.Types import qualified Data.ByteString as BS import Data.ByteString.Unsafe import System.IO.Unsafe as U castEnum :: (Enum a, Enum b) => a -> b castEnum = toEnum . fromEnum foreign import ccall "static b64.h b64_enc_part" c_b64_enc_part :: Ptr Word8 -> CSize -> Ptr Word8 -> Ptr CSize -> Ptr (Ptr Word8) -> Ptr CSize -> IO () foreign import ccall "static b64.h b64_enc_final" c_b64_enc_final :: Ptr Word8 -> CSize -> Ptr Word8 -> Ptr CSize -> IO CInt foreign import ccall "static b64.h b64_dec_part" c_b64_dec_part :: Ptr Word8 -> CSize -> Ptr Word8 -> Ptr CSize -> Ptr (Ptr Word8) -> Ptr CSize -> IO CInt foreign import ccall "static b64.h b64_dec_final" c_b64_dec_final :: Ptr Word8 -> CSize -> Ptr Word8 -> Ptr CSize -> IO CInt -- | Encoding function. -- -- This function encodes as large a portion of the input as possible and -- returns the encoded part together with the remaining part. Enough space is -- allocated for the encoding to make sure that the remaining part is less than -- 3 bytes long, which means it can be passed to 'b64_encode_final' as is. -- -- >>> b64_encode_part $ Data.ByteString.Char8.pack "foo" -- ("Zm9v","") -- >>> b64_encode_part $ Data.ByteString.Char8.pack "foob" -- ("Zm9v","b") b64_encode_part :: BS.ByteString -> (BS.ByteString, BS.ByteString) b64_encode_part bs = U.unsafePerformIO $ unsafeUseAsCStringLen bs $ \ (inBuf, inLen) -> do let maxOutLen = inLen `div` 3 * 4 outBuf <- mallocBytes maxOutLen alloca $ \ pOutLen -> alloca $ \ pRemBuf -> alloca $ \ pRemLen -> do poke pOutLen (castEnum maxOutLen) c_b64_enc_part (castPtr inBuf) (castEnum inLen) outBuf pOutLen pRemBuf pRemLen outLen <- peek pOutLen remBuf <- peek pRemBuf remLen <- peek pRemLen remBs <- BS.packCStringLen (castPtr remBuf, castEnum remLen) outBs <- unsafePackCStringFinalizer outBuf (castEnum outLen) (free outBuf) return (outBs, remBs) -- | Encoding function for the final block. -- -- The final block has to have a size less than 3. -- -- >>> b64_encode_final $ Data.ByteString.Char8.pack "r" -- Just "cg==" -- -- Trying to pass in too large a block result in failure: -- -- >>> b64_encode_final $ Data.ByteString.Char8.pack "foo" -- Nothing b64_encode_final :: BS.ByteString -> Maybe BS.ByteString b64_encode_final bs = U.unsafePerformIO $ unsafeUseAsCStringLen bs $ \ (inBuf, inLen) -> do outBuf <- mallocBytes 4 alloca $ \ pOutLen -> do r <- c_b64_enc_final (castPtr inBuf) (castEnum inLen) outBuf pOutLen if r == 0 then do outLen <- peek pOutLen newOutBuf <- reallocBytes outBuf (castEnum outLen) outBs <- unsafePackCStringFinalizer newOutBuf (castEnum outLen) (free newOutBuf) return $ Just outBs else free outBuf >> return Nothing -- | Decoding function. -- -- Decode as large a portion of the input as possible. Enough data is -- allocated for the output to ensure that the remainder is less than 4 bytes -- in size. Success result in a @Right@ value: -- -- >>> b64_decode_part $ Data.ByteString.Char8.pack "Zm9v" -- Right ("foo","") -- >>> b64_decode_part $ Data.ByteString.Char8.pack "Zm9vYmE=" -- Right ("foo","YmE=") -- -- Failures occur on bad input and result in a @Left@ value: -- -- >>> b64_decode_part $ Data.ByteString.Char8.pack "Z=9v" -- Left ("","Z=9v") b64_decode_part :: BS.ByteString -> Either (BS.ByteString, BS.ByteString) (BS.ByteString, BS.ByteString) b64_decode_part bs = U.unsafePerformIO $ unsafeUseAsCStringLen bs $ \ (inBuf, inLen) -> do let maxOutLen = inLen `div` 4 * 3 outBuf <- mallocBytes maxOutLen alloca $ \ pOutLen -> alloca $ \ pRemBuf -> alloca $ \ pRemLen -> do poke pOutLen (castEnum maxOutLen) r <- c_b64_dec_part (castPtr inBuf) (castEnum inLen) outBuf pOutLen pRemBuf pRemLen outLen <- peek pOutLen newOutBuf <- reallocBytes outBuf (castEnum outLen) remBuf <- peek pRemBuf remLen <- peek pRemLen remBs <- BS.packCStringLen (castPtr remBuf, castEnum remLen) outBs <- unsafePackCStringFinalizer newOutBuf (castEnum outLen) (free newOutBuf) if r == 0 then return $ Right (outBs, remBs) else return $ Left (outBs, remBs) -- | Decoding function for the final block. -- -- The final block has to have a size of 0 or 4: -- -- >>> b64_decode_final $ Data.ByteString.Char8.pack "Zm8=" -- Just "fo" -- >>> b64_decode_final $ Data.ByteString.Char8.pack "" -- Just "" -- >>> b64_decode_final $ Data.ByteString.Char8.pack "Zm=" -- Nothing -- -- But it must be the encoding of a block that is less than 3 bytes: -- -- >>> b64_decode_final $ encode $ Data.ByteString.Char8.pack "foo" -- Nothing b64_decode_final :: BS.ByteString -> Maybe BS.ByteString b64_decode_final bs = U.unsafePerformIO $ unsafeUseAsCStringLen bs $ \ (inBuf, inLen) -> do outBuf <- mallocBytes 3 alloca $ \ pOutLen -> do r <- c_b64_dec_final (castPtr inBuf) (castEnum inLen) outBuf pOutLen if r == 0 then do outLen <- peek pOutLen newOutBuf <- reallocBytes outBuf (castEnum outLen) outBs <- unsafePackCStringFinalizer newOutBuf (castEnum outLen) (free newOutBuf) return $ Just outBs else free outBuf >> return Nothing -- | Convenience function that combines 'b64_encode_part' and -- 'b64_encode_final' to encode a complete string. -- -- >>> encode $ Data.ByteString.Char8.pack "foo" -- "Zm9v" -- >>> encode $ Data.ByteString.Char8.pack "foobar" -- "Zm9vYmFy" encode :: BS.ByteString -> BS.ByteString encode bs = let (first, rest) = b64_encode_part bs Just final = b64_encode_final rest in first `BS.append` final -- | Convenience function that combines 'b64_decode_part' and -- 'b64_decode_final' to decode a complete string. -- -- >>> decode $ Data.ByteString.Char8.pack "Zm9v" -- Right "foo" -- >>> decode $ Data.ByteString.Char8.pack "Zm9vYmFy" -- Right "foobar" -- -- Failures when decoding returns the decoded part and the remainder: -- -- >>> decode $ Data.ByteString.Char8.pack "Zm9vYm=y" -- Left ("foo","Ym=y") decode :: BS.ByteString -> Either (BS.ByteString, BS.ByteString) BS.ByteString decode bs = either Left (\ (first, rest) -> maybe (Left (first, rest)) (\ fin -> Right (first `BS.append` fin)) (b64_decode_final rest)) (b64_decode_part bs) sandi-0.2.3/src/Codec/Binary/Base32Hex.hs0000644000175000001440000001514312200126151017065 0ustar magnususers{-# LANGUAGE ForeignFunctionInterface #-} -- | -- Module : Codec.Binary.Base32Hex -- Copyright : (c) 2012 Magnus Therning -- License : BSD3 -- -- Implemented as specified in RFC 4648 (). -- -- This encoding is closely related to base 32 and so is its implementation, so -- please refer to "Codec.Binary.Base32" for further details. module Codec.Binary.Base32Hex ( b32h_encode_part , b32h_encode_final , b32h_decode_part , b32h_decode_final , encode , decode ) where import Foreign import Foreign.C.Types import qualified Data.ByteString as BS import Data.ByteString.Unsafe import System.IO.Unsafe as U castEnum :: (Enum a, Enum b) => a -> b castEnum = toEnum . fromEnum foreign import ccall "static b32.h b32h_enc_part" c_b32h_enc_part :: Ptr Word8 -> CSize -> Ptr Word8 -> Ptr CSize -> Ptr (Ptr Word8) -> Ptr CSize -> IO () foreign import ccall "static b32.h b32h_enc_final" c_b32h_enc_final :: Ptr Word8 -> CSize -> Ptr Word8 -> Ptr CSize -> IO CInt foreign import ccall "static b32.h b32h_dec_part" c_b32h_dec_part :: Ptr Word8 -> CSize -> Ptr Word8 -> Ptr CSize -> Ptr (Ptr Word8) -> Ptr CSize -> IO CInt foreign import ccall "static b32.h b32h_dec_final" c_b32h_dec_final :: Ptr Word8 -> CSize -> Ptr Word8 -> Ptr CSize -> IO CInt -- | Encoding function. -- -- See 'Codec.Binary.Base32.b32_encode_part'. -- -- >>> b32h_encode_part $ Data.ByteString.Char8.pack "fooba" -- ("CPNMUOJ1","") -- >>> b32h_encode_part $ Data.ByteString.Char8.pack "foobar" -- ("CPNMUOJ1","r") b32h_encode_part :: BS.ByteString -> (BS.ByteString, BS.ByteString) b32h_encode_part bs = U.unsafePerformIO $ unsafeUseAsCStringLen bs $ \ (inBuf, inLen) -> do let maxOutLen = inLen `div` 5 * 8 outBuf <- mallocBytes maxOutLen alloca $ \ pOutLen -> alloca $ \ pRemBuf -> alloca $ \ pRemLen -> do poke pOutLen (castEnum maxOutLen) c_b32h_enc_part (castPtr inBuf) (castEnum inLen) outBuf pOutLen pRemBuf pRemLen outLen <- peek pOutLen remBuf <- peek pRemBuf remLen <- peek pRemLen remBs <- BS.packCStringLen (castPtr remBuf, castEnum remLen) outBs <- unsafePackCStringFinalizer outBuf (castEnum outLen) (free outBuf) return (outBs, remBs) -- | Encoding function for the final block. -- -- See 'Codec.Binary.Base32.b32_encode_final'. -- -- >>> b32h_encode_final $ Data.ByteString.Char8.pack "r" -- Just "E8======" -- >>> b32h_encode_final $ Data.ByteString.Char8.pack "fooba" -- Nothing b32h_encode_final :: BS.ByteString -> Maybe BS.ByteString b32h_encode_final bs = U.unsafePerformIO $ unsafeUseAsCStringLen bs $ \ (inBuf, inLen) -> do outBuf <- mallocBytes 8 alloca $ \ pOutLen -> do r <- c_b32h_enc_final (castPtr inBuf) (castEnum inLen) outBuf pOutLen if r == 0 then do outLen <- peek pOutLen newOutBuf <- reallocBytes outBuf (castEnum outLen) outBs <- unsafePackCStringFinalizer newOutBuf (castEnum outLen) (free newOutBuf) return $ Just outBs else free outBuf >> return Nothing -- | Decoding function. -- -- See 'Codec.Binary.Base32.b32_decode_part'. -- -- >>> b32h_decode_part $ Data.ByteString.Char8.pack "CPNMUOJ1" -- Right ("fooba","") -- >>> b32h_decode_part $ Data.ByteString.Char8.pack "CPNMUOJ1E8======" -- Right ("fooba","E8======") -- >>> b32h_decode_part $ Data.ByteString.Char8.pack "C=NMUOJ1" -- Left ("","C=NMUOJ1") b32h_decode_part :: BS.ByteString -> Either (BS.ByteString, BS.ByteString) (BS.ByteString, BS.ByteString) b32h_decode_part bs = U.unsafePerformIO $ unsafeUseAsCStringLen bs $ \ (inBuf, inLen) -> do let maxOutLen = inLen `div` 8 * 5 outBuf <- mallocBytes maxOutLen alloca $ \ pOutLen -> alloca $ \ pRemBuf -> alloca $ \ pRemLen -> do poke pOutLen (castEnum maxOutLen) r <- c_b32h_dec_part (castPtr inBuf) (castEnum inLen) outBuf pOutLen pRemBuf pRemLen outLen <- peek pOutLen newOutBuf <- reallocBytes outBuf (castEnum outLen) remBuf <- peek pRemBuf remLen <- peek pRemLen remBs <- BS.packCStringLen (castPtr remBuf, castEnum remLen) outBs <- unsafePackCStringFinalizer newOutBuf (castEnum outLen) (free newOutBuf) if r == 0 then return $ Right (outBs, remBs) else return $ Left (outBs, remBs) -- | Decoding function for the final block. -- -- See 'Codec.Binary.Base32.b32_decode_final'. -- -- >>> b32h_decode_final $ Data.ByteString.Char8.pack "CPNMUOG=" -- Just "foob" -- >>> b32h_decode_final $ Data.ByteString.Char8.pack "" -- Just "" -- >>> b32h_decode_final $ Data.ByteString.Char8.pack "CPNMUO=" -- Nothing -- >>> b32h_decode_final $ encode $ Data.ByteString.Char8.pack "fooba" -- Nothing b32h_decode_final :: BS.ByteString -> Maybe BS.ByteString b32h_decode_final bs = U.unsafePerformIO $ unsafeUseAsCStringLen bs $ \ (inBuf, inLen) -> do outBuf <- mallocBytes 5 alloca $ \ pOutLen -> do r <- c_b32h_dec_final (castPtr inBuf) (castEnum inLen) outBuf pOutLen if r == 0 then do outLen <- peek pOutLen newOutBuf <- reallocBytes outBuf (castEnum outLen) outBs <- unsafePackCStringFinalizer newOutBuf (castEnum outLen) (free newOutBuf) return $ Just outBs else free outBuf >> return Nothing -- | Convenience function that combines 'b32h_encode_part' and -- 'b32h_encode_final' to encode a complete string. -- -- >>> encode $ Data.ByteString.Char8.pack "fooba" -- "CPNMUOJ1" -- >>> encode $ Data.ByteString.Char8.pack "foobar" -- "CPNMUOJ1E8======" encode :: BS.ByteString -> BS.ByteString encode bs = let (first, rest) = b32h_encode_part bs Just final = b32h_encode_final rest in first `BS.append` final -- | Convenience function that combines 'b32h_decode_part' and -- 'b32h_decode_final' to decode a complete string. -- -- >>> decode $ Data.ByteString.Char8.pack "CPNMUOJ1" -- Right "fooba" -- >>> decode $ Data.ByteString.Char8.pack "CPNMUOJ1E8======" -- Right "foobar" -- -- Failures when decoding returns the decoded part and the remainder: -- -- >>> decode $ Data.ByteString.Char8.pack "CPNMUOJ1=8======" -- Left ("fooba","=8======") decode :: BS.ByteString -> Either (BS.ByteString, BS.ByteString) BS.ByteString decode bs = either Left (\ (first, rest) -> maybe (Left (first, rest)) (\ fin -> Right (first `BS.append` fin)) (b32h_decode_final rest)) (b32h_decode_part bs) sandi-0.2.3/src/Codec/Binary/Base64Url.hs0000644000175000001440000001154112200126151017106 0ustar magnususers{-# LANGUAGE ForeignFunctionInterface #-} -- | -- Module: Codec.Binary.Base64Url -- Copyright: (c) 2012 Magnus Therning -- License: BSD3 -- -- Implemented as specified in RFC 4648 (). -- -- The difference compared to vanilla Base64 encoding is just in two -- characters. In Base64 the characters @/+@ are used, and in Base64Url they -- are replaced by @_-@ respectively. -- -- Please refer to "Codec.Binary.Base64" for the details of all functions in -- this module. module Codec.Binary.Base64Url ( b64u_encode_part , b64u_encode_final , b64u_decode_part , b64u_decode_final , encode , decode ) where import Foreign import Foreign.C.Types import qualified Data.ByteString as BS import Data.ByteString.Unsafe import System.IO.Unsafe as U castEnum :: (Enum a, Enum b) => a -> b castEnum = toEnum . fromEnum foreign import ccall "static b64.h b64u_enc_part" c_b64u_enc_part :: Ptr Word8 -> CSize -> Ptr Word8 -> Ptr CSize -> Ptr (Ptr Word8) -> Ptr CSize -> IO () foreign import ccall "static b64.h b64u_enc_final" c_b64u_enc_final :: Ptr Word8 -> CSize -> Ptr Word8 -> Ptr CSize -> IO CInt foreign import ccall "static b64.h b64u_dec_part" c_b64u_dec_part :: Ptr Word8 -> CSize -> Ptr Word8 -> Ptr CSize -> Ptr (Ptr Word8) -> Ptr CSize -> IO CInt foreign import ccall "static b64.h b64u_dec_final" c_b64u_dec_final :: Ptr Word8 -> CSize -> Ptr Word8 -> Ptr CSize -> IO CInt b64u_encode_part :: BS.ByteString -> (BS.ByteString, BS.ByteString) b64u_encode_part bs = U.unsafePerformIO $ unsafeUseAsCStringLen bs $ \ (inBuf, inLen) -> do let maxOutLen = inLen `div` 3 * 4 outBuf <- mallocBytes maxOutLen alloca $ \ pOutLen -> alloca $ \ pRemBuf -> alloca $ \ pRemLen -> do poke pOutLen (castEnum maxOutLen) c_b64u_enc_part (castPtr inBuf) (castEnum inLen) outBuf pOutLen pRemBuf pRemLen outLen <- peek pOutLen remBuf <- peek pRemBuf remLen <- peek pRemLen remBs <- BS.packCStringLen (castPtr remBuf, castEnum remLen) outBs <- unsafePackCStringFinalizer outBuf (castEnum outLen) (free outBuf) return (outBs, remBs) b64u_encode_final :: BS.ByteString -> Maybe BS.ByteString b64u_encode_final bs = U.unsafePerformIO $ unsafeUseAsCStringLen bs $ \ (inBuf, inLen) -> do outBuf <- mallocBytes 4 alloca $ \ pOutLen -> do r <- c_b64u_enc_final (castPtr inBuf) (castEnum inLen) outBuf pOutLen if r == 0 then do outLen <- peek pOutLen newOutBuf <- reallocBytes outBuf (castEnum outLen) outBs <- unsafePackCStringFinalizer newOutBuf (castEnum outLen) (free newOutBuf) return $ Just outBs else free outBuf >> return Nothing b64u_decode_part :: BS.ByteString -> Either (BS.ByteString, BS.ByteString) (BS.ByteString, BS.ByteString) b64u_decode_part bs = U.unsafePerformIO $ unsafeUseAsCStringLen bs $ \ (inBuf, inLen) -> do let maxOutLen = inLen `div` 4 * 3 outBuf <- mallocBytes maxOutLen alloca $ \ pOutLen -> alloca $ \ pRemBuf -> alloca $ \ pRemLen -> do poke pOutLen (castEnum maxOutLen) r <- c_b64u_dec_part (castPtr inBuf) (castEnum inLen) outBuf pOutLen pRemBuf pRemLen outLen <- peek pOutLen newOutBuf <- reallocBytes outBuf (castEnum outLen) remBuf <- peek pRemBuf remLen <- peek pRemLen remBs <- BS.packCStringLen (castPtr remBuf, castEnum remLen) outBs <- unsafePackCStringFinalizer newOutBuf (castEnum outLen) (free newOutBuf) if r == 0 then return $ Right (outBs, remBs) else return $ Left (outBs, remBs) b64u_decode_final :: BS.ByteString -> Maybe BS.ByteString b64u_decode_final bs = U.unsafePerformIO $ unsafeUseAsCStringLen bs $ \ (inBuf, inLen) -> do outBuf <- mallocBytes 3 alloca $ \ pOutLen -> do r <- c_b64u_dec_final (castPtr inBuf) (castEnum inLen) outBuf pOutLen if r == 0 then do outLen <- peek pOutLen newOutBuf <- reallocBytes outBuf (castEnum outLen) outBs <- unsafePackCStringFinalizer newOutBuf (castEnum outLen) (free newOutBuf) return $ Just outBs else free outBuf >> return Nothing encode :: BS.ByteString -> BS.ByteString encode bs = let (first, rest) = b64u_encode_part bs Just final = b64u_encode_final rest in first `BS.append` final decode :: BS.ByteString -> Either (BS.ByteString, BS.ByteString) BS.ByteString decode bs = either Left (\ (first, rest) -> maybe (Left (first, rest)) (\ fin -> Right (first `BS.append` fin)) (b64u_decode_final rest)) (b64u_decode_part bs) sandi-0.2.3/src/Codec/Binary/Uu.hs0000644000175000001440000001667712200126151016007 0ustar magnususers{-# LANGUAGE ForeignFunctionInterface #-} -- | -- Module: Codec.Binary.Uu -- Copyright: (c) 2012 Magnus Therning -- License: BSD3 -- -- Uuencoding is notoriously badly specified. This implementation aims at -- being compatible with the GNU Sharutils -- (). -- -- Just like Base64 encoding uuencoding expands blocks of 3 bytes into blocks -- of 4 bytes. There is however no well defined ending to a piece of encoded -- data, instead uuencoded data is commonly transferred linewise where each -- line is prepended with the length of the data in the line. -- -- This module currently only deals with the encoding. Chopping the encoded -- data into lines, and unchopping lines into encoded data is left as an -- exercise to the reader. (Patches are welcome.) module Codec.Binary.Uu ( uu_encode_part , uu_encode_final , uu_decode_part , uu_decode_final , encode , decode ) where import Data.ByteString.Unsafe import Foreign import Foreign.C.Types import System.IO.Unsafe as U import qualified Data.ByteString as BS castEnum :: (Enum a, Enum b) => a -> b castEnum = toEnum . fromEnum foreign import ccall "static uu.h uu_enc_part" c_uu_enc_part :: Ptr Word8 -> CSize -> Ptr Word8 -> Ptr CSize -> Ptr (Ptr Word8) -> Ptr CSize -> IO () foreign import ccall "static uu.h uu_enc_final" c_uu_enc_final :: Ptr Word8 -> CSize -> Ptr Word8 -> Ptr CSize -> IO CInt foreign import ccall "static uu.h uu_dec_part" c_uu_dec_part :: Ptr Word8 -> CSize -> Ptr Word8 -> Ptr CSize -> Ptr (Ptr Word8) -> Ptr CSize -> IO CInt foreign import ccall "static uu.h uu_dec_final" c_uu_dec_final :: Ptr Word8 -> CSize -> Ptr Word8 -> Ptr CSize -> IO CInt -- | Encoding function. -- -- This function encodes as large a portion of the input as possible and -- returns the encoded part together with the remaining part. Enough space is -- allocated for the encoding to make sure that the remaining part is less than -- 3 bytes long, which means it can be passed to 'uu_encode_final' as is. -- -- >>> uu_encode_part $ Data.ByteString.Char8.pack "foo" -- ("9F]O","") -- >>> uu_encode_part $ Data.ByteString.Char8.pack "foob" -- ("9F]O","b") uu_encode_part :: BS.ByteString -> (BS.ByteString, BS.ByteString) uu_encode_part bs = U.unsafePerformIO $ unsafeUseAsCStringLen bs $ \ (inBuf, inLen) -> do let maxOutLen = inLen `div` 3 * 4 outBuf <- mallocBytes maxOutLen alloca $ \ pOutLen -> alloca $ \ pRemBuf -> alloca $ \ pRemLen -> do poke pOutLen (castEnum maxOutLen) c_uu_enc_part (castPtr inBuf) (castEnum inLen) outBuf pOutLen pRemBuf pRemLen outLen <- peek pOutLen remBuf <- peek pRemBuf remLen <- peek pRemLen remBs <- BS.packCStringLen (castPtr remBuf, castEnum remLen) outBs <- unsafePackCStringFinalizer outBuf (castEnum outLen) (free outBuf) return (outBs, remBs) -- | Encoding function for the final block. -- -- The final block has to have a size less than 3. -- -- >>> uu_encode_final $ Data.ByteString.Char8.pack "r" -- Just "<@" -- -- Trying to pass in too large a block result in failure: -- -- >>> uu_encode_final $ Data.ByteString.Char8.pack "foo" -- Nothing uu_encode_final :: BS.ByteString -> Maybe BS.ByteString uu_encode_final bs = U.unsafePerformIO $ unsafeUseAsCStringLen bs $ \ (inBuf, inLen) -> do outBuf <- mallocBytes 4 alloca $ \ pOutLen -> do r <- c_uu_enc_final (castPtr inBuf) (castEnum inLen) outBuf pOutLen if r == 0 then do outLen <- peek pOutLen newOutBuf <- reallocBytes outBuf (castEnum outLen) outBs <- unsafePackCStringFinalizer newOutBuf (castEnum outLen) (free newOutBuf) return $ Just outBs else free outBuf >> return Nothing -- | Decoding function. -- -- Decode as large a portion of the input as possible. Enough data is -- allocated for the output to ensure that the remainder is less than 4 bytes -- in size. Success result in a @Right@ value: -- -- >>> uu_decode_part $ Data.ByteString.Char8.pack "9F]O" -- Right ("foo","") -- >>> uu_decode_part $ Data.ByteString.Char8.pack "9F]O8F$" -- Right ("foo","8F$") -- -- Failures occur on bad input and result in a @Left@ value: -- -- >>> uu_decode_part $ Data.ByteString.Char8.pack "9F 0" -- Left ("","9F 0") uu_decode_part :: BS.ByteString -> Either (BS.ByteString, BS.ByteString) (BS.ByteString, BS.ByteString) uu_decode_part bs = U.unsafePerformIO $ unsafeUseAsCStringLen bs $ \ (inBuf, inLen) -> do let maxOutLen = inLen `div` 4 * 3 outBuf <- mallocBytes maxOutLen alloca $ \ pOutLen -> alloca $ \ pRemBuf -> alloca $ \ pRemLen -> do poke pOutLen (castEnum maxOutLen) r <- c_uu_dec_part (castPtr inBuf) (castEnum inLen) outBuf pOutLen pRemBuf pRemLen outLen <- peek pOutLen newOutBuf <- reallocBytes outBuf (castEnum outLen) remBuf <- peek pRemBuf remLen <- peek pRemLen remBs <- BS.packCStringLen (castPtr remBuf, castEnum remLen) outBs <- unsafePackCStringFinalizer newOutBuf (castEnum outLen) (free newOutBuf) if r == 0 then return $ Right (outBs, remBs) else return $ Left (outBs, remBs) -- | Decoding function for the final block. -- -- The final block has to have a size of 0 or 4: -- -- >>> uu_decode_final $ Data.ByteString.Char8.pack "9F\\" -- Just "fo" -- >>> uu_decode_final $ Data.ByteString.Char8.pack "" -- Just "" -- >>> uu_decode_final $ Data.ByteString.Char8.pack "9F¬" -- Nothing -- -- But it must be the encoding of a block that is less than 3 bytes: -- -- >>> uu_decode_final $ encode $ Data.ByteString.Char8.pack "foo" -- Nothing uu_decode_final :: BS.ByteString -> Maybe BS.ByteString uu_decode_final bs = U.unsafePerformIO $ unsafeUseAsCStringLen bs $ \ (inBuf, inLen) -> do outBuf <- mallocBytes 3 alloca $ \ pOutLen -> do r <- c_uu_dec_final (castPtr inBuf) (castEnum inLen) outBuf pOutLen if r == 0 then do outLen <- peek pOutLen newOutBuf <- reallocBytes outBuf (castEnum outLen) outBs <- unsafePackCStringFinalizer newOutBuf (castEnum outLen) (free newOutBuf) return $ Just outBs else free outBuf >> return Nothing -- | Convenience function that combines 'uu_encode_part' and -- 'uu_encode_final' to encode a complete string. -- -- >>> encode $ Data.ByteString.Char8.pack "foo" -- "9F]O" -- >>> encode $ Data.ByteString.Char8.pack "foobar" -- "9F]O8F%R" encode :: BS.ByteString -> BS.ByteString encode bs = let (first, rest) = uu_encode_part bs Just final = uu_encode_final rest in first `BS.append` final -- | Convenience function that combines 'uu_decode_part' and -- 'uu_decode_final' to decode a complete string. -- -- >>> decode $ Data.ByteString.Char8.pack "9F]O" -- Right "foo" -- >>> decode $ Data.ByteString.Char8.pack "9F]O8F%R" -- Right "foobar" -- -- Failures when decoding returns the decoded part and the remainder: -- -- >>> decode $ Data.ByteString.Char8.pack "9F]O8F¬R" -- Left ("foo","8F\172R") decode :: BS.ByteString -> Either (BS.ByteString, BS.ByteString) BS.ByteString decode bs = either Left (\ (first, rest) -> maybe (Left (first, rest)) (\ fin -> Right (first `BS.append` fin)) (uu_decode_final rest)) (uu_decode_part bs) sandi-0.2.3/src/Codec/Binary/Yenc.hs0000644000175000001440000000771312200126151016303 0ustar magnususers{-# LANGUAGE ForeignFunctionInterface #-} -- | -- Module: Codec.Binary.Yenc -- Copyright: (c) 2012 Magnus Therning -- License: BSD3 -- -- Implementation based on the specification found at -- . module Codec.Binary.Yenc ( y_enc , y_dec , encode , decode ) where import qualified Data.ByteString as BS import Foreign import Foreign.C.Types import System.IO.Unsafe as U import qualified Data.ByteString.Unsafe as BSU import Data.List castEnum :: (Enum a, Enum b) => a -> b castEnum = toEnum . fromEnum foreign import ccall "static yenc.h y_enc" c_y_enc :: Ptr Word8 -> CSize -> Ptr Word8 -> Ptr CSize -> Ptr (Ptr Word8) -> Ptr CSize -> IO () foreign import ccall "static yenc.h y_dec" c_y_dec :: Ptr Word8 -> CSize -> Ptr Word8 -> Ptr CSize -> Ptr (Ptr Word8) -> Ptr CSize -> IO CInt -- | Encoding function. -- -- This function allocates enough space to hold 20% more than the size of the -- indata (or at least 512 bytes) and then encodes as much as possible of the -- indata. That means there is a risk that the encoded data won't fit and in -- that case the second part of the pair contains the remainder of the indata. -- -- >>> y_enc $ Data.ByteString.Char8.pack "foobar" -- ("\144\153\153\140\139\156","") -- >>> snd $ y_enc $ Data.ByteString.Char8.pack $ Data.List.take 257 $ repeat '\x13' -- "\DC3" y_enc :: BS.ByteString -> (BS.ByteString, BS.ByteString) y_enc bs = U.unsafePerformIO $ BSU.unsafeUseAsCStringLen bs $ \ (inBuf, inLen) -> do let maxOutLen = max 512 (ceiling $ (toRational inLen) * 1.2) outBuf <- mallocBytes maxOutLen alloca $ \ pOutLen -> alloca $ \ pRemBuf -> alloca $ \ pRemLen -> do poke pOutLen (castEnum maxOutLen) c_y_enc (castPtr inBuf) (castEnum inLen) outBuf pOutLen pRemBuf pRemLen outLen <- peek pOutLen newOutBuf <- reallocBytes outBuf (castEnum outLen) remBuf <- peek pRemBuf remLen <- peek pRemLen remBs <- BS.packCStringLen (castPtr remBuf, castEnum remLen) outBs <- BSU.unsafePackCStringFinalizer newOutBuf (castEnum outLen) (free newOutBuf) return (outBs, remBs) -- | Decoding function. -- -- >>> y_dec $ Data.ByteString.pack [144,153,153,140,139,156] -- Right ("foobar","") -- >>> y_dec $ Data.ByteString.Char8.pack "=}" -- Right ("\DC3","") -- -- A @Left@ value is only ever returned on decoding errors which, due to -- characteristics of the encoding, can never happen. -- -- >>> y_dec $ Data.ByteString.Char8.pack "=" -- Right ("","=") y_dec :: BS.ByteString -> Either (BS.ByteString, BS.ByteString) (BS.ByteString, BS.ByteString) y_dec bs = U.unsafePerformIO $ BSU.unsafeUseAsCStringLen bs $ \ (inBuf, inLen) -> do outBuf <- mallocBytes inLen alloca $ \ pOutLen -> alloca $ \ pRemBuf -> alloca $ \ pRemLen -> do poke pOutLen (castEnum inLen) r <- c_y_dec (castPtr inBuf) (castEnum inLen) outBuf pOutLen pRemBuf pRemLen outLen <- peek pOutLen newOutBuf <- reallocBytes outBuf (castEnum outLen) remBuf <- peek pRemBuf remLen <- peek pRemLen remBs <- BS.packCStringLen (castPtr remBuf, castEnum remLen) outBs <- BSU.unsafePackCStringFinalizer newOutBuf (castEnum outLen) (free newOutBuf) if r == 0 then return $ Right (outBs, remBs) else return $ Left (outBs, remBs) -- | Convenient function that calls 'y_enc' repeatedly until the whole input -- data is encoded. encode :: BS.ByteString -> BS.ByteString encode = BS.concat . takeWhile (not . BS.null) . unfoldr (Just . y_enc) -- | A synonym for 'y_dec'. decode :: BS.ByteString -> Either (BS.ByteString, BS.ByteString) BS.ByteString decode bs = case y_dec bs of Right a@(d, r) -> if BS.null r then Right d else Left a Left a -> Left a sandi-0.2.3/src/Codec/Binary/Base32.hs0000644000175000001440000001641112200126151016417 0ustar magnususers{-# LANGUAGE ForeignFunctionInterface #-} -- | -- Module: Codec.Binary.Base32 -- Copyright: (c) 2012 Magnus Therning -- License: BSD3 -- -- Implemented as specified in RFC 4648 (). -- -- Base32 encoding works by expanding blocks of 5 bytes of data into blocks of -- 8 bytes of data. Finally it also includes a well defined ending of the -- encoded data to make sure the size of the final block of encoded data is 8 -- bytes too. module Codec.Binary.Base32 ( b32_encode_part , b32_encode_final , b32_decode_part , b32_decode_final , encode , decode ) where import Foreign import Foreign.C.Types import qualified Data.ByteString as BS import Data.ByteString.Unsafe import System.IO.Unsafe as U castEnum :: (Enum a, Enum b) => a -> b castEnum = toEnum . fromEnum foreign import ccall "static b32.h b32_enc_part" c_b32_enc_part :: Ptr Word8 -> CSize -> Ptr Word8 -> Ptr CSize -> Ptr (Ptr Word8) -> Ptr CSize -> IO () foreign import ccall "static b32.h b32_enc_final" c_b32_enc_final :: Ptr Word8 -> CSize -> Ptr Word8 -> Ptr CSize -> IO CInt foreign import ccall "static b32.h b32_dec_part" c_b32_dec_part :: Ptr Word8 -> CSize -> Ptr Word8 -> Ptr CSize -> Ptr (Ptr Word8) -> Ptr CSize -> IO CInt foreign import ccall "static b32.h b32_dec_final" c_b32_dec_final :: Ptr Word8 -> CSize -> Ptr Word8 -> Ptr CSize -> IO CInt -- | Encoding function. -- -- This function encodes as large a portion of the input as possible and -- returns the encoded part together with the remaining part. Enough space is -- allocated for the encoding to make sure that the remaining part is less than -- 5 bytes long, which means it can be passed to 'b32_encode_final' as is. -- -- >>> b32_encode_part $ Data.ByteString.Char8.pack "fooba" -- ("MZXW6YTB","") -- >>> b32_encode_part $ Data.ByteString.Char8.pack "foobar" -- ("MZXW6YTB","r") b32_encode_part :: BS.ByteString -> (BS.ByteString, BS.ByteString) b32_encode_part bs = U.unsafePerformIO $ unsafeUseAsCStringLen bs $ \ (inBuf, inLen) -> do let maxOutLen = inLen `div` 5 * 8 outBuf <- mallocBytes maxOutLen alloca $ \ pOutLen -> alloca $ \ pRemBuf -> alloca $ \ pRemLen -> do poke pOutLen (castEnum maxOutLen) c_b32_enc_part (castPtr inBuf) (castEnum inLen) outBuf pOutLen pRemBuf pRemLen outLen <- peek pOutLen remBuf <- peek pRemBuf remLen <- peek pRemLen remBs <- BS.packCStringLen (castPtr remBuf, castEnum remLen) outBs <- unsafePackCStringFinalizer outBuf (castEnum outLen) (free outBuf) return (outBs, remBs) -- | Encoding function for the final block. -- -- The final block has to have a size less than 5. -- -- >>> b32_encode_final $ Data.ByteString.Char8.pack "r" -- Just "OI======" -- -- Trying to pass in too large a block result in failure: -- -- >>> b32_encode_final $ Data.ByteString.Char8.pack "fooba" -- Nothing b32_encode_final :: BS.ByteString -> Maybe BS.ByteString b32_encode_final bs = U.unsafePerformIO $ unsafeUseAsCStringLen bs $ \ (inBuf, inLen) -> do outBuf <- mallocBytes 8 alloca $ \ pOutLen -> do r <- c_b32_enc_final (castPtr inBuf) (castEnum inLen) outBuf pOutLen if r == 0 then do outLen <- peek pOutLen newOutBuf <- reallocBytes outBuf (castEnum outLen) outBs <- unsafePackCStringFinalizer newOutBuf (castEnum outLen) (free newOutBuf) return $ Just outBs else free outBuf >> return Nothing -- | Decoding function. -- -- Decode as large a portion of the input as possible. Enough data is -- allocated for the output to ensure that the remainder is less than 8 bytes -- in size. Success result in a @Right@ value: -- -- >>> b32_decode_part $ Data.ByteString.Char8.pack "MZXW6YTB" -- Right ("fooba","") -- >>> b32_decode_part $ Data.ByteString.Char8.pack "MZXW6YTBOI======" -- Right ("fooba","OI======") -- -- Failures occur on bad input and result in a @Left@ value: -- -- >>> b32_decode_part $ Data.ByteString.Char8.pack "M=XW6YTB" -- Left ("","M=XW6YTB") b32_decode_part :: BS.ByteString -> Either (BS.ByteString, BS.ByteString) (BS.ByteString, BS.ByteString) b32_decode_part bs = U.unsafePerformIO $ unsafeUseAsCStringLen bs $ \ (inBuf, inLen) -> do let maxOutLen = inLen `div` 8 * 5 outBuf <- mallocBytes maxOutLen alloca $ \ pOutLen -> alloca $ \ pRemBuf -> alloca $ \ pRemLen -> do poke pOutLen (castEnum maxOutLen) r <- c_b32_dec_part (castPtr inBuf) (castEnum inLen) outBuf pOutLen pRemBuf pRemLen outLen <- peek pOutLen newOutBuf <- reallocBytes outBuf (castEnum outLen) remBuf <- peek pRemBuf remLen <- peek pRemLen remBs <- BS.packCStringLen (castPtr remBuf, castEnum remLen) outBs <- unsafePackCStringFinalizer newOutBuf (castEnum outLen) (free newOutBuf) if r == 0 then return $ Right (outBs, remBs) else return $ Left (outBs, remBs) -- | Decoding function for the final block. -- -- The final block has to have a size of 0 or 8: -- -- >>> b32_decode_final $ Data.ByteString.Char8.pack "MZXW6YQ=" -- Just "foob" -- >>> b32_decode_final $ Data.ByteString.Char8.pack "" -- Just "" -- >>> b32_decode_final $ Data.ByteString.Char8.pack "MZXW6Y=" -- Nothing -- -- But it must be the encoding of a block that is less than 5 bytes: -- -- >>> b32_decode_final $ encode $ Data.ByteString.Char8.pack "fooba" -- Nothing b32_decode_final :: BS.ByteString -> Maybe BS.ByteString b32_decode_final bs = U.unsafePerformIO $ unsafeUseAsCStringLen bs $ \ (inBuf, inLen) -> do outBuf <- mallocBytes 5 alloca $ \ pOutLen -> do r <- c_b32_dec_final (castPtr inBuf) (castEnum inLen) outBuf pOutLen if r == 0 then do outLen <- peek pOutLen newOutBuf <- reallocBytes outBuf (castEnum outLen) outBs <- unsafePackCStringFinalizer newOutBuf (castEnum outLen) (free newOutBuf) return $ Just outBs else free outBuf >> return Nothing -- | Convenience function that combines 'b32_encode_part' and -- 'b32_encode_final' to encode a complete string. -- -- >>> encode $ Data.ByteString.Char8.pack "fooba" -- "MZXW6YTB" -- >>> encode $ Data.ByteString.Char8.pack "foobar" -- "MZXW6YTBOI======" encode :: BS.ByteString -> BS.ByteString encode bs = let (first, rest) = b32_encode_part bs Just final = b32_encode_final rest in first `BS.append` final -- | Convenience function that combines 'b32_decode_part' and -- 'b32_decode_final' to decode a complete string. -- -- >>> decode $ Data.ByteString.Char8.pack "MZXW6YTB" -- Right "fooba" -- >>> decode $ Data.ByteString.Char8.pack "MZXW6YTBOI======" -- Right "foobar" -- -- Failures when decoding returns the decoded part and the remainder: -- -- >>> decode $ Data.ByteString.Char8.pack "MZXW6YTBOI=0====" -- Left ("fooba","OI=0====") decode :: BS.ByteString -> Either (BS.ByteString, BS.ByteString) BS.ByteString decode bs = either Left (\ (first, rest) -> maybe (Left (first, rest)) (\ fin -> Right (first `BS.append` fin)) (b32_decode_final rest)) (b32_decode_part bs) sandi-0.2.3/src/Codec/Binary/Base16.hs0000644000175000001440000000735712200126151016432 0ustar magnususers{-# LANGUAGE ForeignFunctionInterface #-} -- | -- Module: Codec.Binary.Base16 -- Copyright: (c) 2012 Magnus Therning -- License: BSD3 -- -- Implemention of base 16 encoding (hex encoding) as specified in RFC 4648 -- (). module Codec.Binary.Base16 ( b16_enc , b16_dec , encode , decode ) where import Foreign import Foreign.C.Types import System.IO.Unsafe as U import qualified Data.ByteString as BS import qualified Data.ByteString.Unsafe as BSU castEnum :: (Enum a, Enum b) => a -> b castEnum = toEnum . fromEnum foreign import ccall "static b16.h b16_enc" c_b16_enc :: Ptr Word8 -> CSize -> Ptr Word8 -> Ptr CSize -> Ptr (Ptr Word8) -> Ptr CSize -> IO () foreign import ccall "static b16.h b16_dec" c_b16_dec :: Ptr Word8 -> CSize -> Ptr Word8 -> Ptr CSize -> Ptr (Ptr Word8) -> Ptr CSize -> IO CInt -- | Encoding function. -- -- This function, unlike some other encoding functions in the library, simply -- cannot fail. Double the length of the input string is allocated for the -- encoded data, which is guaranteed to hold the result. -- -- >>> b16_enc $ Data.ByteString.pack [0x00] -- "00" -- -- >>> b16_enc $ Data.ByteString.Char8.pack "foobar" -- "666F6F626172" b16_enc :: BS.ByteString -> BS.ByteString -- ^ The encoded string b16_enc bs = U.unsafePerformIO $ BSU.unsafeUseAsCStringLen bs $ \ (inBuf, inLen) -> do let maxOutLen = inLen * 2 outBuf <- mallocBytes maxOutLen alloca $ \ pOutLen -> alloca $ \ pRemBuf -> alloca $ \ pRemLen -> do poke pOutLen (castEnum maxOutLen) c_b16_enc (castPtr inBuf) (castEnum inLen) outBuf pOutLen pRemBuf pRemLen outLen <- peek pOutLen outBs <- BSU.unsafePackCStringFinalizer outBuf (castEnum outLen) (free outBuf) return outBs -- | Decoding function. -- -- The returned value on success is @Right (\, \)@ (the undecoded part is either a empty or a single byte), and on -- failure it's @Left (\, \)@. Space equal to -- the length of the input string is allocated, which is more than enough to -- hold the decoded data. -- -- >>> b16_dec $ Data.ByteString.Char8.pack "00" -- Right ("\NUL","") -- -- >>> b16_dec $ Data.ByteString.Char8.pack "666F6F626172" -- Right ("foobar","") -- -- >>> b16_dec $ Data.ByteString.Char8.pack "666F6F62617" -- Right ("fooba","7") -- >>> b16_dec $ Data.ByteString.Char8.pack "666F6F62617g" -- Left ("fooba","g") b16_dec :: BS.ByteString -> Either (BS.ByteString, BS.ByteString) (BS.ByteString, BS.ByteString) b16_dec bs = U.unsafePerformIO $ BSU.unsafeUseAsCStringLen bs $ \ (inBuf, inLen) -> do outBuf <- mallocBytes inLen alloca $ \ pOutLen -> alloca $ \ pRemBuf -> alloca $ \ pRemLen -> do poke pOutLen (castEnum inLen) r <- c_b16_dec (castPtr inBuf) (castEnum inLen) outBuf pOutLen pRemBuf pRemLen outLen <- peek pOutLen newOutBuf <- reallocBytes outBuf (castEnum outLen) remBuf <- peek pRemBuf remLen <- peek pRemLen remBs <- BS.packCStringLen (castPtr remBuf, castEnum remLen) outBs <- BSU.unsafePackCStringFinalizer newOutBuf (castEnum outLen) (free newOutBuf) if r == 0 then return $ Right (outBs, remBs) else return $ Left (outBs, remBs) -- | A synonym for 'b16_enc'. encode :: BS.ByteString -> BS.ByteString encode = b16_enc -- | A synonum for 'b16_dec'. decode :: BS.ByteString -> Either (BS.ByteString, BS.ByteString) BS.ByteString decode bs = case b16_dec bs of Right a@(d, r) -> if BS.null r then Right d else Left a Left a -> Left a sandi-0.2.3/src/Codec/Binary/QuotedPrintable.hs0000644000175000001440000001130412200126151020476 0ustar magnususers{-# LANGUAGE ForeignFunctionInterface #-} -- | -- Module: Codec.Binary.QuotedPrintable -- Copyright: (c) 2012 Magnus Therning -- License: BSD3 -- -- Implementation of Quoted-Printable based on RFC 2045 -- (). -- -- This encoding encodes /everything/ that is passed in, it will not try to -- guess the native line ending for your architecture. In other words, if you -- are using this to encode text you need to split it into separate lines -- before encoding. module Codec.Binary.QuotedPrintable ( qp_enc , qp_dec , encode , decode ) where import Data.List import Foreign import Foreign.C.Types import System.IO.Unsafe as U import qualified Data.ByteString as BS import qualified Data.ByteString.Unsafe as BSU castEnum :: (Enum a, Enum b) => a -> b castEnum = toEnum . fromEnum foreign import ccall "static qp.h qp_enc" c_qp_enc :: Ptr Word8 -> CSize -> Ptr Word8 -> Ptr CSize -> Ptr (Ptr Word8) -> Ptr CSize -> IO () foreign import ccall "static qp.h qp_dec" c_qp_dec :: Ptr Word8 -> CSize -> Ptr Word8 -> Ptr CSize -> Ptr (Ptr Word8) -> Ptr CSize -> IO CInt -- | Encoding function. -- -- This function allocates enough space to hold twice the size of the indata -- (or at least 512 bytes) and then encodes as much as possible of the indata. -- That means there is a risk that the encoded data won't fit and in that case -- the second part of the pair contains the remainder of the indata. -- -- >>> qp_enc $ Data.ByteString.Char8.pack "=" -- ("=3D","") -- >>> snd $ qp_enc $ Data.ByteString.Char8.pack $ Data.List.take 171 $ repeat '=' -- "=" qp_enc :: BS.ByteString -> (BS.ByteString, BS.ByteString) qp_enc bs = U.unsafePerformIO $ BSU.unsafeUseAsCStringLen bs $ \ (inBuf, inLen) -> do let maxOutBuf = max 512 (2 * inLen) outBuf <- mallocBytes maxOutBuf alloca $ \ pOutLen -> alloca $ \ pRemBuf -> alloca $ \ pRemLen -> do poke pOutLen (castEnum maxOutBuf) c_qp_enc (castPtr inBuf) (castEnum inLen) outBuf pOutLen pRemBuf pRemLen outLen <- peek pOutLen newOutBuf <- reallocBytes outBuf (castEnum outLen) remBuf <- peek pRemBuf remLen <- peek pRemLen remBs <- BS.packCStringLen (castPtr remBuf, castEnum remLen) outBs <- BSU.unsafePackCStringFinalizer newOutBuf (castEnum outLen) (free newOutBuf) return (outBs, remBs) -- | Decoding function. -- -- >>> qp_dec $ Data.ByteString.Char8.pack "foobar" -- Right "foobar" -- >>> qp_dec $ Data.ByteString.Char8.pack "1=20+=201=20=3D=202" -- Right "1 + 1 = 2" -- -- The input data is allowed to use lowercase letters in the hexadecimal -- representation of an octets value, even though the standard says that only -- uppercase letters may be used: -- -- >>> qp_dec $ Data.ByteString.Char8.pack "=3D" -- Right "=" -- >>> qp_dec $ Data.ByteString.Char8.pack "=3d" -- Right "=" -- -- It also allows the input to encode _all_ octets in the hexadecimal -- representation: -- -- >>> qp_dec $ Data.ByteString.Char8.pack "=20!" -- Right (" !","") -- >>> qp_dec $ Data.ByteString.Char8.pack "=20=21" -- Right (" !","") -- -- A @Left@ value is only ever returned on decoding errors. -- -- >>> qp_dec $ Data.ByteString.Char8.pack "=2" -- Right ("","=2") -- >>> qp_dec $ Data.ByteString.Char8.pack "=2g" -- Left ("","=2g") qp_dec :: BS.ByteString -> Either (BS.ByteString, BS.ByteString) (BS.ByteString, BS.ByteString) qp_dec bs = U.unsafePerformIO $ BSU.unsafeUseAsCStringLen bs $ \ (inBuf, inLen) -> do outBuf <- mallocBytes inLen alloca $ \ pOutLen -> alloca $ \ pRemBuf -> alloca $ \ pRemLen -> do poke pOutLen (castEnum inLen) r <- c_qp_dec (castPtr inBuf) (castEnum inLen) outBuf pOutLen pRemBuf pRemLen outLen <- peek pOutLen newOutBuf <- reallocBytes outBuf (castEnum outLen) remBuf <- peek pRemBuf remLen <- peek pRemLen remBs <- BS.packCStringLen (castPtr remBuf, castEnum remLen) outBs <- BSU.unsafePackCStringFinalizer newOutBuf (castEnum outLen) (free newOutBuf) if r == 0 then return $ Right (outBs, remBs) else return $ Left (outBs, remBs) -- | Convenient function that calls 'qp_enc' repeatedly until the whole input -- data is encoded. encode :: BS.ByteString -> BS.ByteString encode = BS.concat . takeWhile (not . BS.null) . unfoldr (Just . qp_enc) -- | A synonym for 'qp_dec'. decode :: BS.ByteString -> Either (BS.ByteString, BS.ByteString) BS.ByteString decode bs = case qp_dec bs of Right a@(d, r) -> if BS.null r then Right d else Left a Left a -> Left a sandi-0.2.3/src/Data/0000755000175000001440000000000012200126151013451 5ustar magnususerssandi-0.2.3/src/Data/Conduit/0000755000175000001440000000000012200126151015056 5ustar magnususerssandi-0.2.3/src/Data/Conduit/Codec/0000755000175000001440000000000012200126151016073 5ustar magnususerssandi-0.2.3/src/Data/Conduit/Codec/Base85.hs0000644000175000001440000000073212200126151017460 0ustar magnususersmodule Data.Conduit.Codec.Base85 where import qualified Codec.Binary.Base85 as B85 import qualified Data.Conduit.Codec.Util as U import Data.Conduit (Conduit, MonadThrow) import Data.ByteString (ByteString, empty) encode :: (Monad m) => Conduit ByteString m ByteString encode = U.encodeI B85.b85_encode_part B85.b85_encode_final empty decode :: (Monad m, MonadThrow m) => Conduit ByteString m ByteString decode = U.decodeI B85.b85_decode_part B85.b85_decode_final empty sandi-0.2.3/src/Data/Conduit/Codec/Xx.hs0000644000175000001440000000071112200126151017025 0ustar magnususersmodule Data.Conduit.Codec.Xx where import qualified Codec.Binary.Xx as Xx import qualified Data.Conduit.Codec.Util as U import Data.Conduit (Conduit, MonadThrow) import Data.ByteString (ByteString, empty) encode :: (Monad m) => Conduit ByteString m ByteString encode = U.encodeI Xx.xx_encode_part Xx.xx_encode_final empty decode :: (Monad m, MonadThrow m) => Conduit ByteString m ByteString decode = U.decodeI Xx.xx_decode_part Xx.xx_decode_final empty sandi-0.2.3/src/Data/Conduit/Codec/Base64.hs0000644000175000001440000000073212200126151017455 0ustar magnususersmodule Data.Conduit.Codec.Base64 where import qualified Codec.Binary.Base64 as B64 import qualified Data.Conduit.Codec.Util as U import Data.Conduit (Conduit, MonadThrow) import Data.ByteString (ByteString, empty) encode :: (Monad m) => Conduit ByteString m ByteString encode = U.encodeI B64.b64_encode_part B64.b64_encode_final empty decode :: (Monad m, MonadThrow m) => Conduit ByteString m ByteString decode = U.decodeI B64.b64_decode_part B64.b64_decode_final empty sandi-0.2.3/src/Data/Conduit/Codec/Base32Hex.hs0000644000175000001440000000075112200126151020116 0ustar magnususersmodule Data.Conduit.Codec.Base32Hex where import qualified Codec.Binary.Base32Hex as B32H import qualified Data.Conduit.Codec.Util as U import Data.Conduit (Conduit, MonadThrow) import Data.ByteString (ByteString, empty) encode :: (Monad m) => Conduit ByteString m ByteString encode = U.encodeI B32H.b32h_encode_part B32H.b32h_encode_final empty decode :: (Monad m, MonadThrow m) => Conduit ByteString m ByteString decode = U.decodeI B32H.b32h_decode_part B32H.b32h_decode_final empty sandi-0.2.3/src/Data/Conduit/Codec/Base64Url.hs0000644000175000001440000000075112200126151020141 0ustar magnususersmodule Data.Conduit.Codec.Base64Url where import qualified Codec.Binary.Base64Url as B64U import qualified Data.Conduit.Codec.Util as U import Data.Conduit (Conduit, MonadThrow) import Data.ByteString (ByteString, empty) encode :: (Monad m) => Conduit ByteString m ByteString encode = U.encodeI B64U.b64u_encode_part B64U.b64u_encode_final empty decode :: (Monad m, MonadThrow m) => Conduit ByteString m ByteString decode = U.decodeI B64U.b64u_decode_part B64U.b64u_decode_final empty sandi-0.2.3/src/Data/Conduit/Codec/Uu.hs0000644000175000001440000000071112200126151017017 0ustar magnususersmodule Data.Conduit.Codec.Uu where import qualified Codec.Binary.Uu as Uu import qualified Data.Conduit.Codec.Util as U import Data.Conduit (Conduit, MonadThrow) import Data.ByteString (ByteString, empty) encode :: (Monad m) => Conduit ByteString m ByteString encode = U.encodeI Uu.uu_encode_part Uu.uu_encode_final empty decode :: (Monad m, MonadThrow m) => Conduit ByteString m ByteString decode = U.decodeI Uu.uu_decode_part Uu.uu_decode_final empty sandi-0.2.3/src/Data/Conduit/Codec/Yenc.hs0000644000175000001440000000061712200126151017331 0ustar magnususersmodule Data.Conduit.Codec.Yenc where import qualified Codec.Binary.Yenc as Y import qualified Data.Conduit.Codec.Util as U import Data.Conduit (Conduit, MonadThrow) import Data.ByteString (ByteString, empty) encode :: (Monad m) => Conduit ByteString m ByteString encode = U.encodeII Y.encode decode :: (Monad m, MonadThrow m) => Conduit ByteString m ByteString decode = U.decodeII Y.y_dec empty sandi-0.2.3/src/Data/Conduit/Codec/Base32.hs0000644000175000001440000000073212200126151017450 0ustar magnususersmodule Data.Conduit.Codec.Base32 where import qualified Codec.Binary.Base32 as B32 import qualified Data.Conduit.Codec.Util as U import Data.Conduit (Conduit, MonadThrow) import Data.ByteString (ByteString, empty) encode :: (Monad m) => Conduit ByteString m ByteString encode = U.encodeI B32.b32_encode_part B32.b32_encode_final empty decode :: (Monad m, MonadThrow m) => Conduit ByteString m ByteString decode = U.decodeI B32.b32_decode_part B32.b32_decode_final empty sandi-0.2.3/src/Data/Conduit/Codec/Base16.hs0000644000175000001440000000056712200126151017460 0ustar magnususersmodule Data.Conduit.Codec.Base16 where import qualified Codec.Binary.Base16 as B16 import qualified Data.Conduit.Codec.Util as U import Data.Conduit import Data.ByteString as BS encode :: (Monad m) => Conduit ByteString m ByteString encode = U.encodeII B16.encode decode :: (Monad m, MonadThrow m) => Conduit ByteString m ByteString decode = U.decodeII B16.b16_dec empty sandi-0.2.3/src/Data/Conduit/Codec/QuotedPrintable.hs0000644000175000001440000000060512200126151021532 0ustar magnususersmodule Data.Conduit.Codec.QuotedPrintable where import qualified Codec.Binary.QuotedPrintable as Qp import qualified Data.Conduit.Codec.Util as U import Data.Conduit import Data.ByteString as BS encode :: (Monad m) => Conduit ByteString m ByteString encode = U.encodeII Qp.encode decode :: (Monad m, MonadThrow m) => Conduit ByteString m ByteString decode = U.decodeII Qp.qp_dec empty sandi-0.2.3/src/Data/Conduit/Codec/Util.hs0000644000175000001440000000522212200126151017345 0ustar magnususers{-# OPTIONS_GHC -XDeriveDataTypeable #-} module Data.Conduit.Codec.Util ( CodecDecodeException(..) , encodeI , decodeI , decodeII , encodeII ) where import Data.Typeable (Typeable) import Control.Exception (Exception) import Data.ByteString as BS (ByteString, append, null) import Data.Conduit (Conduit, MonadThrow, await, monadThrow, yield) import Data.Maybe (fromJust) import Control.Monad (unless) type EncFunc = ByteString -> ByteString type EncFuncPart = ByteString -> (ByteString, ByteString) type EncFuncFinal = ByteString -> Maybe ByteString type DecFunc = ByteString -> Either (ByteString, ByteString) (ByteString, ByteString) type DecFuncFinal = ByteString -> Maybe ByteString data CodecDecodeException = CodecDecodeException ByteString deriving (Typeable, Show) instance Exception CodecDecodeException encodeI :: (Monad m) => EncFuncPart -> EncFuncFinal -> ByteString -> Conduit ByteString m ByteString encodeI enc_part enc_final i = do clear <- await case clear of Nothing -> (yield $ fromJust $ enc_final i) >> return () Just s -> let (a, b) = enc_part (i `append` s) in do unless (BS.null a) $ yield a encodeI enc_part enc_final b decodeI :: (Monad m, MonadThrow m) => DecFunc -> DecFuncFinal -> ByteString -> Conduit ByteString m ByteString decodeI dec_part dec_final i = do enc <- await case enc of Nothing -> case dec_final i of Nothing -> monadThrow (CodecDecodeException i) Just s -> yield s >> return () Just s -> case dec_part (i `append` s) of Left (a, b) -> do unless (BS.null a) $ yield a monadThrow (CodecDecodeException b) Right (a, b) -> do unless (BS.null a) $ yield a decodeI dec_part dec_final b encodeII :: (Monad m) => EncFunc -> Conduit ByteString m ByteString encodeII enc = do clear <- await case clear of Nothing -> return () Just s -> do yield $ enc s encodeII enc decodeII :: (Monad m, MonadThrow m) => DecFunc -> ByteString -> Conduit ByteString m ByteString decodeII dec i = do enc <- await case enc of Nothing -> if BS.null i then return () else monadThrow $ CodecDecodeException i Just s -> case (dec $ i `append` s) of Left (c, b) -> do unless (BS.null c) $ yield c monadThrow $ CodecDecodeException b Right (c, r) -> do unless (BS.null c) $ yield c decodeII dec r sandi-0.2.3/test-src/0000755000175000001440000000000012200126151013555 5ustar magnususerssandi-0.2.3/test-src/Codec/0000755000175000001440000000000012200126151014572 5ustar magnususerssandi-0.2.3/test-src/Codec/Binary/0000755000175000001440000000000012200126151016016 5ustar magnususerssandi-0.2.3/test-src/Codec/Binary/Base85Test.hs0000644000175000001440000000417412200126151020247 0ustar magnususers{-# OPTIONS_GHC -XTemplateHaskell #-} -- Copyright: (c) Magnus Therning, 2013 -- License: BSD3, found in the LICENSE file module Codec.Binary.Base85Test where import Codec.TestUtils import qualified Codec.Binary.Base85 as B85 import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as BSC import Test.HUnit import Test.Framework (Test) import Test.Framework.TH import Test.Framework.Providers.HUnit import Test.Framework.Providers.QuickCheck2 import Data.Word (Word8) case_enc_foobar :: IO () case_enc_foobar = do BS.empty @=? B85.encode BS.empty BSC.pack "Ac" @=? B85.encode (BSC.pack "f") BSC.pack "Ao@" @=? B85.encode (BSC.pack "fo") BSC.pack "AoDS" @=? B85.encode (BSC.pack "foo") BSC.pack "AoDTs" @=? B85.encode (BSC.pack "foob") BSC.pack "AoDTs@/" @=? B85.encode (BSC.pack "fooba") BSC.pack "AoDTs@<)" @=? B85.encode (BSC.pack "foobar") case_enc_specials :: IO () case_enc_specials = do -- all zero BSC.pack "z" @=? B85.encode (BS.pack [0,0,0,0]) -- all space BSC.pack "y" @=? B85.encode (BS.pack [32,32,32,32]) -- double special BSC.pack "yz" @=? B85.encode (BS.pack [32,32,32,32,0,0,0,0]) case_dec_foobar :: IO () case_dec_foobar = do -- foobar Right BS.empty @=? B85.decode BS.empty Right (BSC.pack "f") @=? B85.decode (BSC.pack "Ac") Right (BSC.pack "fo") @=? B85.decode (BSC.pack "Ao@") Right (BSC.pack "foo") @=? B85.decode (BSC.pack "AoDS") Right (BSC.pack "foob") @=? B85.decode (BSC.pack "AoDTs") Right (BSC.pack "fooba") @=? B85.decode (BSC.pack "AoDTs@/") Right (BSC.pack "foobar") @=? B85.decode (BSC.pack "AoDTs@<)") case_dec_specials :: IO () case_dec_specials = do -- all zero Right (BS.pack [0,0,0,0]) @=? B85.decode (BSC.pack "z") -- all space Right (BS.pack [32,32,32,32]) @=? B85.decode (BSC.pack "y") -- double special Right (BS.pack [32,32,32,32,0,0,0,0]) @=? B85.decode (BSC.pack "yz") prop_encdec :: [Word8] -> Bool prop_encdec ws = (BS.pack ws) == (fromRight $ B85.decode $ B85.encode $ BS.pack ws) tests :: Test.Framework.Test tests = $(testGroupGenerator) sandi-0.2.3/test-src/Codec/Binary/UuTest.hs0000644000175000001440000000303412200126151017603 0ustar magnususers{-# OPTIONS_GHC -XTemplateHaskell #-} -- Copyright: (c) Magnus Therning, 2013 -- License: BSD3, found in the LICENSE file module Codec.Binary.UuTest where import Codec.TestUtils import qualified Codec.Binary.Uu as Uu import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as BSC import Test.HUnit import Test.Framework (Test) import Test.Framework.TH import Test.Framework.Providers.HUnit import Test.Framework.Providers.QuickCheck2 import Data.Word (Word8) case_enc_foobar :: IO () case_enc_foobar = do BS.empty @=? Uu.encode BS.empty BSC.pack "9@" @=? Uu.encode (BSC.pack "f") BSC.pack "9F\\" @=? Uu.encode (BSC.pack "fo") BSC.pack "9F]O" @=? Uu.encode (BSC.pack "foo") BSC.pack "9F]O8@" @=? Uu.encode (BSC.pack "foob") BSC.pack "9F]O8F$" @=? Uu.encode (BSC.pack "fooba") BSC.pack "9F]O8F%R" @=? Uu.encode (BSC.pack "foobar") case_dec_foobar :: IO () case_dec_foobar = do Right BS.empty @=? Uu.decode BS.empty Right (BSC.pack "f") @=? Uu.decode (BSC.pack "9@") Right (BSC.pack "fo") @=? Uu.decode (BSC.pack "9F\\") Right (BSC.pack "foo") @=? Uu.decode (BSC.pack "9F]O") Right (BSC.pack "foob") @=? Uu.decode (BSC.pack "9F]O8@") Right (BSC.pack "fooba") @=? Uu.decode (BSC.pack "9F]O8F$") Right (BSC.pack "foobar") @=? Uu.decode (BSC.pack "9F]O8F%R") prop_encdec :: [Word8] -> Bool prop_encdec ws = (BS.pack ws) == (fromRight $ Uu.decode $ Uu.encode $ BS.pack ws) tests :: Test.Framework.Test tests = $(testGroupGenerator) sandi-0.2.3/test-src/Codec/Binary/Base32Test.hs0000644000175000001440000000370412200126151020235 0ustar magnususers{-# OPTIONS_GHC -XTemplateHaskell #-} -- Copyright: (c) Magnus Therning, 2013 -- License: BSD3, found in the LICENSE file module Codec.Binary.Base32Test where import Codec.TestUtils import qualified Codec.Binary.Base32 as B32 import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as BSC import Test.HUnit import Test.Framework (Test) import Test.Framework.TH import Test.Framework.Providers.HUnit import Test.Framework.Providers.QuickCheck2 import Data.Word (Word8) case_enc_foobar :: IO () case_enc_foobar = do BSC.empty @=? B32.encode BSC.empty BSC.pack "MY======" @=? B32.encode (BSC.pack "f") BSC.pack "MZXQ====" @=? B32.encode (BSC.pack "fo") BSC.pack "MZXW6===" @=? B32.encode (BSC.pack "foo") BSC.pack "MZXW6YQ=" @=? B32.encode (BSC.pack "foob") BSC.pack "MZXW6YTB" @=? B32.encode (BSC.pack "fooba") BSC.pack "MZXW6YTBOI======" @=? B32.encode (BSC.pack "foobar") case_dec_foobar :: IO () case_dec_foobar = do Right BS.empty @=? B32.decode BS.empty Right (BSC.pack "f") @=? B32.decode (BSC.pack "MY======") Right (BSC.pack "fo") @=? B32.decode (BSC.pack "MZXQ====") Right (BSC.pack "foo") @=? B32.decode (BSC.pack "MZXW6===") Right (BSC.pack "foob") @=? B32.decode (BSC.pack "MZXW6YQ=") Right (BSC.pack "fooba") @=? B32.decode (BSC.pack "MZXW6YTB") Right (BSC.pack "foobar") @=? B32.decode (BSC.pack "MZXW6YTBOI======") case_dec_failures :: IO () case_dec_failures = do -- illegal char Left (BSC.empty, BSC.pack "M=XW6YTB") @=? (B32.b32_decode_part $ BSC.pack "M=XW6YTB") -- full block Nothing @=? (B32.b32_decode_final $ BSC.pack "MZXW6YTB") -- too short Nothing @=? (B32.b32_decode_final $ BSC.pack "MZXW6Y=") prop_encdec :: [Word8] -> Bool prop_encdec ws = (BS.pack ws) == (fromRight $ B32.decode $ B32.encode $ BS.pack ws) tests :: Test.Framework.Test tests = $(testGroupGenerator) sandi-0.2.3/test-src/Codec/Binary/Base64Test.hs0000644000175000001440000000347012200126151020242 0ustar magnususers{-# OPTIONS_GHC -XTemplateHaskell #-} -- Copyright: (c) Magnus Therning, 2013 -- License: BSD3, found in the LICENSE file module Codec.Binary.Base64Test where import Codec.TestUtils import qualified Codec.Binary.Base64 as B64 import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as BSC import Test.HUnit import Test.Framework (Test) import Test.Framework.TH import Test.Framework.Providers.HUnit import Test.Framework.Providers.QuickCheck2 import Data.Word (Word8) case_enc_foobar :: IO () case_enc_foobar = do BSC.empty @=? B64.encode BSC.empty BSC.pack "Zg==" @=? B64.encode (BSC.pack "f") BSC.pack "Zm8=" @=? B64.encode (BSC.pack "fo") BSC.pack "Zm9v" @=? B64.encode (BSC.pack "foo") BSC.pack "Zm9vYg==" @=? B64.encode (BSC.pack "foob") BSC.pack "Zm9vYmE=" @=? B64.encode (BSC.pack "fooba") BSC.pack "Zm9vYmFy" @=? B64.encode (BSC.pack "foobar") case_enc_specials :: IO () case_enc_specials = do -- /++/ BSC.pack "/++/" @=? B64.encode (BS.pack [255,239,191]) case_dec_foobar :: IO () case_dec_foobar = do Right BSC.empty @=? B64.decode BSC.empty Right (BSC.pack "f") @=? B64.decode (BSC.pack "Zg==") Right (BSC.pack "fo") @=? B64.decode (BSC.pack "Zm8=") Right (BSC.pack "foo") @=? B64.decode (BSC.pack "Zm9v") Right (BSC.pack "foob") @=? B64.decode (BSC.pack "Zm9vYg==") Right (BSC.pack "fooba") @=? B64.decode (BSC.pack "Zm9vYmE=") Right (BSC.pack "foobar") @=? B64.decode (BSC.pack "Zm9vYmFy") case_dec_specials :: IO () case_dec_specials = do -- /++/ Right (BS.pack [255,239,191]) @=? B64.decode (BSC.pack "/++/") prop_encdec :: [Word8] -> Bool prop_encdec ws = (BS.pack ws) == (fromRight $ B64.decode $ B64.encode $ BS.pack ws) tests :: Test.Framework.Test tests = $(testGroupGenerator) sandi-0.2.3/test-src/Codec/Binary/Base64UrlTest.hs0000644000175000001440000000352312200126151020724 0ustar magnususers{-# OPTIONS_GHC -XTemplateHaskell #-} -- Copyright: (c) Magnus Therning, 2013 -- License: BSD3, found in the LICENSE file module Codec.Binary.Base64UrlTest where import Codec.TestUtils import qualified Codec.Binary.Base64Url as B64U import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as BSC import Test.HUnit import Test.Framework (Test) import Test.Framework.TH import Test.Framework.Providers.HUnit import Test.Framework.Providers.QuickCheck2 import Data.Word (Word8) case_enc_foobar :: IO () case_enc_foobar = do BSC.empty @=? B64U.encode BSC.empty BSC.pack "Zg==" @=? B64U.encode (BSC.pack "f") BSC.pack "Zm8=" @=? B64U.encode (BSC.pack "fo") BSC.pack "Zm9v" @=? B64U.encode (BSC.pack "foo") BSC.pack "Zm9vYg==" @=? B64U.encode (BSC.pack "foob") BSC.pack "Zm9vYmE=" @=? B64U.encode (BSC.pack "fooba") BSC.pack "Zm9vYmFy" @=? B64U.encode (BSC.pack "foobar") case_enc_specials :: IO () case_enc_specials = do -- _--_ BSC.pack "_--_" @=? (B64U.encode $ BS.pack [255,239,191]) case_dec_foobar :: IO () case_dec_foobar = do Right BSC.empty @=? B64U.decode BSC.empty Right (BSC.pack "f") @=? B64U.decode (BSC.pack "Zg==") Right (BSC.pack "fo") @=? B64U.decode (BSC.pack "Zm8=") Right (BSC.pack "foo") @=? B64U.decode (BSC.pack "Zm9v") Right (BSC.pack "foob") @=? B64U.decode (BSC.pack "Zm9vYg==") Right (BSC.pack "fooba") @=? B64U.decode (BSC.pack "Zm9vYmE=") Right (BSC.pack "foobar") @=? B64U.decode (BSC.pack "Zm9vYmFy") case_dec_specials :: IO () case_dec_specials = do -- _--_ Right (BS.pack [255,239,191]) @=? B64U.decode (BSC.pack "_--_") prop_encdec :: [Word8] -> Bool prop_encdec ws = (BS.pack ws) == (fromRight $ B64U.decode $ B64U.encode $ BS.pack ws) tests :: Test.Framework.Test tests = $(testGroupGenerator) sandi-0.2.3/test-src/Codec/Binary/QuotedPrintableTest.hs0000644000175000001440000000174412200126151022322 0ustar magnususers{-# OPTIONS_GHC -XTemplateHaskell #-} -- Copyright: (c) Magnus Therning, 2013 -- License: BSD3, found in the LICENSE file module Codec.Binary.QuotedPrintableTest where import Codec.TestUtils import qualified Codec.Binary.QuotedPrintable as QP import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as BSC import Test.HUnit import Test.Framework (Test) import Test.Framework.TH import Test.Framework.Providers.HUnit import Test.Framework.Providers.QuickCheck2 import Data.Word (Word8) case_enc_foobar :: IO () case_enc_foobar = do BS.empty @=? QP.encode BS.empty BSC.pack "foobar" @=? QP.encode (BSC.pack "foobar") case_dec_foobar :: IO () case_dec_foobar = do Right BS.empty @=? QP.decode BS.empty Right (BSC.pack "foobar") @=? QP.decode (BSC.pack "foobar") prop_encdec :: [Word8] -> Bool prop_encdec ws = (BS.pack ws) == (fromRight $ QP.decode $ QP.encode $ BS.pack ws) tests :: Test.Framework.Test tests = $(testGroupGenerator) sandi-0.2.3/test-src/Codec/Binary/Base32HexTest.hs0000644000175000001440000000374012200126151020702 0ustar magnususers{-# OPTIONS_GHC -XTemplateHaskell #-} -- Copyright: (c) Magnus Therning, 2013 -- License: BSD3, found in the LICENSE file module Codec.Binary.Base32HexTest where import Codec.TestUtils import qualified Codec.Binary.Base32Hex as B32H import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as BSC import Test.HUnit import Test.Framework (Test) import Test.Framework.TH import Test.Framework.Providers.HUnit import Test.Framework.Providers.QuickCheck2 import Data.Word (Word8) case_enc_foobar :: IO () case_enc_foobar = do BSC.empty @=? B32H.encode BS.empty BSC.pack "CO======" @=? B32H.encode (BSC.pack "f") BSC.pack "CPNG====" @=? B32H.encode (BSC.pack "fo") BSC.pack "CPNMU===" @=? B32H.encode (BSC.pack "foo") BSC.pack "CPNMUOG=" @=? B32H.encode (BSC.pack "foob") BSC.pack "CPNMUOJ1" @=? B32H.encode (BSC.pack "fooba") BSC.pack "CPNMUOJ1E8======" @=? B32H.encode (BSC.pack "foobar") case_dec_foobar :: IO () case_dec_foobar = do Right BS.empty @=? B32H.decode BS.empty Right (BSC.pack "f") @=? B32H.decode (BSC.pack "CO======") Right (BSC.pack "fo") @=? B32H.decode (BSC.pack "CPNG====") Right (BSC.pack "foo") @=? B32H.decode (BSC.pack "CPNMU===") Right (BSC.pack "foob") @=? B32H.decode (BSC.pack "CPNMUOG=") Right (BSC.pack "fooba") @=? B32H.decode (BSC.pack "CPNMUOJ1") Right (BSC.pack "foobar") @=? B32H.decode (BSC.pack "CPNMUOJ1E8======") case_dec_failures :: IO () case_dec_failures = do -- illegal char Left (BS.empty, BSC.pack "C=NMUOJ1") @=? (B32H.b32h_decode_part $ BSC.pack "C=NMUOJ1") -- full block Nothing @=? (B32H.b32h_decode_final $ BSC.pack "CPNMUOJ1") -- too short Nothing @=? (B32H.b32h_decode_final $ BSC.pack "CPNMUO=") prop_encdec :: [Word8] -> Bool prop_encdec ws = (BS.pack ws) == (fromRight $ B32H.decode $ B32H.encode $ BS.pack ws) tests :: Test.Framework.Test tests = $(testGroupGenerator) sandi-0.2.3/test-src/Codec/Binary/XxTest.hs0000644000175000001440000000303312200126151017610 0ustar magnususers{-# OPTIONS_GHC -XTemplateHaskell #-} -- Copyright: (c) Magnus Therning, 2013 -- License: BSD3, found in the LICENSE file module Codec.Binary.XxTest where import Codec.TestUtils import qualified Codec.Binary.Xx as Xx import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as BSC import Test.HUnit import Test.Framework (Test) import Test.Framework.TH import Test.Framework.Providers.HUnit import Test.Framework.Providers.QuickCheck2 import Data.Word (Word8) case_enc_foobar :: IO () case_enc_foobar = do BS.empty @=? Xx.encode BS.empty BSC.pack "NU" @=? Xx.encode (BSC.pack "f") BSC.pack "Naw" @=? Xx.encode (BSC.pack "fo") BSC.pack "Naxj" @=? Xx.encode (BSC.pack "foo") BSC.pack "NaxjMU" @=? Xx.encode (BSC.pack "foob") BSC.pack "NaxjMa2" @=? Xx.encode (BSC.pack "fooba") BSC.pack "NaxjMa3m" @=? Xx.encode (BSC.pack "foobar") case_dec_foobar :: IO () case_dec_foobar = do Right BS.empty @=? Xx.decode BS.empty Right (BSC.pack "f") @=? Xx.decode (BSC.pack "NU") Right (BSC.pack "fo") @=? Xx.decode (BSC.pack "Naw") Right (BSC.pack "foo") @=? Xx.decode (BSC.pack "Naxj") Right (BSC.pack "foob") @=? Xx.decode (BSC.pack "NaxjMU") Right (BSC.pack "fooba") @=? Xx.decode (BSC.pack "NaxjMa2") Right (BSC.pack "foobar") @=? Xx.decode (BSC.pack "NaxjMa3m") prop_encdec :: [Word8] -> Bool prop_encdec ws = (BS.pack ws) == (fromRight $ Xx.decode $ Xx.encode $ BS.pack ws) tests :: Test.Framework.Test tests = $(testGroupGenerator) sandi-0.2.3/test-src/Codec/Binary/Base16Test.hs0000644000175000001440000000347112200126151020240 0ustar magnususers{-# OPTIONS_GHC -XTemplateHaskell #-} -- Copyright: (c) Magnus Therning, 2013 -- License: BSD3, found in the LICENSE file module Codec.Binary.Base16Test where import Codec.TestUtils import qualified Codec.Binary.Base16 as B16 import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as BSC import Test.HUnit import Test.Framework (Test) import Test.Framework.TH import Test.Framework.Providers.HUnit import Test.Framework.Providers.QuickCheck2 import Data.Word (Word8) case_b16_enc_foobar :: IO () case_b16_enc_foobar = do BSC.empty @=? B16.encode BSC.empty BSC.pack "66" @=? B16.encode (BSC.pack "f") BSC.pack "666F" @=? B16.encode (BSC.pack "fo") BSC.pack "666F6F" @=? B16.encode (BSC.pack "foo") BSC.pack "666F6F62" @=? B16.encode (BSC.pack "foob") BSC.pack "666F6F6261" @=? B16.encode (BSC.pack "fooba") BSC.pack "666F6F626172" @=? B16.encode (BSC.pack "foobar") case_b16_dec_foobar :: IO () case_b16_dec_foobar = do Right BS.empty @=? B16.decode BS.empty Right (BSC.pack "f") @=? B16.decode (BSC.pack "66") Right (BSC.pack "fo") @=? B16.decode (BSC.pack "666F") Right (BSC.pack "foo") @=? B16.decode (BSC.pack "666F6F") Right (BSC.pack "foob") @=? B16.decode (BSC.pack "666F6F62") Right (BSC.pack "fooba") @=? B16.decode (BSC.pack "666F6F6261") Right (BSC.pack "foobar") @=? B16.decode (BSC.pack "666F6F626172") case_b16_dec_failure :: IO () case_b16_dec_failure = do -- odd number of input bytes (Left (BSC.pack "fooba", BS.pack [55])) @=? (B16.decode $ BS.pack [54,54,54,70,54,70,54,50,54,49,55]) prop_b16_encdec :: [Word8] -> Bool prop_b16_encdec ws = (BS.pack ws) == (fromRight $ B16.decode $ B16.encode $ BS.pack ws) tests :: Test.Framework.Test tests = $(testGroupGenerator) sandi-0.2.3/test-src/Codec/Binary/YencTest.hs0000644000175000001440000000433012200126151020110 0ustar magnususers{-# OPTIONS_GHC -XTemplateHaskell #-} -- Copyright: (c) Magnus Therning, 2013 -- License: BSD3, found in the LICENSE file module Codec.Binary.YencTest where import Codec.TestUtils import qualified Codec.Binary.Yenc as Y import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as BSC import Test.HUnit import Test.Framework (Test) import Test.Framework.TH import Test.Framework.Providers.HUnit import Test.Framework.Providers.QuickCheck2 import Data.Word (Word8) case_enc_foobar :: IO () case_enc_foobar = do BS.empty @=? Y.encode BS.empty BS.pack [144] @=? Y.encode (BSC.pack "f") BS.pack [144,153] @=? Y.encode (BSC.pack "fo") BS.pack [144,153,153] @=? Y.encode (BSC.pack "foo") BS.pack [144,153,153,140] @=? Y.encode (BSC.pack "foob") BS.pack [144,153,153,140,139] @=? Y.encode (BSC.pack "fooba") BS.pack [144,153,153,140,139,156] @=? Y.encode (BSC.pack "foobar") case_enc_specials :: IO () case_enc_specials = do -- expanded chars BS.pack [61,64] @=? Y.encode (BS.pack [214]) BS.pack [61,74] @=? Y.encode (BS.pack [224]) BS.pack [61,77] @=? Y.encode (BS.pack [227]) BS.pack [61,125] @=? Y.encode (BS.pack [19]) case_dec_foobar :: IO () case_dec_foobar = do Right BS.empty @=? Y.decode BS.empty Right (BSC.pack "f") @=? Y.decode (BS.pack [144]) Right (BSC.pack "fo") @=? Y.decode (BS.pack [144,153]) Right (BSC.pack "foo") @=? Y.decode (BS.pack [144,153,153]) Right (BSC.pack "foob") @=? Y.decode (BS.pack [144,153,153,140]) Right (BSC.pack "fooba") @=? Y.decode (BS.pack [144,153,153,140,139]) Right (BSC.pack "foobar") @=? Y.decode (BS.pack [144,153,153,140,139,156]) case_dec_specials :: IO () case_dec_specials = do -- expanded chars Right (BS.pack [214]) @=? Y.decode (BS.pack [61,64]) Right (BS.pack [224]) @=? Y.decode (BS.pack [61,74]) Right (BS.pack [227]) @=? Y.decode (BS.pack [61,77]) Right (BS.pack [19]) @=? Y.decode (BS.pack [61,125]) prop_encdec :: [Word8] -> Bool prop_encdec ws = (BS.pack ws) == (fromRight $ Y.decode $ Y.encode $ BS.pack ws) tests :: Test.Framework.Test tests = $(testGroupGenerator) sandi-0.2.3/test-src/Codec/TestUtils.hs0000644000175000001440000000021312200126151017062 0ustar magnususers-- Copyright: (c) Magnus Therning, 2013 -- License: BSD3, found in the LICENSE file module Codec.TestUtils where fromRight (Right a) = a sandi-0.2.3/test-src/Main.hs0000644000175000001440000000231012200126151014771 0ustar magnususers{-# OPTIONS_GHC -XTemplateHaskell #-} -- Copyright: (c) Magnus Therning, 2012 -- License: BSD3, found in the LICENSE file module Main where import Test.Framework import Test.Framework.TH -- import Test.Framework.Providers.HUnit -- import Test.Framework.Providers.QuickCheck2 -- import Test.HUnit -- import qualified Data.ByteString as BS -- import qualified Data.ByteString.Char8 as BSC import qualified Codec.Binary.Base16Test as B16Test import qualified Codec.Binary.Base32Test as B32Test import qualified Codec.Binary.Base32HexTest as B32HTest import qualified Codec.Binary.Base64Test as B64Test import qualified Codec.Binary.Base64UrlTest as B64UTest import qualified Codec.Binary.Base85Test as B85Test import qualified Codec.Binary.QuotedPrintableTest as QPTest import qualified Codec.Binary.UuTest as UuTest import qualified Codec.Binary.XxTest as XxTest import qualified Codec.Binary.YencTest as YTest tests :: [Test.Framework.Test] tests = [ $(testGroupGenerator) , B16Test.tests , B32Test.tests , B32HTest.tests , B64Test.tests , B64UTest.tests , B85Test.tests , QPTest.tests , UuTest.tests , XxTest.tests , YTest.tests ] main :: IO () main = defaultMain tests sandi-0.2.3/Setup.hs0000644000175000001440000000144612200126151013452 0ustar magnususers#! /usr/bin/env runhaskell {- Copyright © 2007 Magnus Therning - - This file is part of dataenc. - - Dataenc is free software: you can redistribute it and/or modify it under - the terms of the GNU Lesser General Public License as published by the - Free Software Foundation, either version 3 of the License, or (at your - option) any later version. - - Dataenc is distributed in the hope that it will be useful, but WITHOUT - ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or - FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public - License for more details. - - You should have received a copy of the GNU Lesser General Public License - along with dataenc. If not, see -} import Distribution.Simple main = defaultMain sandi-0.2.3/sandi.cabal0000644000175000001440000000522512200126151014077 0ustar magnususersname: sandi version: 0.2.3 license: BSD3 license-file: LICENSE cabal-version: >= 1.8 build-type: Simple author: Magnus Therning maintainer: magnus@therning.org homepage: http://hackage.haskell.org/package/sandi copyright: Magnus Therning, 2012 category: Codec synopsis: Data encoding library description: Reasonably fast data encoding library. extra-source-files: csrc/*.h source-repository head type: git location: https://github.com/magthe/sandi library hs-source-dirs: src c-sources: csrc/codec.c include-dirs: csrc ghc-options: -Wall cc-options: -Wall -Wextra build-depends: base >=4.5 && < 4.7, bytestring >=0.9 && < 0.11, conduit ==1.0.* exposed-modules: Codec.Binary.Base16 Codec.Binary.Base32 Codec.Binary.Base32Hex Codec.Binary.Base64 Codec.Binary.Base64Url Codec.Binary.Base85 Codec.Binary.QuotedPrintable Codec.Binary.Uu Codec.Binary.Xx Codec.Binary.Yenc Data.Conduit.Codec.Base16 Data.Conduit.Codec.Base32 Data.Conduit.Codec.Base32Hex Data.Conduit.Codec.Base64 Data.Conduit.Codec.Base64Url Data.Conduit.Codec.Base85 Data.Conduit.Codec.QuotedPrintable Data.Conduit.Codec.Uu Data.Conduit.Codec.Xx Data.Conduit.Codec.Yenc other-modules: Data.Conduit.Codec.Util test-suite sandi-tests type: exitcode-stdio-1.0 hs-source-dirs: src, test-src build-depends: sandi, base, bytestring, HUnit, test-framework-quickcheck2, test-framework-hunit, test-framework-th, test-framework main-is: Main.hs other-modules: Codec.Binary.Base16Test Codec.Binary.Base32HexTest Codec.Binary.Base32Test Codec.Binary.Base64Test Codec.Binary.Base64UrlTest Codec.Binary.Base85Test Codec.Binary.QuotedPrintableTest Codec.Binary.UuTest Codec.Binary.XxTest Codec.Binary.YencTest Codec.TestUtils benchmark sandi-bench type: exitcode-stdio-1.0 hs-source-dirs: src, bench-src build-depends: sandi, base, bytestring, criterion main-is: Main.hs other-modules: Codec.Binary.Base16Bench Codec.Binary.Base32Bench Codec.Binary.Base32HexBench Codec.Binary.Base64Bench Codec.Binary.Base64UrlBench Codec.Binary.Base85Bench Codec.Binary.QuotedPrintableBench Codec.Binary.UuBench Codec.Binary.XxBench Codec.Binary.YencBench