diff --git a/Bench/Bench.hs b/Bench/Bench.hs new file mode 100644 --- /dev/null +++ b/Bench/Bench.hs @@ -0,0 +1,33 @@ +{-# LANGUAGE BangPatterns #-} +import Criterion.Main +import qualified Data.ByteString as B +import qualified Data.ByteString.Lazy as L +import qualified Crypto.Hash.MD5 as MD5 + +hashmany (i,u,f) = f . foldl u i + +allHashs = + [ ("MD5",MD5.hash, hashmany (MD5.init,MD5.update,MD5.finalize)) + ] + +benchHash :: a -> (a -> B.ByteString) -> Benchmarkable +benchHash bs f = whnf f bs + +withHashesFilter out f = map f $ filter (\(n,_,_) -> not (n `elem` out)) allHashs +withHashes f = map f allHashs + +main = do + let !bs32 = B.replicate 32 0 + !bs256 = B.replicate 256 0 + !bs4096 = B.replicate 4096 0 + !bs1M = B.replicate (1*1024*1024) 0 + let !lbs64x256 = (map (const (B.replicate 64 0)) [0..3]) + !lbs64x4096 = (map (const (B.replicate 64 0)) [0..63]) + defaultMain + [ bgroup "hash-32b" (withHashes (\(name, f,_) -> bench name $ benchHash bs32 f)) + , bgroup "hash-256b" (withHashes (\(name, f,_) -> bench name $ benchHash bs256 f)) + , bgroup "hash-4Kb" (withHashes (\(name, f,_) -> bench name $ benchHash bs4096 f)) + , bgroup "hash-1Mb" (withHashesFilter ["MD2"] (\(name, f,_) -> bench name $ benchHash bs1M f)) + , bgroup "iuf-64x256" (withHashes (\(name, _,f) -> bench name $ benchHash lbs64x256 f)) + , bgroup "iuf-64x4096" (withHashes (\(name, _,f) -> bench name $ benchHash lbs64x4096 f)) + ] diff --git a/Bench/BenchAPI.hs b/Bench/BenchAPI.hs new file mode 100644 --- /dev/null +++ b/Bench/BenchAPI.hs @@ -0,0 +1,39 @@ +{-# LANGUAGE BangPatterns #-} +import Criterion.Main +import qualified Data.ByteString as B +import qualified Data.ByteString.Lazy as L +import qualified Crypto.Hash.MD5 as MD5 + +md5F = ( "MD5" + , MD5.hash + , MD5.finalize . MD5.update MD5.init + ) + +main = do + let !bs32 = B.replicate 32 0 + !bs256 = B.replicate 256 0 + !bs4096 = B.replicate 4096 0 + !bs1M = B.replicate (1*1024*1024) 0 + let !lbs64x256 = (map (const (B.replicate 64 0)) [0..3]) + !lbs64x4096 = (map (const (B.replicate 64 0)) [0..63]) + + let (fname, fHash, fIncr) = md5F + let benchName ty z = fname ++ "." ++ ty -- ++ " " ++ show z + defaultMain + [ bgroup "hash-0b" + [ bench (benchName "hash" 0) $ whnf fHash B.empty + , bench (benchName "incr" 0) $ whnf fIncr B.empty + ] + , bgroup "hash-32b" + [ bench (benchName "hash" 32) $ whnf fHash bs32 + , bench (benchName "incr" 32) $ whnf fIncr bs32 + ] + , bgroup "hash-256b" + [ bench (benchName "hash" 256) $ whnf fHash bs256 + , bench (benchName "incr" 256) $ whnf fIncr bs256 + ] + , bgroup "hash-4Kb" + [ bench (benchName "hash" 4096) $ whnf fHash bs4096 + , bench (benchName "incr" 4096) $ whnf fIncr bs4096 + ] + ] diff --git a/Crypto/Hash/MD5.hs b/Crypto/Hash/MD5.hs new file mode 100644 --- /dev/null +++ b/Crypto/Hash/MD5.hs @@ -0,0 +1,184 @@ +-- | +-- Module : Crypto.Hash.MD5 +-- License : BSD-style +-- Maintainer : Herbert Valerio Riedel +-- Stability : stable +-- Portability : unknown +-- +-- A module containing bindings +-- +module Crypto.Hash.MD5 + ( + + -- * Incremental API + -- + -- | This API is based on 4 different functions, similar to the + -- lowlevel operations of a typical hash: + -- + -- - 'init': create a new hash context + -- - 'update': update non-destructively a new hash context with a strict bytestring + -- - 'updates': same as update, except that it takes a list of strict bytestring + -- - 'finalize': finalize the context and returns a digest bytestring. + -- + -- all those operations are completely pure, and instead of + -- changing the context as usual in others language, it + -- re-allocates a new context each time. + -- + -- Example: + -- + -- > import qualified Data.ByteString + -- > import qualified Crypto.Hash.MD5 as MD5 + -- > + -- > main = print digest + -- > where + -- > digest = MD5.finalize ctx + -- > ctx = foldl MD5.update ctx0 (map Data.ByteString.pack [ [1,2,3], [4,5,6] ]) + -- > ctx0 = MD5.init + + Ctx(..) + , init -- :: Ctx + , update -- :: Ctx -> ByteString -> Ctx + , updates -- :: Ctx -> [ByteString] -> Ctx + , finalize -- :: Ctx -> ByteString + + -- * Single Pass API + -- + -- | This API use the incremental API under the hood to provide + -- the common all-in-one operations to create digests out of a + -- 'ByteString' and lazy 'L.ByteString'. + -- + -- - 'hash': create a digest ('init' + 'update' + 'finalize') from a strict 'ByteString' + -- - 'hashlazy': create a digest ('init' + 'update' + 'finalize') from a lazy 'L.ByteString' + -- + -- Example: + -- + -- > import qualified Data.ByteString + -- > import qualified Crypto.Hash.MD5 as MD5 + -- > + -- > main = print $ MD5.hash (Data.ByteString.pack [0..255]) + -- + -- __NOTE__: The returned digest is a binary 'ByteString'. For + -- converting to a base16/hex encoded digest the + -- + -- package is recommended. + + , hash -- :: ByteString -> ByteString + , hashlazy -- :: ByteString -> ByteString + ) where + +import Prelude hiding (init) +import Foreign.Ptr +import Foreign.ForeignPtr (withForeignPtr) +import Foreign.Storable +import Foreign.Marshal.Alloc +import qualified Data.ByteString.Lazy as L +import qualified Data.ByteString as B +import Data.ByteString (ByteString) +import Data.ByteString.Unsafe (unsafeUseAsCStringLen) +import Data.ByteString.Internal (create, toForeignPtr) +import Data.Word +import System.IO.Unsafe (unsafeDupablePerformIO) + +-- | perform IO for hashes that do allocation and ffi. +-- unsafeDupablePerformIO is used when possible as the +-- computation is pure and the output is directly linked +-- to the input. we also do not modify anything after it has +-- been returned to the user. +unsafeDoIO :: IO a -> a +unsafeDoIO = unsafeDupablePerformIO + +-- | MD5 Context +newtype Ctx = Ctx ByteString + +{-# INLINE digestSize #-} +digestSize :: Int +digestSize = 16 + +{-# INLINE sizeCtx #-} +sizeCtx :: Int +sizeCtx = 96 + +{-# RULES "digestSize" B.length (finalize init) = digestSize #-} +{-# RULES "hash" forall b. finalize (update init b) = hash b #-} +{-# RULES "hash.list1" forall b. finalize (updates init [b]) = hash b #-} +{-# RULES "hashmany" forall b. finalize (foldl update init b) = hashlazy (L.fromChunks b) #-} +{-# RULES "hashlazy" forall b. finalize (foldl update init $ L.toChunks b) = hashlazy b #-} + +{-# INLINE withByteStringPtr #-} +withByteStringPtr :: ByteString -> (Ptr Word8 -> IO a) -> IO a +withByteStringPtr b f = + withForeignPtr fptr $ \ptr -> f (ptr `plusPtr` off) + where (fptr, off, _) = toForeignPtr b + +{-# INLINE memcopy64 #-} +memcopy64 :: Ptr Word64 -> Ptr Word64 -> IO () +memcopy64 dst src = mapM_ peekAndPoke [0..(12-1)] + where peekAndPoke i = peekElemOff src i >>= pokeElemOff dst i + +withCtxCopy :: Ctx -> (Ptr Ctx -> IO ()) -> IO Ctx +withCtxCopy (Ctx ctxB) f = Ctx `fmap` createCtx + where createCtx = create sizeCtx $ \dstPtr -> + withByteStringPtr ctxB $ \srcPtr -> do + memcopy64 (castPtr dstPtr) (castPtr srcPtr) + f (castPtr dstPtr) + +withCtxThrow :: Ctx -> (Ptr Ctx -> IO a) -> IO a +withCtxThrow (Ctx ctxB) f = + allocaBytes sizeCtx $ \dstPtr -> + withByteStringPtr ctxB $ \srcPtr -> do + memcopy64 (castPtr dstPtr) (castPtr srcPtr) + f (castPtr dstPtr) + +withCtxNew :: (Ptr Ctx -> IO ()) -> IO Ctx +withCtxNew f = Ctx `fmap` create sizeCtx (f . castPtr) + +withCtxNewThrow :: (Ptr Ctx -> IO a) -> IO a +withCtxNewThrow f = allocaBytes sizeCtx (f . castPtr) + +foreign import ccall unsafe "md5.h hs_cryptohash_md5_init" + c_md5_init :: Ptr Ctx -> IO () + +foreign import ccall unsafe "md5.h hs_cryptohash_md5_update" + c_md5_update :: Ptr Ctx -> Ptr Word8 -> Word32 -> IO () + +foreign import ccall unsafe "md5.h hs_cryptohash_md5_finalize" + c_md5_finalize :: Ptr Ctx -> Ptr Word8 -> IO () + +updateInternalIO :: Ptr Ctx -> ByteString -> IO () +updateInternalIO ptr d = + unsafeUseAsCStringLen d (\(cs, len) -> c_md5_update ptr (castPtr cs) (fromIntegral len)) + +finalizeInternalIO :: Ptr Ctx -> IO ByteString +finalizeInternalIO ptr = create digestSize (c_md5_finalize ptr) + +{-# NOINLINE init #-} +-- | init a context +init :: Ctx +init = unsafeDoIO $ withCtxNew $ c_md5_init + +{-# NOINLINE update #-} +-- | update a context with a bytestring +update :: Ctx -> ByteString -> Ctx +update ctx d = unsafeDoIO $ withCtxCopy ctx $ \ptr -> updateInternalIO ptr d + +{-# NOINLINE updates #-} +-- | updates a context with multiples bytestring +updates :: Ctx -> [ByteString] -> Ctx +updates ctx d = unsafeDoIO $ withCtxCopy ctx $ \ptr -> mapM_ (updateInternalIO ptr) d + +{-# NOINLINE finalize #-} +-- | finalize the context into a digest bytestring +finalize :: Ctx -> ByteString +finalize ctx = unsafeDoIO $ withCtxThrow ctx finalizeInternalIO + +{-# NOINLINE hash #-} +-- | hash a strict bytestring into a digest bytestring +hash :: ByteString -> ByteString +hash d = unsafeDoIO $ withCtxNewThrow $ \ptr -> do + c_md5_init ptr >> updateInternalIO ptr d >> finalizeInternalIO ptr + +{-# NOINLINE hashlazy #-} +-- | hash a lazy bytestring into a digest bytestring +hashlazy :: L.ByteString -> ByteString +hashlazy l = unsafeDoIO $ withCtxNewThrow $ \ptr -> do + c_md5_init ptr >> mapM_ (updateInternalIO ptr) (L.toChunks l) >> finalizeInternalIO ptr diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,28 @@ +Copyright (c) 2010-2014 Vincent Hanquez + 2016 Herbert Valerio Riedel + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions +are met: +1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the author nor the names of his contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE REGENTS 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 AUTHORS 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. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/Tests/KAT.hs b/Tests/KAT.hs new file mode 100644 --- /dev/null +++ b/Tests/KAT.hs @@ -0,0 +1,92 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ViewPatterns #-} +import Data.Char +import Data.Bits +import Data.Word +import Data.ByteString (ByteString) +import Data.Foldable (foldl') +import Data.Monoid (mconcat) +import qualified Data.ByteString as B +import qualified Data.ByteString.Char8 as BC +import qualified Crypto.Hash.MD5 as MD5 + +import Test.Tasty +import Test.Tasty.QuickCheck +import Test.Tasty.HUnit + +v0,v1,v2 :: ByteString +v0 = "" +v1 = "The quick brown fox jumps over the lazy dog" +v2 = "The quick brown fox jumps over the lazy cog" +vectors = [ v0, v1, v2 ] + +instance Arbitrary ByteString where + arbitrary = B.pack `fmap` arbitrary + +data HashFct = HashFct + { fctHash :: (B.ByteString -> B.ByteString) + , fctInc :: ([B.ByteString] -> B.ByteString) } + +hashinc i u f = f . foldl u i + +md5Hash = HashFct { fctHash = MD5.hash, fctInc = hashinc MD5.init MD5.update MD5.finalize } + + +results :: [ (String, HashFct, [String]) ] +results = [ + ("MD5", md5Hash, [ + "d41d8cd98f00b204e9800998ecf8427e", + "9e107d9d372bb6826bd81d3542a419d6", + "1055d3e698d289f2af8663725127bd4b" ]) + ] + +hexalise s = concatMap (\c -> [ hex $ c `div` 16, hex $ c `mod` 16 ]) s + where hex i + | i >= 0 && i <= 9 = fromIntegral (ord '0') + i + | i >= 10 && i <= 15 = fromIntegral (ord 'a') + i - 10 + | otherwise = 0 + +hexaliseB :: B.ByteString -> B.ByteString +hexaliseB = B.pack . hexalise . B.unpack + +splitB :: Int -> ByteString -> [ByteString] +splitB l b = + if B.length b > l + then + let (b1, b2) = B.splitAt l b in + b1 : splitB l b2 + else + [ b ] + +showHash :: B.ByteString -> String +showHash = map (toEnum.fromEnum) . hexalise . B.unpack + +runhash hash v = showHash $ (fctHash hash) $ v +runhashinc hash v = showHash $ (fctInc hash) $ v + +makeTestAlg (name, hash, results) = testGroup name $ concatMap maketest (zip3 [0..] vectors results) + where + runtest :: ByteString -> String + runtest v = runhash hash v + + runtestinc :: Int -> ByteString -> String + runtestinc i v = runhashinc hash $ splitB i v + + maketest (i, v, r) = + [ testCase (show i ++ " one-pass") (r @=? runtest v) + , testCase (show i ++ " inc 1") (r @=? runtestinc 1 v) + , testCase (show i ++ " inc 2") (r @=? runtestinc 2 v) + , testCase (show i ++ " inc 3") (r @=? runtestinc 3 v) + , testCase (show i ++ " inc 4") (r @=? runtestinc 4 v) + , testCase (show i ++ " inc 5") (r @=? runtestinc 5 v) + , testCase (show i ++ " inc 9") (r @=? runtestinc 9 v) + , testCase (show i ++ " inc 16") (r @=? runtestinc 16 v) + ] + +katTests :: [TestTree] +katTests = map makeTestAlg results + + +main = defaultMain $ testGroup "cryptohash" + [ testGroup "KATs" katTests + ] diff --git a/cbits/bitfn.h b/cbits/bitfn.h new file mode 100644 --- /dev/null +++ b/cbits/bitfn.h @@ -0,0 +1,240 @@ +/* + * Copyright (C) 2006-2009 Vincent Hanquez + * + * Redistribution and use in source and binary forms, with or without + * modification, are permitted provided that the following conditions + * are met: + * 1. Redistributions of source code must retain the above copyright + * notice, this list of conditions and the following disclaimer. + * 2. 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. + * + * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``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 AUTHOR 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. + */ + +#ifndef BITFN_H +#define BITFN_H +#include + +#ifndef NO_INLINE_ASM +/**********************************************************/ +# if (defined(__i386__)) +# define ARCH_HAS_SWAP32 +static inline uint32_t bitfn_swap32(uint32_t a) +{ + asm ("bswap %0" : "=r" (a) : "0" (a)); + return a; +} +/**********************************************************/ +# elif (defined(__arm__)) +# define ARCH_HAS_SWAP32 +static inline uint32_t bitfn_swap32(uint32_t a) +{ + uint32_t tmp = a; + asm volatile ("eor %1, %0, %0, ror #16\n" + "bic %1, %1, #0xff0000\n" + "mov %0, %0, ror #8\n" + "eor %0, %0, %1, lsr #8\n" + : "=r" (a), "=r" (tmp) : "0" (a), "1" (tmp)); + return a; +} +/**********************************************************/ +# elif defined(__x86_64__) +# define ARCH_HAS_SWAP32 +# define ARCH_HAS_SWAP64 +static inline uint32_t bitfn_swap32(uint32_t a) +{ + asm ("bswap %0" : "=r" (a) : "0" (a)); + return a; +} + +static inline uint64_t bitfn_swap64(uint64_t a) +{ + asm ("bswap %0" : "=r" (a) : "0" (a)); + return a; +} + +# endif +#endif /* NO_INLINE_ASM */ +/**********************************************************/ + +#ifndef ARCH_HAS_ROL32 +static inline uint32_t rol32(uint32_t word, uint32_t shift) +{ + return (word << shift) | (word >> (32 - shift)); +} +#endif + +#ifndef ARCH_HAS_ROR32 +static inline uint32_t ror32(uint32_t word, uint32_t shift) +{ + return (word >> shift) | (word << (32 - shift)); +} +#endif + +#ifndef ARCH_HAS_ROL64 +static inline uint64_t rol64(uint64_t word, uint32_t shift) +{ + return (word << shift) | (word >> (64 - shift)); +} +#endif + +#ifndef ARCH_HAS_ROR64 +static inline uint64_t ror64(uint64_t word, uint32_t shift) +{ + return (word >> shift) | (word << (64 - shift)); +} +#endif + +#ifndef ARCH_HAS_SWAP32 +static inline uint32_t bitfn_swap32(uint32_t a) +{ + return (a << 24) | ((a & 0xff00) << 8) | ((a >> 8) & 0xff00) | (a >> 24); +} +#endif + +#ifndef ARCH_HAS_ARRAY_SWAP32 +static inline void array_swap32(uint32_t *d, uint32_t *s, uint32_t nb) +{ + while (nb--) + *d++ = bitfn_swap32(*s++); +} +#endif + +#ifndef ARCH_HAS_SWAP64 +static inline uint64_t bitfn_swap64(uint64_t a) +{ + return ((uint64_t) bitfn_swap32((uint32_t) (a >> 32))) | + (((uint64_t) bitfn_swap32((uint32_t) a)) << 32); +} +#endif + +#ifndef ARCH_HAS_ARRAY_SWAP64 +static inline void array_swap64(uint64_t *d, uint64_t *s, uint32_t nb) +{ + while (nb--) + *d++ = bitfn_swap64(*s++); +} +#endif + +#ifndef ARCH_HAS_MEMORY_ZERO +static inline void memory_zero(void *ptr, uint32_t len) +{ + uint32_t *ptr32 = ptr; + uint8_t *ptr8; + int i; + + for (i = 0; i < len / 4; i++) + *ptr32++ = 0; + if (len % 4) { + ptr8 = (uint8_t *) ptr32; + for (i = len % 4; i >= 0; i--) + ptr8[i] = 0; + } +} +#endif + +#ifndef ARCH_HAS_ARRAY_COPY32 +static inline void array_copy32(uint32_t *d, uint32_t *s, uint32_t nb) +{ + while (nb--) *d++ = *s++; +} +#endif + +#ifndef ARCH_HAS_ARRAY_COPY64 +static inline void array_copy64(uint64_t *d, uint64_t *s, uint32_t nb) +{ + while (nb--) *d++ = *s++; +} +#endif + +#ifdef __MINGW32__ + # define LITTLE_ENDIAN 1234 + # define BYTE_ORDER LITTLE_ENDIAN +#elif defined(__FreeBSD__) || defined(__DragonFly__) || defined(__NetBSD__) + # include +#elif defined(__OpenBSD__) || defined(__SVR4) + # include +#elif defined(__APPLE__) + # include +#elif defined( BSD ) && ( BSD >= 199103 ) + # include +#elif defined( __QNXNTO__ ) && defined( __LITTLEENDIAN__ ) + # define LITTLE_ENDIAN 1234 + # define BYTE_ORDER LITTLE_ENDIAN +#elif defined( __QNXNTO__ ) && defined( __BIGENDIAN__ ) + # define BIG_ENDIAN 1234 + # define BYTE_ORDER BIG_ENDIAN +#elif defined( _AIX ) + # include +#else + # include +#endif +/* big endian to cpu */ +#if LITTLE_ENDIAN == BYTE_ORDER + +# define be32_to_cpu(a) bitfn_swap32(a) +# define cpu_to_be32(a) bitfn_swap32(a) +# define le32_to_cpu(a) (a) +# define cpu_to_le32(a) (a) +# define be64_to_cpu(a) bitfn_swap64(a) +# define cpu_to_be64(a) bitfn_swap64(a) +# define le64_to_cpu(a) (a) +# define cpu_to_le64(a) (a) + +# define cpu_to_le32_array(d, s, l) array_copy32(d, s, l) +# define le32_to_cpu_array(d, s, l) array_copy32(d, s, l) +# define cpu_to_be32_array(d, s, l) array_swap32(d, s, l) +# define be32_to_cpu_array(d, s, l) array_swap32(d, s, l) + +# define cpu_to_le64_array(d, s, l) array_copy64(d, s, l) +# define le64_to_cpu_array(d, s, l) array_copy64(d, s, l) +# define cpu_to_be64_array(d, s, l) array_swap64(d, s, l) +# define be64_to_cpu_array(d, s, l) array_swap64(d, s, l) + +# define ror32_be(a, s) rol32(a, s) +# define rol32_be(a, s) ror32(a, s) + +# define ARCH_IS_LITTLE_ENDIAN + +#elif BIG_ENDIAN == BYTE_ORDER + +# define be32_to_cpu(a) (a) +# define cpu_to_be32(a) (a) +# define be64_to_cpu(a) (a) +# define cpu_to_be64(a) (a) +# define le64_to_cpu(a) bitfn_swap64(a) +# define cpu_to_le64(a) bitfn_swap64(a) +# define le32_to_cpu(a) bitfn_swap32(a) +# define cpu_to_le32(a) bitfn_swap32(a) + +# define cpu_to_le32_array(d, s, l) array_swap32(d, s, l) +# define le32_to_cpu_array(d, s, l) array_swap32(d, s, l) +# define cpu_to_be32_array(d, s, l) array_copy32(d, s, l) +# define be32_to_cpu_array(d, s, l) array_copy32(d, s, l) + +# define cpu_to_le64_array(d, s, l) array_swap64(d, s, l) +# define le64_to_cpu_array(d, s, l) array_swap64(d, s, l) +# define cpu_to_be64_array(d, s, l) array_copy64(d, s, l) +# define be64_to_cpu_array(d, s, l) array_copy64(d, s, l) + +# define ror32_be(a, s) ror32(a, s) +# define rol32_be(a, s) rol32(a, s) + +# define ARCH_IS_BIG_ENDIAN + +#else +# error "endian not supported" +#endif + +#endif /* !BITFN_H */ diff --git a/cbits/md5.c b/cbits/md5.c new file mode 100644 --- /dev/null +++ b/cbits/md5.c @@ -0,0 +1,183 @@ +/* + * Copyright (C) 2006-2009 Vincent Hanquez + * 2016 Herbert Valerio Riedel + * + * Redistribution and use in source and binary forms, with or without + * modification, are permitted provided that the following conditions + * are met: + * 1. Redistributions of source code must retain the above copyright + * notice, this list of conditions and the following disclaimer. + * 2. 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. + * + * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``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 AUTHOR 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. + */ + +#include +#include +#include "bitfn.h" +#include "md5.h" + +void +hs_cryptohash_md5_init(struct md5_ctx *ctx) +{ + memset(ctx, 0, sizeof(*ctx)); + + ctx->sz = 0ULL; + ctx->h[0] = 0x67452301; + ctx->h[1] = 0xefcdab89; + ctx->h[2] = 0x98badcfe; + ctx->h[3] = 0x10325476; +} + +#define f1(x, y, z) (z ^ (x & (y ^ z))) +#define f2(x, y, z) f1(z, x, y) +#define f3(x, y, z) (x ^ y ^ z) +#define f4(x, y, z) (y ^ (x | ~z)) +#define R(f, a, b, c, d, i, k, s) a += f(b, c, d) + w[i] + k; a = rol32(a, s); a += b + +static void +md5_do_chunk(struct md5_ctx *ctx, uint32_t *buf) +{ + uint32_t a, b, c, d; +#ifdef ARCH_IS_BIG_ENDIAN + uint32_t w[16]; + cpu_to_le32_array(w, buf, 16); +#else + uint32_t *w = buf; +#endif + a = ctx->h[0]; b = ctx->h[1]; c = ctx->h[2]; d = ctx->h[3]; + + R(f1, a, b, c, d, 0, 0xd76aa478, 7); + R(f1, d, a, b, c, 1, 0xe8c7b756, 12); + R(f1, c, d, a, b, 2, 0x242070db, 17); + R(f1, b, c, d, a, 3, 0xc1bdceee, 22); + R(f1, a, b, c, d, 4, 0xf57c0faf, 7); + R(f1, d, a, b, c, 5, 0x4787c62a, 12); + R(f1, c, d, a, b, 6, 0xa8304613, 17); + R(f1, b, c, d, a, 7, 0xfd469501, 22); + R(f1, a, b, c, d, 8, 0x698098d8, 7); + R(f1, d, a, b, c, 9, 0x8b44f7af, 12); + R(f1, c, d, a, b, 10, 0xffff5bb1, 17); + R(f1, b, c, d, a, 11, 0x895cd7be, 22); + R(f1, a, b, c, d, 12, 0x6b901122, 7); + R(f1, d, a, b, c, 13, 0xfd987193, 12); + R(f1, c, d, a, b, 14, 0xa679438e, 17); + R(f1, b, c, d, a, 15, 0x49b40821, 22); + + R(f2, a, b, c, d, 1, 0xf61e2562, 5); + R(f2, d, a, b, c, 6, 0xc040b340, 9); + R(f2, c, d, a, b, 11, 0x265e5a51, 14); + R(f2, b, c, d, a, 0, 0xe9b6c7aa, 20); + R(f2, a, b, c, d, 5, 0xd62f105d, 5); + R(f2, d, a, b, c, 10, 0x02441453, 9); + R(f2, c, d, a, b, 15, 0xd8a1e681, 14); + R(f2, b, c, d, a, 4, 0xe7d3fbc8, 20); + R(f2, a, b, c, d, 9, 0x21e1cde6, 5); + R(f2, d, a, b, c, 14, 0xc33707d6, 9); + R(f2, c, d, a, b, 3, 0xf4d50d87, 14); + R(f2, b, c, d, a, 8, 0x455a14ed, 20); + R(f2, a, b, c, d, 13, 0xa9e3e905, 5); + R(f2, d, a, b, c, 2, 0xfcefa3f8, 9); + R(f2, c, d, a, b, 7, 0x676f02d9, 14); + R(f2, b, c, d, a, 12, 0x8d2a4c8a, 20); + + R(f3, a, b, c, d, 5, 0xfffa3942, 4); + R(f3, d, a, b, c, 8, 0x8771f681, 11); + R(f3, c, d, a, b, 11, 0x6d9d6122, 16); + R(f3, b, c, d, a, 14, 0xfde5380c, 23); + R(f3, a, b, c, d, 1, 0xa4beea44, 4); + R(f3, d, a, b, c, 4, 0x4bdecfa9, 11); + R(f3, c, d, a, b, 7, 0xf6bb4b60, 16); + R(f3, b, c, d, a, 10, 0xbebfbc70, 23); + R(f3, a, b, c, d, 13, 0x289b7ec6, 4); + R(f3, d, a, b, c, 0, 0xeaa127fa, 11); + R(f3, c, d, a, b, 3, 0xd4ef3085, 16); + R(f3, b, c, d, a, 6, 0x04881d05, 23); + R(f3, a, b, c, d, 9, 0xd9d4d039, 4); + R(f3, d, a, b, c, 12, 0xe6db99e5, 11); + R(f3, c, d, a, b, 15, 0x1fa27cf8, 16); + R(f3, b, c, d, a, 2, 0xc4ac5665, 23); + + R(f4, a, b, c, d, 0, 0xf4292244, 6); + R(f4, d, a, b, c, 7, 0x432aff97, 10); + R(f4, c, d, a, b, 14, 0xab9423a7, 15); + R(f4, b, c, d, a, 5, 0xfc93a039, 21); + R(f4, a, b, c, d, 12, 0x655b59c3, 6); + R(f4, d, a, b, c, 3, 0x8f0ccc92, 10); + R(f4, c, d, a, b, 10, 0xffeff47d, 15); + R(f4, b, c, d, a, 1, 0x85845dd1, 21); + R(f4, a, b, c, d, 8, 0x6fa87e4f, 6); + R(f4, d, a, b, c, 15, 0xfe2ce6e0, 10); + R(f4, c, d, a, b, 6, 0xa3014314, 15); + R(f4, b, c, d, a, 13, 0x4e0811a1, 21); + R(f4, a, b, c, d, 4, 0xf7537e82, 6); + R(f4, d, a, b, c, 11, 0xbd3af235, 10); + R(f4, c, d, a, b, 2, 0x2ad7d2bb, 15); + R(f4, b, c, d, a, 9, 0xeb86d391, 21); + + ctx->h[0] += a; ctx->h[1] += b; ctx->h[2] += c; ctx->h[3] += d; +} + +void +hs_cryptohash_md5_update(struct md5_ctx *ctx, uint8_t *data, uint32_t len) +{ + uint32_t index, to_fill; + + index = (uint32_t) (ctx->sz & 0x3f); + to_fill = 64 - index; + + ctx->sz += len; + + if (index && len >= to_fill) { + memcpy(ctx->buf + index, data, to_fill); + md5_do_chunk(ctx, (uint32_t *) ctx->buf); + len -= to_fill; + data += to_fill; + index = 0; + } + + /* process as much 64-block as possible */ + for (; len >= 64; len -= 64, data += 64) + md5_do_chunk(ctx, (uint32_t *) data); + + /* append data into buf */ + if (len) + memcpy(ctx->buf + index, data, len); +} + +void +hs_cryptohash_md5_finalize(struct md5_ctx *ctx, uint8_t *out) +{ + static uint8_t padding[64] = { 0x80, }; + uint64_t bits; + uint32_t index, padlen; + uint32_t *p = (uint32_t *) out; + + /* add padding and update data with it */ + bits = cpu_to_le64(ctx->sz << 3); + + /* pad out to 56 */ + index = (uint32_t) (ctx->sz & 0x3f); + padlen = (index < 56) ? (56 - index) : ((64 + 56) - index); + hs_cryptohash_md5_update(ctx, padding, padlen); + + /* append length */ + hs_cryptohash_md5_update(ctx, (uint8_t *) &bits, sizeof(bits)); + + /* output hash */ + p[0] = cpu_to_le32(ctx->h[0]); + p[1] = cpu_to_le32(ctx->h[1]); + p[2] = cpu_to_le32(ctx->h[2]); + p[3] = cpu_to_le32(ctx->h[3]); +} diff --git a/cbits/md5.h b/cbits/md5.h new file mode 100644 --- /dev/null +++ b/cbits/md5.h @@ -0,0 +1,45 @@ +/* + * Copyright (C) 2006-2009 Vincent Hanquez + * 2016 Herbert Valerio Riedel + * + * Redistribution and use in source and binary forms, with or without + * modification, are permitted provided that the following conditions + * are met: + * 1. Redistributions of source code must retain the above copyright + * notice, this list of conditions and the following disclaimer. + * 2. 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. + * + * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``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 AUTHOR 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. + */ + +#ifndef CRYPTOHASH_MD5_H +#define CRYPTOHASH_MD5_H + +#include + +struct md5_ctx +{ + uint64_t sz; + uint8_t buf[64]; + uint32_t h[4]; +}; + +#define MD5_DIGEST_SIZE 16 +#define MD5_CTX_SIZE sizeof(struct md5_ctx) + +void hs_cryptohash_md5_init(struct md5_ctx *ctx); +void hs_cryptohash_md5_update(struct md5_ctx *ctx, uint8_t *data, uint32_t len); +void hs_cryptohash_md5_finalize(struct md5_ctx *ctx, uint8_t *out); + +#endif diff --git a/cryptohash-md5.cabal b/cryptohash-md5.cabal new file mode 100644 --- /dev/null +++ b/cryptohash-md5.cabal @@ -0,0 +1,82 @@ +name: cryptohash-md5 +version: 0.11.7.1 +description: + A practical incremental and one-pass, pure API to the + + with performance close to the fastest implementations available in other languages. + . + The implementation is made in C with a haskell FFI wrapper that hides the C implementation. + . + NOTE: This package has been forked off @cryptohash-0.11.7@ because the @cryptohash@ package + has been deprecated and so this package continues to satisfy the need for a lightweight package + providing the MD5 hash algorithm without any dependencies on packages other than + @base@ and @bytestring@. + . + Consequently, this package can be used as a drop-in replacement for @cryptohash@'s + "Crypto.Hash.MD5" module, though with a clearly smaller footprint. + +license: BSD3 +license-file: LICENSE +copyright: Vincent Hanquez, Herbert Valerio Riedel +maintainer: Herbert Valerio Riedel +homepage: https://github.com/hvr/cryptohash-md5 +bug-reports: https://github.com/hvr/cryptohash-md5/issues +synopsis: Fast, pure and practical MD5 implementation +category: Data, Cryptography +build-type: Simple +cabal-version: >=1.10 +tested-with: GHC == 7.4.2 + , GHC == 7.6.3 + , GHC == 7.8.4 + , GHC == 7.10.3 + , GHC == 8.0.1 + +extra-source-files: cbits/bitfn.h + cbits/md5.h + +source-repository head + type: git + location: https://github.com/hvr/cryptohash-md5.git + +library + default-language: Haskell2010 + build-depends: base >= 4.5 && < 4.10 + , bytestring >= 0.9.2 && < 0.11 + + exposed-modules: Crypto.Hash.MD5 + ghc-options: -Wall -fno-cse -O2 + cc-options: -O3 + c-sources: cbits/md5.c + include-dirs: cbits + +test-suite test-kat + default-language: Haskell2010 + type: exitcode-stdio-1.0 + hs-source-dirs: Tests + main-is: KAT.hs + build-depends: cryptohash-md5 + , base + , bytestring + , tasty == 0.11.* + , tasty-quickcheck == 0.8.* + , tasty-hunit == 0.9.* + +benchmark bench-hashes + default-language: Haskell2010 + type: exitcode-stdio-1.0 + main-is: Bench.hs + hs-source-dirs: Bench + build-depends: cryptohash-md5 + , base + , bytestring + , criterion == 1.1.* + +benchmark bench-api + default-language: Haskell2010 + type: exitcode-stdio-1.0 + main-is: BenchAPI.hs + hs-source-dirs: Bench + build-depends: cryptohash-md5 + , base + , bytestring + , criterion == 1.1.*