sandi-0.5/bench-src/0000755000000000000000000000000013426042666012517 5ustar0000000000000000sandi-0.5/bench-src/Codec/0000755000000000000000000000000013426042666013534 5ustar0000000000000000sandi-0.5/bench-src/Codec/Binary/0000755000000000000000000000000013426042666014760 5ustar0000000000000000sandi-0.5/csrc/0000755000000000000000000000000013426042666011605 5ustar0000000000000000sandi-0.5/src/0000755000000000000000000000000013426042666011442 5ustar0000000000000000sandi-0.5/src/Codec/0000755000000000000000000000000013426042666012457 5ustar0000000000000000sandi-0.5/src/Codec/Binary/0000755000000000000000000000000013426042666013703 5ustar0000000000000000sandi-0.5/src/Data/0000755000000000000000000000000013426042666012313 5ustar0000000000000000sandi-0.5/src/Data/Conduit/0000755000000000000000000000000013426042666013720 5ustar0000000000000000sandi-0.5/src/Data/Conduit/Codec/0000755000000000000000000000000013426042666014735 5ustar0000000000000000sandi-0.5/test-src/0000755000000000000000000000000013426042666012417 5ustar0000000000000000sandi-0.5/test-src/Codec/0000755000000000000000000000000013426042666013434 5ustar0000000000000000sandi-0.5/test-src/Codec/Binary/0000755000000000000000000000000013426042666014660 5ustar0000000000000000sandi-0.5/src/Codec/Binary/Base16.hs0000644000000000000000000000727313426042666015271 0ustar0000000000000000{-# 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 ( b16Enc , b16Dec , 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. -- -- >>> b16Enc $ Data.ByteString.pack [0x00] -- "00" -- -- >>> b16Enc $ Data.ByteString.Char8.pack "foobar" -- "666F6F626172" b16Enc :: BS.ByteString -> BS.ByteString -- ^ The encoded string b16Enc 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 BSU.unsafePackCStringFinalizer outBuf (castEnum outLen) (free outBuf) -- | 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. -- -- >>> b16Dec $ Data.ByteString.Char8.pack "00" -- Right ("\NUL","") -- -- >>> b16Dec $ Data.ByteString.Char8.pack "666F6F626172" -- Right ("foobar","") -- -- >>> b16Dec $ Data.ByteString.Char8.pack "666F6F62617" -- Right ("fooba","7") -- >>> b16Dec $ Data.ByteString.Char8.pack "666F6F62617g" -- Left ("fooba","g") b16Dec :: BS.ByteString -> Either (BS.ByteString, BS.ByteString) (BS.ByteString, BS.ByteString) b16Dec 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 = b16Enc -- | A synonum for 'b16_dec'. decode :: BS.ByteString -> Either (BS.ByteString, BS.ByteString) BS.ByteString decode bs = case b16Dec bs of Right a@(d, r) -> if BS.null r then Right d else Left a Left a -> Left a sandi-0.5/src/Codec/Binary/Base32.hs0000644000000000000000000001632213426042666015262 0ustar0000000000000000{-# 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 ( b32EncodePart , b32EncodeFinal , b32DecodePart , b32DecodeFinal , 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. -- -- >>> b32EncodePart $ Data.ByteString.Char8.pack "fooba" -- ("MZXW6YTB","") -- >>> b32EncodePart $ Data.ByteString.Char8.pack "foobar" -- ("MZXW6YTB","r") b32EncodePart :: BS.ByteString -> (BS.ByteString, BS.ByteString) b32EncodePart 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. -- -- >>> b32EncodeFinal $ Data.ByteString.Char8.pack "r" -- Just "OI======" -- -- Trying to pass in too large a block result in failure: -- -- >>> b32EncodeFinal $ Data.ByteString.Char8.pack "fooba" -- Nothing b32EncodeFinal :: BS.ByteString -> Maybe BS.ByteString b32EncodeFinal 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: -- -- >>> b32DecodePart $ Data.ByteString.Char8.pack "MZXW6YTB" -- Right ("fooba","") -- >>> b32DecodePart $ Data.ByteString.Char8.pack "MZXW6YTBOI======" -- Right ("fooba","OI======") -- -- Failures occur on bad input and result in a @Left@ value: -- -- >>> b32DecodePart $ Data.ByteString.Char8.pack "M=XW6YTB" -- Left ("","M=XW6YTB") b32DecodePart :: BS.ByteString -> Either (BS.ByteString, BS.ByteString) (BS.ByteString, BS.ByteString) b32DecodePart 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: -- -- >>> b32DecodeFinal $ Data.ByteString.Char8.pack "MZXW6YQ=" -- Just "foob" -- >>> b32DecodeFinal $ Data.ByteString.Char8.pack "" -- Just "" -- >>> b32DecodeFinal $ Data.ByteString.Char8.pack "MZXW6Y=" -- Nothing -- -- But it must be the encoding of a block that is less than 5 bytes: -- -- >>> b32DecodeFinal $ encode $ Data.ByteString.Char8.pack "fooba" -- Nothing b32DecodeFinal :: BS.ByteString -> Maybe BS.ByteString b32DecodeFinal 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 = first `BS.append` final where (first, rest) = b32EncodePart bs Just final = b32EncodeFinal rest -- | 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)) (b32DecodeFinal rest)) (b32DecodePart bs) sandi-0.5/src/Codec/Binary/Base32Hex.hs0000644000000000000000000001505413426042666015730 0ustar0000000000000000{-# 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 ( b32hEncodePart , b32hEncodeFinal , b32hDecodePart , b32hDecodeFinal , 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'. -- -- >>> b32hEncodePart $ Data.ByteString.Char8.pack "fooba" -- ("CPNMUOJ1","") -- >>> b32hEncodePart $ Data.ByteString.Char8.pack "foobar" -- ("CPNMUOJ1","r") b32hEncodePart :: BS.ByteString -> (BS.ByteString, BS.ByteString) b32hEncodePart 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'. -- -- >>> b32hEncodeFinal $ Data.ByteString.Char8.pack "r" -- Just "E8======" -- >>> b32hEncodeFinal $ Data.ByteString.Char8.pack "fooba" -- Nothing b32hEncodeFinal :: BS.ByteString -> Maybe BS.ByteString b32hEncodeFinal 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'. -- -- >>> b32hDecodePart $ Data.ByteString.Char8.pack "CPNMUOJ1" -- Right ("fooba","") -- >>> b32hDecodePart $ Data.ByteString.Char8.pack "CPNMUOJ1E8======" -- Right ("fooba","E8======") -- >>> b32hDecodePart $ Data.ByteString.Char8.pack "C=NMUOJ1" -- Left ("","C=NMUOJ1") b32hDecodePart :: BS.ByteString -> Either (BS.ByteString, BS.ByteString) (BS.ByteString, BS.ByteString) b32hDecodePart 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'. -- -- >>> b32hDecodeFinal $ Data.ByteString.Char8.pack "CPNMUOG=" -- Just "foob" -- >>> b32hDecodeFinal $ Data.ByteString.Char8.pack "" -- Just "" -- >>> b32hDecodeFinal $ Data.ByteString.Char8.pack "CPNMUO=" -- Nothing -- >>> b32hDecodeFinal $ encode $ Data.ByteString.Char8.pack "fooba" -- Nothing b32hDecodeFinal :: BS.ByteString -> Maybe BS.ByteString b32hDecodeFinal 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 = first `BS.append` final where (first, rest) = b32hEncodePart bs Just final = b32hEncodeFinal rest -- | 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)) (b32hDecodeFinal rest)) (b32hDecodePart bs) sandi-0.5/src/Codec/Binary/Base64.hs0000644000000000000000000001615613426042666015274 0ustar0000000000000000{-# 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 ( b64EncodePart , b64EncodeFinal , b64DecodePart , b64DecodeFinal , 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. -- -- >>> b64EncodePart $ Data.ByteString.Char8.pack "foo" -- ("Zm9v","") -- >>> b64EncodePart $ Data.ByteString.Char8.pack "foob" -- ("Zm9v","b") b64EncodePart :: BS.ByteString -> (BS.ByteString, BS.ByteString) b64EncodePart 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. -- -- >>> b64EncodeFinal $ Data.ByteString.Char8.pack "r" -- Just "cg==" -- -- Trying to pass in too large a block result in failure: -- -- >>> b64EncodeFinal $ Data.ByteString.Char8.pack "foo" -- Nothing b64EncodeFinal :: BS.ByteString -> Maybe BS.ByteString b64EncodeFinal 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: -- -- >>> b64DecodePart $ Data.ByteString.Char8.pack "Zm9v" -- Right ("foo","") -- >>> b64DecodePart $ Data.ByteString.Char8.pack "Zm9vYmE=" -- Right ("foo","YmE=") -- -- Failures occur on bad input and result in a @Left@ value: -- -- >>> b64DecodePart $ Data.ByteString.Char8.pack "Z=9v" -- Left ("","Z=9v") b64DecodePart :: BS.ByteString -> Either (BS.ByteString, BS.ByteString) (BS.ByteString, BS.ByteString) b64DecodePart 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: -- -- >>> b64DecodeFinal $ Data.ByteString.Char8.pack "Zm8=" -- Just "fo" -- >>> b64DecodeFinal $ Data.ByteString.Char8.pack "" -- Just "" -- >>> b64DecodeFinal $ Data.ByteString.Char8.pack "Zm=" -- Nothing -- -- But it must be the encoding of a block that is less than 3 bytes: -- -- >>> b64DecodeFinal $ encode $ Data.ByteString.Char8.pack "foo" -- Nothing b64DecodeFinal :: BS.ByteString -> Maybe BS.ByteString b64DecodeFinal 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 = first `BS.append` final where (first, rest) = b64EncodePart bs Just final = b64EncodeFinal rest -- | 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)) (b64DecodeFinal rest)) (b64DecodePart bs) sandi-0.5/src/Codec/Binary/Base64Url.hs0000644000000000000000000001150013426042666015743 0ustar0000000000000000{-# 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 ( b64uEncodePart , b64uEncodeFinal , b64uDecodePart , b64uDecodeFinal , 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 b64uEncodePart :: BS.ByteString -> (BS.ByteString, BS.ByteString) b64uEncodePart 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) b64uEncodeFinal :: BS.ByteString -> Maybe BS.ByteString b64uEncodeFinal 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 b64uDecodePart :: BS.ByteString -> Either (BS.ByteString, BS.ByteString) (BS.ByteString, BS.ByteString) b64uDecodePart 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) b64uDecodeFinal :: BS.ByteString -> Maybe BS.ByteString b64uDecodeFinal 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 = first `BS.append` final where (first, rest) = b64uEncodePart bs Just final = b64uEncodeFinal rest 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)) (b64uDecodeFinal rest)) (b64uDecodePart bs) sandi-0.5/src/Codec/Binary/Base85.hs0000644000000000000000000001560613426042666015276 0ustar0000000000000000{-# LANGUAGE ForeignFunctionInterface #-} -- | -- Module: Codec.Binary.Base85 -- Copyright: (c) 2012 Magnus Therning -- License: BSD3 -- -- Implemented as described at . module Codec.Binary.Base85 ( b85EncodePart , b85EncodeFinal , b85DecodePart , b85DecodeFinal , 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. -- -- >>> b85EncodePart $ Data.ByteString.Char8.pack "foobar" -- ("AoDTs","ar") -- -- It supports special handling of both all-zero groups and all-space groups. -- -- >>> b85EncodePart $ Data.ByteString.Char8.pack " " -- ("y", "") -- >>> b85EncodePart $ Data.ByteString.Char8.pack "\0\0\0\0" -- ("z", "") b85EncodePart :: BS.ByteString -> (BS.ByteString, BS.ByteString) b85EncodePart 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. -- -- >>> b85EncodeFinal $ Data.ByteString.Char8.pack "ar" -- Just "@<)" b85EncodeFinal :: BS.ByteString -> Maybe BS.ByteString b85EncodeFinal 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. -- -- >>> b85DecodePart $ Data.ByteString.Char8.pack "AoDTs" -- Right ("foob","") -- >>> b85DecodePart $ Data.ByteString.Char8.pack "AoDTs@<)" -- Right ("foob","@<)") -- >>> b85DecodePart $ 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 $ b85DecodePart $ Data.ByteString.Char8.pack $ Prelude.take 129 $ repeat 'y' -- "y" b85DecodePart :: BS.ByteString -> Either (BS.ByteString, BS.ByteString) (BS.ByteString, BS.ByteString) b85DecodePart 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. -- -- >>> b85DecodeFinal $ Data.ByteString.Char8.pack "@<)" -- Just "ar" -- >>> b85DecodeFinal $ Data.ByteString.Char8.pack "" -- Just "" -- >>> b85DecodeFinal $ Data.ByteString.Char8.pack "AoDTs" -- Nothing b85DecodeFinal :: BS.ByteString -> Maybe BS.ByteString b85DecodeFinal 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 = first `BS.append` final where (first, rest) = b85EncodePart bs Just final = b85EncodeFinal rest -- | 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 = either Left handleFinal (iterateDecode [] bs) where iterateDecode bss re = case b85DecodePart 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)) (b85DecodeFinal rest) sandi-0.5/src/Codec/Binary/QuotedPrintable.hs0000644000000000000000000001413313426042666017343 0ustar0000000000000000{-# LANGUAGE ForeignFunctionInterface #-} -- | -- Module: Codec.Binary.QuotedPrintable -- Copyright: (c) 2012 Magnus Therning -- License: BSD3 -- -- Implementation of Quoted-Printable based on RFC 2045 -- (). module Codec.Binary.QuotedPrintable ( qpEncode , qpEncodeSL , qpDecode , 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 :: Word8 -> 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 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. -- -- 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. -- -- >>> qpEncode $ Data.ByteString.Char8.pack "=" -- ("=3D","") -- >>> snd $ qpEncode $ Data.ByteString.Char8.pack $ Data.List.take 171 $ repeat '=' -- "=" -- -- All space (0x20) and tab (0x9) characters are encoded: -- -- >>> qpEncode $ Data.ByteString.Char8.pack " \t" -- ("=20=09","") -- -- Since the input is supposed to have been split prior to calling this -- function all occurances of CR and LF are encoded. -- -- >>> qpEncode $ Data.ByteString.Char8.pack "\n\r\r\n\n\r" -- ("=0A=0D=0D=0A=0A=0D","") -- -- Soft line breaks are inserted as needed -- -- >>> qpEncode $ Data.ByteString.Char8.pack "=========================" -- ("=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=\r\n=3D","") qpEncode :: BS.ByteString -> (BS.ByteString, BS.ByteString) qpEncode = qpEnc' 1 -- | Single line encoding function. -- -- Like 'qpEncode', but without inserting soft line breaks. qpEncodeSL :: BS.ByteString -> (BS.ByteString, BS.ByteString) qpEncodeSL = qpEnc' 0 qpEnc' :: Word8 -> BS.ByteString -> (BS.ByteString, BS.ByteString) qpEnc' split 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 split (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. -- -- >>> qpDecode $ Data.ByteString.Char8.pack "foobar" -- Right "foobar" -- >>> qpDecode $ 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: -- -- >>> qpDecode $ Data.ByteString.Char8.pack "=3D" -- Right "=" -- >>> qpDecode $ Data.ByteString.Char8.pack "=3d" -- Right "=" -- -- It also allows the input to encode _all_ octets in the hexadecimal -- representation: -- -- >>> qpDecode $ Data.ByteString.Char8.pack "=20!" -- Right (" !","") -- >>> qpDecode $ Data.ByteString.Char8.pack "=20=21" -- Right (" !","") -- -- A @Left@ value is only ever returned on decoding errors. -- -- >>> qpDecode $ Data.ByteString.Char8.pack "=2" -- Right ("","=2") -- >>> qpDecode $ Data.ByteString.Char8.pack "=2g" -- Left ("","=2g") -- -- Per the specification a CRLF pair is left in, but a single CR or LF is an -- error. -- -- >>> qpDecode $ Data.ByteString.Char8.pack "\r\n" -- Right ("\r\n","") -- >>> qpDecode $ Data.ByteString.Char8.pack "\n" -- Left ("","\n") -- >>> qpDecode $ Data.ByteString.Char8.pack "\r" -- Left ("","\r") -- -- the same goes for space and tab characters -- -- >>> qpDecode $ Data.ByteString.Char8.pack " \t" -- Right (" \t","") -- -- The function deals properly with soft line breaks. -- -- >>> qpDecode $ Data.ByteString.Char8.pack " =\r\n" -- Right (" ","") qpDecode :: BS.ByteString -> Either (BS.ByteString, BS.ByteString) (BS.ByteString, BS.ByteString) qpDecode 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 'qpEncode' repeatedly until the whole input -- data is encoded. encode :: BS.ByteString -> BS.ByteString encode = BS.concat . takeWhile (not . BS.null) . unfoldr (Just . qpEncode) -- | A synonym for 'qpDec'. decode :: BS.ByteString -> Either (BS.ByteString, BS.ByteString) BS.ByteString decode = either Left goR . qpDecode where goR a@(d, r) = if BS.null r then Right d else Left a sandi-0.5/src/Codec/Binary/Uu.hs0000644000000000000000000001661013426042666014634 0ustar0000000000000000{-# 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 ( uuEncodePart , uuEncodeFinal , uuDecodePart , uuDecodeFinal , 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. -- -- >>> uuEncodePart $ Data.ByteString.Char8.pack "foo" -- ("9F]O","") -- >>> uuEncodePart $ Data.ByteString.Char8.pack "foob" -- ("9F]O","b") uuEncodePart :: BS.ByteString -> (BS.ByteString, BS.ByteString) uuEncodePart 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. -- -- >>> uuEncodeFinal $ Data.ByteString.Char8.pack "r" -- Just "<@" -- -- Trying to pass in too large a block result in failure: -- -- >>> uuEncodeFinal $ Data.ByteString.Char8.pack "foo" -- Nothing uuEncodeFinal :: BS.ByteString -> Maybe BS.ByteString uuEncodeFinal 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: -- -- >>> uuDecodePart $ Data.ByteString.Char8.pack "9F]O" -- Right ("foo","") -- >>> uuDecodePart $ Data.ByteString.Char8.pack "9F]O8F$" -- Right ("foo","8F$") -- -- Failures occur on bad input and result in a @Left@ value: -- -- >>> uuDecodePart $ Data.ByteString.Char8.pack "9F 0" -- Left ("","9F 0") uuDecodePart :: BS.ByteString -> Either (BS.ByteString, BS.ByteString) (BS.ByteString, BS.ByteString) uuDecodePart 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: -- -- >>> uuDecodeFinal $ Data.ByteString.Char8.pack "9F\\" -- Just "fo" -- >>> uuDecodeFinal $ Data.ByteString.Char8.pack "" -- Just "" -- >>> uuDecodeFinal $ Data.ByteString.Char8.pack "9F¬" -- Nothing -- -- But it must be the encoding of a block that is less than 3 bytes: -- -- >>> uuDecodeFinal $ encode $ Data.ByteString.Char8.pack "foo" -- Nothing uuDecodeFinal :: BS.ByteString -> Maybe BS.ByteString uuDecodeFinal 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 = first `BS.append` final where (first, rest) = uuEncodePart bs Just final = uuEncodeFinal rest -- | 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)) (uuDecodeFinal rest)) (uuDecodePart bs) sandi-0.5/src/Codec/Binary/Xx.hs0000644000000000000000000001330513426042666014640 0ustar0000000000000000{-# 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 ( xxEncodePart , xxEncodeFinal , xxDecodePart , xxDecodeFinal , 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. -- -- >>> xxEncodePart $ Data.ByteString.Char8.pack "foo" -- ("Naxj","") -- >>> xxEncodePart $ Data.ByteString.Char8.pack "foob" -- ("Naxj","b") xxEncodePart :: BS.ByteString -> (BS.ByteString, BS.ByteString) xxEncodePart 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. -- -- >>> xxEncodeFinal $ Data.ByteString.Char8.pack "r" -- Just "QU" -- >>> xxEncodeFinal $ Data.ByteString.Char8.pack "foo" -- Nothing xxEncodeFinal :: BS.ByteString -> Maybe BS.ByteString xxEncodeFinal 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. -- -- >>> xxDecodePart $ Data.ByteString.Char8.pack "Naxj" -- Right ("foo","") -- >>> xxDecodePart $ Data.ByteString.Char8.pack "NaxjMa3" -- Right ("foo","Ma3") -- -- >>> xxDecodePart $ Data.ByteString.Char8.pack "Na j" -- Left ("","Na J") xxDecodePart :: BS.ByteString -> Either (BS.ByteString, BS.ByteString) (BS.ByteString, BS.ByteString) xxDecodePart 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. -- -- >>> xxDecodeFinal $ Data.ByteString.Char8.pack "Naw" -- Just "fo" -- >>> xxDecodeFinal $ Data.ByteString.Char8.pack "" -- Just "" -- >>> xxDecodeFinal $ Data.ByteString.Char8.pack "Na " -- Nothing -- -- >>> xxDecodeFinal $ encode $ Data.ByteString.Char8.pack "foo" -- Nothing xxDecodeFinal :: BS.ByteString -> Maybe BS.ByteString xxDecodeFinal 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 = first `BS.append` final where (first, rest) = xxEncodePart bs Just final = xxEncodeFinal rest 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)) (xxDecodeFinal rest)) (xxDecodePart bs) sandi-0.5/src/Codec/Binary/Yenc.hs0000644000000000000000000000774513426042666015152 0ustar0000000000000000{-# LANGUAGE ForeignFunctionInterface #-} -- | -- Module: Codec.Binary.Yenc -- Copyright: (c) 2012 Magnus Therning -- License: BSD3 -- -- Implementation based on the specification found at -- . module Codec.Binary.Yenc ( yEncode , yDecode , 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. -- -- >>> yEncode $ Data.ByteString.Char8.pack "foobar" -- ("\144\153\153\140\139\156","") -- >>> snd $ yEncode $ Data.ByteString.Char8.pack $ Data.List.take 257 $ repeat '\x13' -- "\DC3" yEncode :: BS.ByteString -> (BS.ByteString, BS.ByteString) yEncode 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. -- -- >>> yDecode $ Data.ByteString.pack [144,153,153,140,139,156] -- Right ("foobar","") -- >>> yDecode $ 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. -- -- >>> yDecode $ Data.ByteString.Char8.pack "=" -- Right ("","=") yDecode :: BS.ByteString -> Either (BS.ByteString, BS.ByteString) (BS.ByteString, BS.ByteString) yDecode 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 . yEncode) -- | A synonym for 'y_dec'. decode :: BS.ByteString -> Either (BS.ByteString, BS.ByteString) BS.ByteString decode bs = case yDecode bs of Right a@(d, r) -> if BS.null r then Right d else Left a Left a -> Left a sandi-0.5/src/Data/Conduit/Codec/Base16.hs0000644000000000000000000000104113426042666016306 0ustar0000000000000000-- | -- Module: Data.Conduit.Codec.Base16 -- Copyright: (c) 2014 Magnus Therning -- License: BSD3 module Data.Conduit.Codec.Base16 where import qualified Codec.Binary.Base16 as B16 import qualified Data.Conduit.Codec.Util as U import Control.Monad.Catch (MonadThrow) import Data.ByteString (ByteString, empty) import Data.Conduit (ConduitT) encode :: (Monad m) => ConduitT ByteString ByteString m () encode = U.encodeII B16.encode decode :: (Monad m, MonadThrow m) => ConduitT ByteString ByteString m () decode = U.decodeII B16.b16Dec empty sandi-0.5/src/Data/Conduit/Codec/Base32.hs0000644000000000000000000000113113426042666016304 0ustar0000000000000000-- | -- Module: Data.Conduit.Codec.Base32 -- Copyright: (c) 2014 Magnus Therning -- License: BSD3 module Data.Conduit.Codec.Base32 where import qualified Codec.Binary.Base32 as B32 import qualified Data.Conduit.Codec.Util as U import Control.Monad.Catch (MonadThrow) import Data.ByteString (ByteString, empty) import Data.Conduit (ConduitT) encode :: (Monad m) => ConduitT ByteString ByteString m () encode = U.encodeI B32.b32EncodePart B32.b32EncodeFinal empty decode :: (Monad m, MonadThrow m) => ConduitT ByteString ByteString m () decode = U.decodeI B32.b32DecodePart B32.b32DecodeFinal empty sandi-0.5/src/Data/Conduit/Codec/Base32Hex.hs0000644000000000000000000000115313426042666016755 0ustar0000000000000000-- | -- Module: Data.Conduit.Codec.Base32Hex -- Copyright: (c) 2014 Magnus Therning -- License: BSD3 module Data.Conduit.Codec.Base32Hex where import qualified Codec.Binary.Base32Hex as B32H import qualified Data.Conduit.Codec.Util as U import Control.Monad.Catch (MonadThrow) import Data.ByteString (ByteString, empty) import Data.Conduit (ConduitT) encode :: (Monad m) => ConduitT ByteString ByteString m () encode = U.encodeI B32H.b32hEncodePart B32H.b32hEncodeFinal empty decode :: (Monad m, MonadThrow m) => ConduitT ByteString ByteString m () decode = U.decodeI B32H.b32hDecodePart B32H.b32hDecodeFinal empty sandi-0.5/src/Data/Conduit/Codec/Base64.hs0000644000000000000000000000113113426042666016311 0ustar0000000000000000-- | -- Module: Data.Conduit.Codec.Base64 -- Copyright: (c) 2014 Magnus Therning -- License: BSD3 module Data.Conduit.Codec.Base64 where import qualified Codec.Binary.Base64 as B64 import qualified Data.Conduit.Codec.Util as U import Control.Monad.Catch (MonadThrow) import Data.ByteString (ByteString, empty) import Data.Conduit (ConduitT) encode :: (Monad m) => ConduitT ByteString ByteString m () encode = U.encodeI B64.b64EncodePart B64.b64EncodeFinal empty decode :: (Monad m, MonadThrow m) => ConduitT ByteString ByteString m () decode = U.decodeI B64.b64DecodePart B64.b64DecodeFinal empty sandi-0.5/src/Data/Conduit/Codec/Base64Url.hs0000644000000000000000000000115313426042666017000 0ustar0000000000000000-- | -- Module: Data.Conduit.Codec.Base64Url -- Copyright: (c) 2014 Magnus Therning -- License: BSD3 module Data.Conduit.Codec.Base64Url where import qualified Codec.Binary.Base64Url as B64U import qualified Data.Conduit.Codec.Util as U import Control.Monad.Catch (MonadThrow) import Data.ByteString (ByteString, empty) import Data.Conduit (ConduitT) encode :: (Monad m) => ConduitT ByteString ByteString m () encode = U.encodeI B64U.b64uEncodePart B64U.b64uEncodeFinal empty decode :: (Monad m, MonadThrow m) => ConduitT ByteString ByteString m () decode = U.decodeI B64U.b64uDecodePart B64U.b64uDecodeFinal empty sandi-0.5/src/Data/Conduit/Codec/Base85.hs0000644000000000000000000000113113426042666016314 0ustar0000000000000000-- | -- Module: Data.Conduit.Codec.Base85 -- Copyright: (c) 2014 Magnus Therning -- License: BSD3 module Data.Conduit.Codec.Base85 where import qualified Codec.Binary.Base85 as B85 import qualified Data.Conduit.Codec.Util as U import Control.Monad.Catch (MonadThrow) import Data.ByteString (ByteString, empty) import Data.Conduit (ConduitT) encode :: (Monad m) => ConduitT ByteString ByteString m () encode = U.encodeI B85.b85EncodePart B85.b85EncodeFinal empty decode :: (Monad m, MonadThrow m) => ConduitT ByteString ByteString m () decode = U.decodeI B85.b85DecodePart B85.b85DecodeFinal empty sandi-0.5/src/Data/Conduit/Codec/QuotedPrintable.hs0000644000000000000000000000107313426042666020374 0ustar0000000000000000-- | -- Module: Data.Conduit.Codec.QuotedPrintable -- Copyright: (c) 2014 Magnus Therning -- License: BSD3 module Data.Conduit.Codec.QuotedPrintable where import qualified Codec.Binary.QuotedPrintable as Qp import qualified Data.Conduit.Codec.Util as U import Control.Monad.Catch (MonadThrow) import Data.ByteString (ByteString, empty) import Data.Conduit (ConduitT) encode :: (Monad m) => ConduitT ByteString ByteString m () encode = U.encodeII Qp.encode decode :: (Monad m, MonadThrow m) => ConduitT ByteString ByteString m () decode = U.decodeII Qp.qpDecode empty sandi-0.5/src/Data/Conduit/Codec/Uu.hs0000644000000000000000000000110413426042666015656 0ustar0000000000000000-- | -- Module: Data.Conduit.Codec.Uu -- Copyright: (c) 2014 Magnus Therning -- License: BSD3 module Data.Conduit.Codec.Uu where import qualified Codec.Binary.Uu as Uu import qualified Data.Conduit.Codec.Util as U import Control.Monad.Catch (MonadThrow) import Data.ByteString (ByteString, empty) import Data.Conduit (ConduitT) encode :: (Monad m) => ConduitT ByteString ByteString m () encode = U.encodeI Uu.uuEncodePart Uu.uuEncodeFinal empty decode :: (Monad m, MonadThrow m) => ConduitT ByteString ByteString m () decode = U.decodeI Uu.uuDecodePart Uu.uuDecodeFinal empty sandi-0.5/src/Data/Conduit/Codec/Xx.hs0000644000000000000000000000110413426042666015664 0ustar0000000000000000-- | -- Module: Data.Conduit.Codec.Xx -- Copyright: (c) 2014 Magnus Therning -- License: BSD3 module Data.Conduit.Codec.Xx where import qualified Codec.Binary.Xx as Xx import qualified Data.Conduit.Codec.Util as U import Control.Monad.Catch (MonadThrow) import Data.ByteString (ByteString, empty) import Data.Conduit (ConduitT) encode :: (Monad m) => ConduitT ByteString ByteString m () encode = U.encodeI Xx.xxEncodePart Xx.xxEncodeFinal empty decode :: (Monad m, MonadThrow m) => ConduitT ByteString ByteString m () decode = U.decodeI Xx.xxDecodePart Xx.xxDecodeFinal empty sandi-0.5/src/Data/Conduit/Codec/Yenc.hs0000644000000000000000000000102613426042666016166 0ustar0000000000000000-- | -- Module: Data.Conduit.Codec.Yenc -- Copyright: (c) 2014 Magnus Therning -- License: BSD3 module Data.Conduit.Codec.Yenc where import qualified Codec.Binary.Yenc as Y import qualified Data.Conduit.Codec.Util as U import Control.Monad.Catch (MonadThrow) import Data.ByteString (ByteString, empty) import Data.Conduit (ConduitT) encode :: (Monad m) => ConduitT ByteString ByteString m () encode = U.encodeII Y.encode decode :: (Monad m, MonadThrow m) => ConduitT ByteString ByteString m () decode = U.decodeII Y.yDecode empty sandi-0.5/src/Data/Conduit/Codec/Util.hs0000644000000000000000000000532713426042666016215 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} -- | -- Module: Data.Conduit.Codec.Util -- Copyright: (c) 2014 Magnus Therning -- License: BSD3 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 (ConduitT, await, yield) import Data.Maybe (fromJust) import Control.Monad (unless, void) import Control.Monad.Catch (MonadThrow, throwM) 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 -> ConduitT ByteString ByteString m () encodeI enc_part enc_final i = do clear <- await case clear of Nothing -> void (yield $ fromJust $ enc_final i) 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 -> ConduitT ByteString ByteString m () decodeI dec_part dec_final i = do enc <- await case enc of Nothing -> case dec_final i of Nothing -> throwM (CodecDecodeException i) Just s -> void (yield s) Just s -> case dec_part (i `append` s) of Left (a, b) -> do unless (BS.null a) $ yield a throwM (CodecDecodeException b) Right (a, b) -> do unless (BS.null a) $ yield a decodeI dec_part dec_final b encodeII :: (Monad m) => EncFunc -> ConduitT ByteString ByteString m () 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 -> ConduitT ByteString ByteString m () decodeII dec i = do enc <- await case enc of Nothing -> unless (BS.null i) (throwM $ CodecDecodeException i) Just s -> case dec $ i `append` s of Left (c, b) -> do unless (BS.null c) $ yield c throwM $ CodecDecodeException b Right (c, r) -> do unless (BS.null c) $ yield c decodeII dec r sandi-0.5/csrc/codec.c0000644000000000000000000015015413426042666013034 0ustar0000000000000000// 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"; #define QP_MAX_CHARS 71 void qp_enc(uint8_t split, 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, l; for(i = 0, *dstlen = 0, l = 0; i < srclen && *dstlen < od; i++, (*dstlen)++, l++) { if(split && (l >= QP_MAX_CHARS) && (*dstlen + 3 < od)) { dst[*dstlen] = '='; dst[*dstlen + 1] = 13; dst[*dstlen + 2] = 10; *dstlen += 3; l = 0; } 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; l += 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((9 == src[i]) || (32 <= 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; } if(13 == src[i + 1] && 10 == src[i + 2]) { i += 2; (*dstlen)--; } else { 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 if(13 == src[i] && i + 1 < srclen && 10 == src[i + 1]) { dst[(*dstlen)++] = src[i++]; dst[*dstlen] = src[i]; } 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.5/test-src/Main.hs0000644000000000000000000000165113426042666013642 0ustar0000000000000000-- Copyright: (c) Magnus Therning, 2012 -- License: BSD3, found in the LICENSE file module Main where import Test.Tasty 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 :: TestTree tests = testGroup "All tests" [ 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.5/test-src/Codec/Binary/Base16Test.hs0000644000000000000000000000334113426042666017076 0ustar0000000000000000{-# LANGUAGE TemplateHaskell #-} -- 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 Data.Word (Word8) import Test.Tasty import Test.Tasty.TH import Test.Tasty.HUnit import Test.Tasty.QuickCheck 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 = -- 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 :: TestTree tests = $(testGroupGenerator) sandi-0.5/test-src/Codec/Binary/Base32HexTest.hs0000644000000000000000000000360313426042666017542 0ustar0000000000000000{-# LANGUAGE TemplateHaskell #-} -- 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 Data.Word (Word8) import Test.Tasty import Test.Tasty.TH import Test.Tasty.HUnit import Test.Tasty.QuickCheck 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.b32hDecodePart (BSC.pack "C=NMUOJ1") -- full block Nothing @=? B32H.b32hDecodeFinal (BSC.pack "CPNMUOJ1") -- too short Nothing @=? B32H.b32hDecodeFinal (BSC.pack "CPNMUO=") prop_encdec :: [Word8] -> Bool prop_encdec ws = BS.pack ws == fromRight (B32H.decode $ B32H.encode $ BS.pack ws) tests :: TestTree tests = $(testGroupGenerator) sandi-0.5/test-src/Codec/Binary/Base32Test.hs0000644000000000000000000000354713426042666017104 0ustar0000000000000000{-# LANGUAGE TemplateHaskell #-} -- 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 Data.Word (Word8) import Test.Tasty import Test.Tasty.TH import Test.Tasty.HUnit import Test.Tasty.QuickCheck 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.b32DecodePart (BSC.pack "M=XW6YTB") -- full block Nothing @=? B32.b32DecodeFinal (BSC.pack "MZXW6YTB") -- too short Nothing @=? B32.b32DecodeFinal (BSC.pack "MZXW6Y=") prop_encdec :: [Word8] -> Bool prop_encdec ws = BS.pack ws == fromRight (B32.decode $ B32.encode $ BS.pack ws) tests :: TestTree tests = $(testGroupGenerator) sandi-0.5/test-src/Codec/Binary/Base64Test.hs0000644000000000000000000000334113426042666017101 0ustar0000000000000000{-# LANGUAGE TemplateHaskell #-} -- 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 Data.Word (Word8) import Test.Tasty import Test.Tasty.TH import Test.Tasty.HUnit import Test.Tasty.QuickCheck 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 = -- /++/ 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 = -- /++/ 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 :: TestTree tests = $(testGroupGenerator) sandi-0.5/test-src/Codec/Binary/Base64UrlTest.hs0000644000000000000000000000337213426042666017570 0ustar0000000000000000{-# LANGUAGE TemplateHaskell #-} -- 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 Data.Word (Word8) import Test.Tasty import Test.Tasty.TH import Test.Tasty.HUnit import Test.Tasty.QuickCheck 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 = -- _--_ 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 = -- _--_ 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 :: TestTree tests = $(testGroupGenerator) sandi-0.5/test-src/Codec/Binary/Base85Test.hs0000644000000000000000000000405313426042666017105 0ustar0000000000000000{-# LANGUAGE TemplateHaskell #-} -- 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 Data.Word (Word8) import Test.Tasty import Test.Tasty.TH import Test.Tasty.HUnit import Test.Tasty.QuickCheck 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 :: TestTree tests = $(testGroupGenerator) sandi-0.5/test-src/Codec/Binary/QuotedPrintableTest.hs0000644000000000000000000000435413426042666021164 0ustar0000000000000000{-# LANGUAGE TemplateHaskell #-} -- Copyright: (c) Magnus Therning, 2013-2015 -- 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 Data.Word (Word8) import Test.Tasty import Test.Tasty.TH import Test.Tasty.HUnit import Test.Tasty.QuickCheck case_enc_foobar :: IO () case_enc_foobar = do BS.empty @=? QP.encode BS.empty BSC.pack "foobar" @=? QP.encode (BSC.pack "foobar") BSC.pack "foo=20bar" @=? QP.encode (BSC.pack "foo bar") BSC.pack "foo=09bar" @=? QP.encode (BSC.pack "foo\tbar") BSC.pack "foo=0Dbar" @=? QP.encode (BSC.pack "foo\rbar") BSC.pack "foo=0Abar" @=? QP.encode (BSC.pack "foo\nbar") case_enc_splitting :: IO () case_enc_splitting = do BSC.pack "=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=\r\n=3D=3D=3D" @=? QP.encode (BSC.pack "===========================") (BSC.pack "=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=\r\n=3D=3D=3D", BSC.pack "") @=? QP.qpEncode (BSC.pack "===========================") (BSC.pack "=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D", BSC.pack "") @=? QP.qpEncodeSL (BSC.pack "===========================") case_dec_foobar :: IO () case_dec_foobar = do Right BS.empty @=? QP.decode BS.empty Right (BSC.pack "foobar") @=? QP.decode (BSC.pack "foobar") Right (BSC.pack "foo bar") @=? QP.decode (BSC.pack "foo bar") Right (BSC.pack "foo bar") @=? QP.decode (BSC.pack "foo=20bar") Right (BSC.pack "foo\tbar") @=? QP.decode (BSC.pack "foo\tbar") Right (BSC.pack "foo\tbar") @=? QP.decode (BSC.pack "foo=09bar") Right (BSC.pack "foo\r\nbar") @=? QP.decode (BSC.pack "foo\r\nbar") Right (BSC.pack "foobar") @=? QP.decode (BSC.pack "foo=\r\nbar") Left (BSC.pack "foo", BSC.pack "\nbar") @=? QP.decode (BSC.pack "foo\nbar") Left (BSC.pack "foo", BSC.pack "\rbar") @=? QP.decode (BSC.pack "foo\rbar") prop_encdec :: [Word8] -> Bool prop_encdec ws = BS.pack ws == fromRight (QP.decode $ QP.encode $ BS.pack ws) tests :: TestTree tests = $(testGroupGenerator) sandi-0.5/test-src/Codec/Binary/UuTest.hs0000644000000000000000000000271313426042666016450 0ustar0000000000000000{-# LANGUAGE TemplateHaskell #-} -- 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 Data.Word (Word8) import Test.Tasty import Test.Tasty.TH import Test.Tasty.HUnit import Test.Tasty.QuickCheck 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 :: TestTree tests = $(testGroupGenerator) sandi-0.5/test-src/Codec/Binary/XxTest.hs0000644000000000000000000000271213426042666016455 0ustar0000000000000000{-# LANGUAGE TemplateHaskell #-} -- 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 Data.Word (Word8) import Test.Tasty import Test.Tasty.TH import Test.Tasty.HUnit import Test.Tasty.QuickCheck 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 :: TestTree tests = $(testGroupGenerator) sandi-0.5/test-src/Codec/Binary/YencTest.hs0000644000000000000000000000420713426042666016755 0ustar0000000000000000{-# LANGUAGE TemplateHaskell #-} -- 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 Data.Word (Word8) import Test.Tasty import Test.Tasty.TH import Test.Tasty.QuickCheck import Test.Tasty.HUnit 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 :: TestTree tests = $(testGroupGenerator) sandi-0.5/test-src/Codec/TestUtils.hs0000644000000000000000000000021313426042666015724 0ustar0000000000000000-- Copyright: (c) Magnus Therning, 2013 -- License: BSD3, found in the LICENSE file module Codec.TestUtils where fromRight (Right a) = a sandi-0.5/bench-src/Main.hs0000644000000000000000000000223213426042666013736 0ustar0000000000000000module 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.5/bench-src/Codec/Binary/Base16Bench.hs0000644000000000000000000000064513426042666017302 0ustar0000000000000000module 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.5/bench-src/Codec/Binary/Base32Bench.hs0000644000000000000000000000064513426042666017300 0ustar0000000000000000module 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.5/bench-src/Codec/Binary/Base32HexBench.hs0000644000000000000000000000067313426042666017746 0ustar0000000000000000module 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.5/bench-src/Codec/Binary/Base64Bench.hs0000644000000000000000000000064513426042666017305 0ustar0000000000000000module 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.5/bench-src/Codec/Binary/Base64UrlBench.hs0000644000000000000000000000067313426042666017771 0ustar0000000000000000module 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.5/bench-src/Codec/Binary/Base85Bench.hs0000644000000000000000000000064513426042666017310 0ustar0000000000000000module 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.5/bench-src/Codec/Binary/QuotedPrintableBench.hs0000644000000000000000000000073313426042666021361 0ustar0000000000000000module 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.5/bench-src/Codec/Binary/UuBench.hs0000644000000000000000000000061113426042666016643 0ustar0000000000000000module 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.5/bench-src/Codec/Binary/XxBench.hs0000644000000000000000000000061113426042666016651 0ustar0000000000000000module 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.5/bench-src/Codec/Binary/YencBench.hs0000644000000000000000000000062513426042666017155 0ustar0000000000000000module 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.5/LICENSE0000644000000000000000000000276113426042666011666 0ustar0000000000000000Copyright (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.5/sandi.cabal0000644000000000000000000000546313426043222012732 0ustar0000000000000000cabal-version: 1.12 -- This file has been generated from package.yaml by hpack version 0.31.1. -- -- see: https://github.com/sol/hpack -- -- hash: 6183f2dd5fde1b5f89e8c5599ef0b4457280d17a3b0126ef21c0f541cc780473 name: sandi version: 0.5 synopsis: Data encoding library description: Reasonably fast data encoding library. category: Codec, Conduit maintainer: Magnus Therning license: BSD3 license-file: LICENSE build-type: Simple extra-source-files: package.yaml csrc/codec.h source-repository head type: git location: https://github.com/magthe/sandi.git flag with-conduit manual: True default: True library 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 other-modules: Paths_sandi hs-source-dirs: src cc-options: -fPIC -Wall -Wextra c-sources: csrc/codec.c build-depends: base <5 , bytestring if flag(with-conduit) exposed-modules: 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 build-depends: conduit , exceptions default-language: Haskell2010 test-suite sandi-tests type: exitcode-stdio-1.0 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 Paths_sandi hs-source-dirs: test-src build-depends: base , bytestring , sandi , tasty , tasty-hunit , tasty-quickcheck , tasty-th default-language: Haskell2010 benchmark sandi-bench type: exitcode-stdio-1.0 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 Paths_sandi hs-source-dirs: bench-src build-depends: base , bytestring , criterion , sandi default-language: Haskell2010 sandi-0.5/package.yaml0000644000000000000000000000264413426043176013135 0ustar0000000000000000name: sandi version: 0.5 synopsis: Data encoding library description: >- Reasonably fast data encoding library. maintainer: Magnus Therning license: BSD3 category: Codec, Conduit extra-source-files: - package.yaml - csrc/*.h git: https://github.com/magthe/sandi.git flags: with-conduit: manual: True default: True library: source-dirs: - src c-sources: - csrc/codec.c cc-options: - -fPIC - -Wall - -Wextra dependencies: - base <5 - bytestring when: - condition: flag(with-conduit) dependencies: - conduit - exceptions exposed-modules: - 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 tests: sandi-tests: source-dirs: - test-src main: Main.hs dependencies: - sandi - base - bytestring - tasty - tasty-hunit - tasty-quickcheck - tasty-th benchmarks: sandi-bench: source-dirs: - bench-src main: Main.hs dependencies: - sandi - base - bytestring - criterion sandi-0.5/csrc/codec.h0000644000000000000000000000757713426042666013053 0ustar0000000000000000// 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 split, 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