114 lines
3.2 KiB
Haskell
114 lines
3.2 KiB
Haskell
import Control.Monad (replicateM)
|
|
|
|
import qualified Data.ByteString.Lazy as BL
|
|
import qualified Data.ByteString.Lazy.Char8 as BLC
|
|
import Data.Binary.Get
|
|
import Data.Binary.Put
|
|
import Data.Bits
|
|
|
|
import Data.Array (Array, listArray, (!))
|
|
import Data.List (foldl)
|
|
import Data.Word (Word32)
|
|
|
|
import Numeric (showHex)
|
|
|
|
|
|
-- functions
|
|
type Fun = Word32 -> Word32 -> Word32 -> Word32
|
|
|
|
funF, funG, funH, funI :: Fun
|
|
funF x y z = (x .&. y) .|. (complement x .&. z)
|
|
funG x y z = (x .&. z) .|. (complement z .&. y)
|
|
funH x y z = x `xor` y `xor` z
|
|
funI x y z = y `xor` (complement z .|. x)
|
|
|
|
idxF, idxG, idxH, idxI :: Int -> Int
|
|
idxF i = i
|
|
idxG i = (5 * i + 1) `mod` 16
|
|
idxH i = (3 * i + 5) `mod` 16
|
|
idxI i = 7 * i `mod` 16
|
|
|
|
|
|
-- arrays
|
|
funA :: Array Int Fun
|
|
funA = listArray (1,64) $ replicate 16 =<< [funF, funG, funH, funI]
|
|
|
|
idxA :: Array Int Int
|
|
idxA = listArray (1,64) $ zipWith ($) (replicate 16 =<< [idxF, idxG, idxH, idxI]) [0..63]
|
|
|
|
rotA :: Array Int Int
|
|
rotA = listArray (1,64) $ concat . replicate 4 =<<
|
|
[[7, 12, 17, 22], [5, 9, 14, 20], [4, 11, 16, 23], [6, 10, 15, 21]]
|
|
|
|
sinA :: Array Int Word32
|
|
sinA = listArray (1,64) $ map (floor . (*mult) . abs . sin) [1..64]
|
|
where mult = 2 ** 32 :: Double
|
|
|
|
|
|
-- to lazily calculate MD5 sum for standart input:
|
|
-- main = putStrLn . md5sum =<< BL.getContents
|
|
|
|
main :: IO ()
|
|
main = mapM_ (putStrLn . md5sum . BLC.pack)
|
|
[ ""
|
|
, "a"
|
|
, "abc"
|
|
, "message digest"
|
|
, "abcdefghijklmnopqrstuvwxyz"
|
|
, "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789"
|
|
, "12345678901234567890123456789012345678901234567890123456789012345678901234567890"
|
|
]
|
|
|
|
|
|
md5sum :: BL.ByteString -> String
|
|
md5sum input =
|
|
let MD5 a b c d = getMD5 initial `runGet` input
|
|
in foldr hex [] . BL.unpack . runPut $ mapM_ putWord32le [a,b,c,d]
|
|
where
|
|
initial = MD5 0x67452301 0xEFCDAB89 0x98BADCFE 0x10325476
|
|
|
|
hex x s | x < 16 = '0' : showHex x s -- quick hack: like "%02x"
|
|
| otherwise = showHex x s
|
|
|
|
|
|
data MD5 = MD5
|
|
{ a :: {-# UNPACK #-} !Word32
|
|
, b :: {-# UNPACK #-} !Word32
|
|
, c :: {-# UNPACK #-} !Word32
|
|
, d :: {-# UNPACK #-} !Word32
|
|
}
|
|
|
|
|
|
getMD5 :: MD5 -> Get MD5
|
|
getMD5 md5 = do
|
|
chunk <- getLazyByteString 64
|
|
let len = BL.length chunk
|
|
|
|
if len == 64
|
|
then getMD5 $! md5 <+> chunk -- apply and process next chunk
|
|
|
|
else do -- input is totally eaten, finalize
|
|
bytes <- bytesRead
|
|
let fin = runPut . putWord64le $ fromIntegral (bytes - 64 + len) * 8
|
|
pad n = chunk `BL.append` (0x80 `BL.cons` BL.replicate (n - 1) 0x00)
|
|
|
|
return $ if len >= 56
|
|
then md5 <+> pad (64 - len) <+> BL.replicate 56 0x00 `BL.append` fin
|
|
else md5 <+> pad (56 - len) `BL.append` fin
|
|
|
|
|
|
(<+>) :: MD5 -> BL.ByteString -> MD5
|
|
infixl 5 <+>
|
|
md5@(MD5 a b c d) <+> bs =
|
|
let datA = listArray (0,15) $ replicateM 16 getWord32le `runGet` bs
|
|
MD5 a' b' c' d' = foldl' (md5round datA) md5 [1..64]
|
|
in MD5 (a + a') (b + b') (c + c') (d + d')
|
|
|
|
|
|
md5round :: Array Int Word32 -> MD5 -> Int -> MD5
|
|
md5round datA (MD5 a b c d) i =
|
|
let f = funA ! i
|
|
w = datA ! (idxA ! i)
|
|
a' = b + (a + f b c d + w + sinA ! i) `rotateL` rotA ! i
|
|
in MD5 d a' b c
|