diff options
author | Simon Marlow <marlowsd@gmail.com> | 2008-05-28 12:52:58 +0000 |
---|---|---|
committer | Simon Marlow <marlowsd@gmail.com> | 2008-05-28 12:52:58 +0000 |
commit | 526c3af1dc98987b6949f4df73c0debccf9875bd (patch) | |
tree | e9dd06d73e2f4281cec06d1f46ae63f1063799e6 /compiler/utils | |
parent | 842e9d6628a27cf1f420d53f6a5901935dc50c54 (diff) | |
download | haskell-526c3af1dc98987b6949f4df73c0debccf9875bd.tar.gz |
Use MD5 checksums for recompilation checking (fixes #1372, #1959)
This is a much more robust way to do recompilation checking. The idea
is to create a fingerprint of the ABI of an interface, and track
dependencies by recording the fingerprints of ABIs that a module
depends on. If any of those ABIs have changed, then we need to
recompile.
In bug #1372 we weren't recording dependencies on package modules,
this patch fixes that by recording fingerprints of package modules
that we depend on. Within a package there is still fine-grained
recompilation avoidance as before.
We currently use MD5 for fingerprints, being a good compromise between
efficiency and security. We're not worried about attackers, but we
are worried about accidental collisions.
All the MD5 sums do make interface files a bit bigger, but compile
times on the whole are about the same as before. Recompilation
avoidance should be a bit more accurate than in 6.8.2 due to fixing
#1959, especially when using -O.
Diffstat (limited to 'compiler/utils')
-rw-r--r-- | compiler/utils/Binary.hs | 121 | ||||
-rw-r--r-- | compiler/utils/FastMutInt.lhs | 42 | ||||
-rw-r--r-- | compiler/utils/Fingerprint.hsc | 77 | ||||
-rw-r--r-- | compiler/utils/md5.c | 238 | ||||
-rw-r--r-- | compiler/utils/md5.h | 24 |
5 files changed, 441 insertions, 61 deletions
diff --git a/compiler/utils/Binary.hs b/compiler/utils/Binary.hs index 2ebc856f58..076ae16640 100644 --- a/compiler/utils/Binary.hs +++ b/compiler/utils/Binary.hs @@ -20,11 +20,13 @@ module Binary -- closeBin, seekBin, + seekBy, tellBin, castBin, writeBinMem, readBinMem, + fingerprintBinMem, isEOFBin, @@ -47,7 +49,7 @@ module Binary UserData(..), getUserData, setUserData, newReadState, newWriteState, - putDictionary, getDictionary, + putDictionary, getDictionary, putFS, ) where #include "HsVersions.h" @@ -57,21 +59,19 @@ module Binary import {-# SOURCE #-} Name (Name) import FastString -import Unique import Panic import UniqFM import FastMutInt import Util +import Fingerprint import Foreign -import Data.Array.IO import Data.Array import Data.Bits import Data.Int import Data.Word import Data.IORef import Data.Char ( ord, chr ) -import Data.Array.Base ( unsafeRead, unsafeWrite ) import Control.Monad ( when ) import System.IO as IO import System.IO.Unsafe ( unsafeInterleaveIO ) @@ -92,7 +92,7 @@ import System.IO ( openBinaryFile ) openBinaryFile f mode = openFileEx f (BinaryMode mode) #endif -type BinArray = IOUArray Int Word8 +type BinArray = ForeignPtr Word8 --------------------------------------------------------------- -- BinHandle @@ -168,7 +168,7 @@ openBinMem :: Int -> IO BinHandle openBinMem size | size <= 0 = error "Data.Binary.openBinMem: size must be >= 0" | otherwise = do - arr <- newArray_ (0,size-1) + arr <- mallocForeignPtrBytes size arr_r <- newIORef arr ix_r <- newFastMutInt writeFastMutInt ix_r 0 @@ -190,6 +190,20 @@ seekBin h@(BinMem _ ix_r sz_r _) (BinPtr p) = do then do expandBin h p; writeFastMutInt ix_r p else writeFastMutInt ix_r p +seekBy :: BinHandle -> Int -> IO () +seekBy (BinIO _ ix_r h) off = do + ix <- readFastMutInt ix_r + let ix' = ix + off + writeFastMutInt ix_r ix' + hSeek h AbsoluteSeek (fromIntegral ix') +seekBy h@(BinMem _ ix_r sz_r _) off = do + sz <- readFastMutInt sz_r + ix <- readFastMutInt ix_r + let ix' = ix + off + if (ix' >= sz) + then do expandBin h ix'; writeFastMutInt ix_r ix' + else writeFastMutInt ix_r ix' + isEOFBin :: BinHandle -> IO Bool isEOFBin (BinMem _ ix_r sz_r _) = do ix <- readFastMutInt ix_r @@ -203,7 +217,7 @@ writeBinMem (BinMem _ ix_r _ arr_r) fn = do h <- openBinaryFile fn WriteMode arr <- readIORef arr_r ix <- readFastMutInt ix_r - hPutArray h arr ix + withForeignPtr arr $ \p -> hPutBuf h p ix hClose h readBinMem :: FilePath -> IO BinHandle @@ -212,10 +226,10 @@ readBinMem filename = do h <- openBinaryFile filename ReadMode filesize' <- hFileSize h let filesize = fromIntegral filesize' - arr <- newArray_ (0,filesize-1) - count <- hGetArray h arr filesize - when (count /= filesize) - (error ("Binary.readBinMem: only read " ++ show count ++ " bytes")) + arr <- mallocForeignPtrBytes (filesize*2) + count <- withForeignPtr arr $ \p -> hGetBuf h p filesize + when (count /= filesize) $ + error ("Binary.readBinMem: only read " ++ show count ++ " bytes") hClose h arr_r <- newIORef arr ix_r <- newFastMutInt @@ -224,15 +238,23 @@ readBinMem filename = do writeFastMutInt sz_r filesize return (BinMem noUserData ix_r sz_r arr_r) +fingerprintBinMem :: BinHandle -> IO Fingerprint +fingerprintBinMem (BinIO _ _ _) = error "Binary.md5BinMem: not a memory handle" +fingerprintBinMem (BinMem _ ix_r _ arr_r) = do + arr <- readIORef arr_r + ix <- readFastMutInt ix_r + withForeignPtr arr $ \p -> fingerprintData p ix + -- expand the size of the array to include a specified offset expandBin :: BinHandle -> Int -> IO () expandBin (BinMem _ _ sz_r arr_r) off = do sz <- readFastMutInt sz_r let sz' = head (dropWhile (<= off) (iterate (* 2) sz)) arr <- readIORef arr_r - arr' <- newArray_ (0,sz'-1) - sequence_ [ unsafeRead arr i >>= unsafeWrite arr' i - | i <- [ 0 .. sz-1 ] ] + arr' <- mallocForeignPtrBytes sz' + withForeignPtr arr $ \old -> + withForeignPtr arr' $ \new -> + copyBytes new old sz writeFastMutInt sz_r sz' writeIORef arr_r arr' when debugIsOn $ @@ -253,7 +275,7 @@ putWord8 h@(BinMem _ ix_r sz_r arr_r) w = do then do expandBin h ix putWord8 h w else do arr <- readIORef arr_r - unsafeWrite arr ix w + withForeignPtr arr $ \p -> pokeByteOff p ix w writeFastMutInt ix_r (ix+1) return () putWord8 (BinIO _ ix_r h) w = do @@ -269,7 +291,7 @@ getWord8 (BinMem _ ix_r sz_r arr_r) = do when (ix >= sz) $ ioError (mkIOError eofErrorType "Data.Binary.getWord8" Nothing Nothing) arr <- readIORef arr_r - w <- unsafeRead arr ix + w <- withForeignPtr arr $ \p -> peekByteOff p ix writeFastMutInt ix_r (ix+1) return w getWord8 (BinIO _ ix_r h) = do @@ -581,43 +603,26 @@ data UserData = ud_symtab :: SymbolTable, -- for *serialising* only: - ud_dict_next :: !FastMutInt, -- The next index to use - ud_dict_map :: !(IORef (UniqFM (Int,FastString))), - -- indexed by FastString - - ud_symtab_next :: !FastMutInt, -- The next index to use - ud_symtab_map :: !(IORef (UniqFM (Int,Name))) - -- indexed by Name + ud_put_name :: BinHandle -> Name -> IO (), + ud_put_fs :: BinHandle -> FastString -> IO () } newReadState :: Dictionary -> IO UserData newReadState dict = do - dict_next <- newFastMutInt - dict_map <- newIORef (undef "dict_map") - symtab_next <- newFastMutInt - symtab_map <- newIORef (undef "symtab_map") - return UserData { ud_dict = dict, - ud_symtab = undef "symtab", - ud_dict_next = dict_next, - ud_dict_map = dict_map, - ud_symtab_next = symtab_next, - ud_symtab_map = symtab_map + return UserData { ud_dict = dict, + ud_symtab = undef "symtab", + ud_put_name = undef "put_name", + ud_put_fs = undef "put_fs" } -newWriteState :: IO UserData -newWriteState = do - dict_next <- newFastMutInt - writeFastMutInt dict_next 0 - dict_map <- newIORef emptyUFM - symtab_next <- newFastMutInt - writeFastMutInt symtab_next 0 - symtab_map <- newIORef emptyUFM - return UserData { ud_dict = undef "dict", - ud_symtab = undef "symtab", - ud_dict_next = dict_next, - ud_dict_map = dict_map, - ud_symtab_next = symtab_next, - ud_symtab_map = symtab_map +newWriteState :: (BinHandle -> Name -> IO ()) + -> (BinHandle -> FastString -> IO ()) + -> IO UserData +newWriteState put_name put_fs = do + return UserData { ud_dict = undef "dict", + ud_symtab = undef "symtab", + ud_put_name = put_name, + ud_put_fs = put_fs } noUserData :: a @@ -693,20 +698,16 @@ getFS bh = do instance Binary FastString where put_ bh f = - case getUserData bh of { - UserData { ud_dict_next = j_r, - ud_dict_map = out_r} -> do - out <- readIORef out_r - let uniq = getUnique f - case lookupUFM out uniq of - Just (j, _) -> put_ bh j - Nothing -> do - j <- readFastMutInt j_r - put_ bh j - writeFastMutInt j_r (j + 1) - writeIORef out_r $! addToUFM out uniq (j, f) - } + case getUserData bh of + UserData { ud_put_fs = put_fs } -> put_fs bh f get bh = do j <- get bh return $! (ud_dict (getUserData bh) ! j) + +-- Here to avoid loop + +instance Binary Fingerprint where + put_ h (Fingerprint w1 w2) = do put_ h w1; put_ h w2 + get h = do w1 <- get h; w2 <- get h; return (Fingerprint w1 w2) + diff --git a/compiler/utils/FastMutInt.lhs b/compiler/utils/FastMutInt.lhs index 2039ee5df9..00aba34bba 100644 --- a/compiler/utils/FastMutInt.lhs +++ b/compiler/utils/FastMutInt.lhs @@ -7,7 +7,10 @@ \begin{code} module FastMutInt( FastMutInt, newFastMutInt, - readFastMutInt, writeFastMutInt + readFastMutInt, writeFastMutInt, + + FastMutPtr, newFastMutPtr, + readFastMutPtr, writeFastMutPtr ) where #ifdef __GLASGOW_HASKELL__ @@ -19,6 +22,7 @@ module FastMutInt( import GHC.Base import GHC.IOBase +import GHC.Ptr #else /* ! __GLASGOW_HASKELL__ */ @@ -29,6 +33,10 @@ import Data.IORef newFastMutInt :: IO FastMutInt readFastMutInt :: FastMutInt -> IO Int writeFastMutInt :: FastMutInt -> Int -> IO () + +newFastMutPtr :: IO FastMutPtr +readFastMutPtr :: FastMutPtr -> IO (Ptr a) +writeFastMutPtr :: FastMutPtr -> Ptr a -> IO () \end{code} \begin{code} @@ -47,6 +55,21 @@ readFastMutInt (FastMutInt arr) = IO $ \s -> writeFastMutInt (FastMutInt arr) (I# i) = IO $ \s -> case writeIntArray# arr 0# i s of { s -> (# s, () #) } + +data FastMutPtr = FastMutPtr (MutableByteArray# RealWorld) + +newFastMutPtr = IO $ \s -> + case newByteArray# size s of { (# s, arr #) -> + (# s, FastMutPtr arr #) } + where I# size = SIZEOF_VOID_P + +readFastMutPtr (FastMutPtr arr) = IO $ \s -> + case readAddrArray# arr 0# s of { (# s, i #) -> + (# s, Ptr i #) } + +writeFastMutPtr (FastMutPtr arr) (Ptr i) = IO $ \s -> + case writeAddrArray# arr 0# i s of { s -> + (# s, () #) } #else /* ! __GLASGOW_HASKELL__ */ --maybe someday we could use --http://haskell.org/haskellwiki/Library/ArrayRef @@ -67,6 +90,23 @@ readFastMutInt (FastMutInt ioRefInt) = readIORef ioRefInt -- FastMutInt is strict in the value it contains. writeFastMutInt (FastMutInt ioRefInt) i = i `seq` writeIORef ioRefInt i + + +newtype FastMutPtr = FastMutPtr (IORef (Ptr ())) + +-- If any default value was chosen, it surely would be 0, +-- so we will use that since IORef requires a default value. +-- Or maybe it would be more interesting to package an error, +-- assuming nothing relies on being able to read a bogus Ptr? +-- That could interfere with its strictness for smart optimizers +-- (are they allowed to optimize a 'newtype' that way?) ... +-- Well, maybe that can be added (in DEBUG?) later. +newFastMutPtr = fmap FastMutPtr (newIORef (castPtr nullPtr)) + +readFastMutPtr (FastMutPtr ioRefPtr) = readIORef ioRefPtr + +-- FastMutPtr is strict in the value it contains. +writeFastMutPtr (FastMutPtr ioRefPtr) i = i `seq` writeIORef ioRefPtr i #endif \end{code} diff --git a/compiler/utils/Fingerprint.hsc b/compiler/utils/Fingerprint.hsc new file mode 100644 index 0000000000..d5a2409a26 --- /dev/null +++ b/compiler/utils/Fingerprint.hsc @@ -0,0 +1,77 @@ +-- ---------------------------------------------------------------------------- +-- +-- (c) The University of Glasgow 2006 +-- +-- Fingerprints for recompilation checking and ABI versioning. +-- +-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/Compiler/RecompilationAvoidance +-- +-- ---------------------------------------------------------------------------- + +module Fingerprint ( + Fingerprint(..), fingerprint0, + readHexFingerprint, + fingerprintData + ) where + +#include "md5.h" +##include "HsVersions.h" + +import Outputable + +import Foreign +import Foreign.C +import Text.Printf +import Data.Word +import Numeric ( readHex ) + +-- Using 128-bit MD5 fingerprints for now. + +data Fingerprint = Fingerprint {-# UNPACK #-} !Word64 {-# UNPACK #-} !Word64 + deriving (Eq, Ord) + -- or ByteString? + +fingerprint0 :: Fingerprint +fingerprint0 = Fingerprint 0 0 + +instance Outputable Fingerprint where + ppr (Fingerprint w1 w2) = text (printf "%016x%016x" w1 w2) + +-- useful for parsing the output of 'md5sum', should we want to do that. +readHexFingerprint :: String -> Fingerprint +readHexFingerprint s = Fingerprint w1 w2 + where (s1,s2) = splitAt 16 s + [(w1,"")] = readHex s1 + [(w2,"")] = readHex (take 16 s2) + +peekFingerprint :: Ptr Word8 -> IO Fingerprint +peekFingerprint p = do + let peekW64 :: Ptr Word8 -> Int -> Word64 -> IO Word64 + STRICT3(peekW64) + peekW64 _ 0 i = return i + peekW64 p n i = do + w8 <- peek p + peekW64 (p `plusPtr` 1) (n-1) + ((i `shiftL` 8) .|. fromIntegral w8) + + high <- peekW64 p 8 0 + low <- peekW64 (p `plusPtr` 8) 8 0 + return (Fingerprint high low) + +fingerprintData :: Ptr Word8 -> Int -> IO Fingerprint +fingerprintData buf len = do + allocaBytes (#const sizeof(struct MD5Context)) $ \pctxt -> do + c_MD5Init pctxt + c_MD5Update pctxt buf (fromIntegral len) + allocaBytes 16 $ \pdigest -> do + c_MD5Final pdigest pctxt + peekFingerprint (castPtr pdigest) + +data MD5Context + +foreign import ccall unsafe "MD5Init" + c_MD5Init :: Ptr MD5Context -> IO () +foreign import ccall unsafe "MD5Update" + c_MD5Update :: Ptr MD5Context -> Ptr Word8 -> CInt -> IO () +foreign import ccall unsafe "MD5Final" + c_MD5Final :: Ptr Word8 -> Ptr MD5Context -> IO () diff --git a/compiler/utils/md5.c b/compiler/utils/md5.c new file mode 100644 index 0000000000..0570cbbdf1 --- /dev/null +++ b/compiler/utils/md5.c @@ -0,0 +1,238 @@ +/* + * This code implements the MD5 message-digest algorithm. + * The algorithm is due to Ron Rivest. This code was + * written by Colin Plumb in 1993, no copyright is claimed. + * This code is in the public domain; do with it what you wish. + * + * Equivalent code is available from RSA Data Security, Inc. + * This code has been tested against that, and is equivalent, + * except that you don't need to include two pages of legalese + * with every copy. + * + * To compute the message digest of a chunk of bytes, declare an + * MD5Context structure, pass it to MD5Init, call MD5Update as + * needed on buffers full of bytes, and then call MD5Final, which + * will fill a supplied 16-byte array with the digest. + */ + +#include "HsFFI.h" +#include "md5.h" +#include <string.h> + +void MD5Init(struct MD5Context *context); +void MD5Update(struct MD5Context *context, byte const *buf, int len); +void MD5Final(byte digest[16], struct MD5Context *context); +void MD5Transform(word32 buf[4], word32 const in[16]); + + +/* + * Shuffle the bytes into little-endian order within words, as per the + * MD5 spec. Note: this code works regardless of the byte order. + */ +void +byteSwap(word32 *buf, unsigned words) +{ + byte *p = (byte *)buf; + + do { + *buf++ = (word32)((unsigned)p[3] << 8 | p[2]) << 16 | + ((unsigned)p[1] << 8 | p[0]); + p += 4; + } while (--words); +} + +/* + * Start MD5 accumulation. Set bit count to 0 and buffer to mysterious + * initialization constants. + */ +void +MD5Init(struct MD5Context *ctx) +{ + ctx->buf[0] = 0x67452301; + ctx->buf[1] = 0xefcdab89; + ctx->buf[2] = 0x98badcfe; + ctx->buf[3] = 0x10325476; + + ctx->bytes[0] = 0; + ctx->bytes[1] = 0; +} + +/* + * Update context to reflect the concatenation of another buffer full + * of bytes. + */ +void +MD5Update(struct MD5Context *ctx, byte const *buf, int len) +{ + word32 t; + + /* Update byte count */ + + t = ctx->bytes[0]; + if ((ctx->bytes[0] = t + len) < t) + ctx->bytes[1]++; /* Carry from low to high */ + + t = 64 - (t & 0x3f); /* Space available in ctx->in (at least 1) */ + if ((unsigned)t > len) { + memcpy((byte *)ctx->in + 64 - (unsigned)t, buf, len); + return; + } + /* First chunk is an odd size */ + memcpy((byte *)ctx->in + 64 - (unsigned)t, buf, (unsigned)t); + byteSwap(ctx->in, 16); + MD5Transform(ctx->buf, ctx->in); + buf += (unsigned)t; + len -= (unsigned)t; + + /* Process data in 64-byte chunks */ + while (len >= 64) { + memcpy(ctx->in, buf, 64); + byteSwap(ctx->in, 16); + MD5Transform(ctx->buf, ctx->in); + buf += 64; + len -= 64; + } + + /* Handle any remaining bytes of data. */ + memcpy(ctx->in, buf, len); +} + +/* + * Final wrapup - pad to 64-byte boundary with the bit pattern + * 1 0* (64-bit count of bits processed, MSB-first) + */ +void +MD5Final(byte digest[16], struct MD5Context *ctx) +{ + int count = (int)(ctx->bytes[0] & 0x3f); /* Bytes in ctx->in */ + byte *p = (byte *)ctx->in + count; /* First unused byte */ + + /* Set the first char of padding to 0x80. There is always room. */ + *p++ = 0x80; + + /* Bytes of padding needed to make 56 bytes (-8..55) */ + count = 56 - 1 - count; + + if (count < 0) { /* Padding forces an extra block */ + memset(p, 0, count+8); + byteSwap(ctx->in, 16); + MD5Transform(ctx->buf, ctx->in); + p = (byte *)ctx->in; + count = 56; + } + memset(p, 0, count+8); + byteSwap(ctx->in, 14); + + /* Append length in bits and transform */ + ctx->in[14] = ctx->bytes[0] << 3; + ctx->in[15] = ctx->bytes[1] << 3 | ctx->bytes[0] >> 29; + MD5Transform(ctx->buf, ctx->in); + + byteSwap(ctx->buf, 4); + memcpy(digest, ctx->buf, 16); + memset(ctx,0,sizeof(ctx)); +} + + +/* The four core functions - F1 is optimized somewhat */ + +/* #define F1(x, y, z) (x & y | ~x & z) */ +#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)) + +/* This is the central step in the MD5 algorithm. */ +#define MD5STEP(f,w,x,y,z,in,s) \ + (w += f(x,y,z) + in, w = (w<<s | w>>(32-s)) + x) + +/* + * The core of the MD5 algorithm, this alters an existing MD5 hash to + * reflect the addition of 16 longwords of new data. MD5Update blocks + * the data and converts bytes into longwords for this routine. + */ + +void +MD5Transform(word32 buf[4], word32 const in[16]) +{ + register word32 a, b, c, d; + + a = buf[0]; + b = buf[1]; + c = buf[2]; + d = buf[3]; + + MD5STEP(F1, a, b, c, d, in[0] + 0xd76aa478, 7); + MD5STEP(F1, d, a, b, c, in[1] + 0xe8c7b756, 12); + MD5STEP(F1, c, d, a, b, in[2] + 0x242070db, 17); + MD5STEP(F1, b, c, d, a, in[3] + 0xc1bdceee, 22); + MD5STEP(F1, a, b, c, d, in[4] + 0xf57c0faf, 7); + MD5STEP(F1, d, a, b, c, in[5] + 0x4787c62a, 12); + MD5STEP(F1, c, d, a, b, in[6] + 0xa8304613, 17); + MD5STEP(F1, b, c, d, a, in[7] + 0xfd469501, 22); + MD5STEP(F1, a, b, c, d, in[8] + 0x698098d8, 7); + MD5STEP(F1, d, a, b, c, in[9] + 0x8b44f7af, 12); + MD5STEP(F1, c, d, a, b, in[10] + 0xffff5bb1, 17); + MD5STEP(F1, b, c, d, a, in[11] + 0x895cd7be, 22); + MD5STEP(F1, a, b, c, d, in[12] + 0x6b901122, 7); + MD5STEP(F1, d, a, b, c, in[13] + 0xfd987193, 12); + MD5STEP(F1, c, d, a, b, in[14] + 0xa679438e, 17); + MD5STEP(F1, b, c, d, a, in[15] + 0x49b40821, 22); + + MD5STEP(F2, a, b, c, d, in[1] + 0xf61e2562, 5); + MD5STEP(F2, d, a, b, c, in[6] + 0xc040b340, 9); + MD5STEP(F2, c, d, a, b, in[11] + 0x265e5a51, 14); + MD5STEP(F2, b, c, d, a, in[0] + 0xe9b6c7aa, 20); + MD5STEP(F2, a, b, c, d, in[5] + 0xd62f105d, 5); + MD5STEP(F2, d, a, b, c, in[10] + 0x02441453, 9); + MD5STEP(F2, c, d, a, b, in[15] + 0xd8a1e681, 14); + MD5STEP(F2, b, c, d, a, in[4] + 0xe7d3fbc8, 20); + MD5STEP(F2, a, b, c, d, in[9] + 0x21e1cde6, 5); + MD5STEP(F2, d, a, b, c, in[14] + 0xc33707d6, 9); + MD5STEP(F2, c, d, a, b, in[3] + 0xf4d50d87, 14); + MD5STEP(F2, b, c, d, a, in[8] + 0x455a14ed, 20); + MD5STEP(F2, a, b, c, d, in[13] + 0xa9e3e905, 5); + MD5STEP(F2, d, a, b, c, in[2] + 0xfcefa3f8, 9); + MD5STEP(F2, c, d, a, b, in[7] + 0x676f02d9, 14); + MD5STEP(F2, b, c, d, a, in[12] + 0x8d2a4c8a, 20); + + MD5STEP(F3, a, b, c, d, in[5] + 0xfffa3942, 4); + MD5STEP(F3, d, a, b, c, in[8] + 0x8771f681, 11); + MD5STEP(F3, c, d, a, b, in[11] + 0x6d9d6122, 16); + MD5STEP(F3, b, c, d, a, in[14] + 0xfde5380c, 23); + MD5STEP(F3, a, b, c, d, in[1] + 0xa4beea44, 4); + MD5STEP(F3, d, a, b, c, in[4] + 0x4bdecfa9, 11); + MD5STEP(F3, c, d, a, b, in[7] + 0xf6bb4b60, 16); + MD5STEP(F3, b, c, d, a, in[10] + 0xbebfbc70, 23); + MD5STEP(F3, a, b, c, d, in[13] + 0x289b7ec6, 4); + MD5STEP(F3, d, a, b, c, in[0] + 0xeaa127fa, 11); + MD5STEP(F3, c, d, a, b, in[3] + 0xd4ef3085, 16); + MD5STEP(F3, b, c, d, a, in[6] + 0x04881d05, 23); + MD5STEP(F3, a, b, c, d, in[9] + 0xd9d4d039, 4); + MD5STEP(F3, d, a, b, c, in[12] + 0xe6db99e5, 11); + MD5STEP(F3, c, d, a, b, in[15] + 0x1fa27cf8, 16); + MD5STEP(F3, b, c, d, a, in[2] + 0xc4ac5665, 23); + + MD5STEP(F4, a, b, c, d, in[0] + 0xf4292244, 6); + MD5STEP(F4, d, a, b, c, in[7] + 0x432aff97, 10); + MD5STEP(F4, c, d, a, b, in[14] + 0xab9423a7, 15); + MD5STEP(F4, b, c, d, a, in[5] + 0xfc93a039, 21); + MD5STEP(F4, a, b, c, d, in[12] + 0x655b59c3, 6); + MD5STEP(F4, d, a, b, c, in[3] + 0x8f0ccc92, 10); + MD5STEP(F4, c, d, a, b, in[10] + 0xffeff47d, 15); + MD5STEP(F4, b, c, d, a, in[1] + 0x85845dd1, 21); + MD5STEP(F4, a, b, c, d, in[8] + 0x6fa87e4f, 6); + MD5STEP(F4, d, a, b, c, in[15] + 0xfe2ce6e0, 10); + MD5STEP(F4, c, d, a, b, in[6] + 0xa3014314, 15); + MD5STEP(F4, b, c, d, a, in[13] + 0x4e0811a1, 21); + MD5STEP(F4, a, b, c, d, in[4] + 0xf7537e82, 6); + MD5STEP(F4, d, a, b, c, in[11] + 0xbd3af235, 10); + MD5STEP(F4, c, d, a, b, in[2] + 0x2ad7d2bb, 15); + MD5STEP(F4, b, c, d, a, in[9] + 0xeb86d391, 21); + + buf[0] += a; + buf[1] += b; + buf[2] += c; + buf[3] += d; +} + diff --git a/compiler/utils/md5.h b/compiler/utils/md5.h new file mode 100644 index 0000000000..8d375df268 --- /dev/null +++ b/compiler/utils/md5.h @@ -0,0 +1,24 @@ +/* MD5 message digest */ +#ifndef _MD5_H +#define _MD5_H + +#include "HsFFI.h" + +typedef HsWord32 word32; +typedef HsWord8 byte; + +struct MD5Context { + word32 buf[4]; + word32 bytes[2]; + word32 in[16]; +}; + +void MD5Init(struct MD5Context *context); +void MD5Update(struct MD5Context *context, byte const *buf, int len); +void MD5Final(byte digest[16], struct MD5Context *context); +void MD5Transform(word32 buf[4], word32 const in[16]); + +#endif /* _MD5_H */ + + + |