Permalink
Browse files

Cabalize

darcs-hash:20080111235753-c44f9-56811d330090bd7a5aceb9691da38de0c6022418.gz
  • Loading branch information...
1 parent 1711aac commit c4ee6e86ac868abdddb87c99cf202294d4c3986d @TomMD committed Jan 11, 2008
Showing with 56 additions and 442 deletions.
  1. +30 −0 LICENSE
  2. +0 −199 MD5.rolled.hs
  3. +0 −243 MD5.unroll.hs
  4. +3 −0 NOTES
  5. +3 −0 Setup.lhs
  6. +20 −0 pureMD5.cabal
View
30 LICENSE
@@ -0,0 +1,30 @@
+Copyright (c) Thomas DuBuisson
+
+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 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.
View
@@ -1,199 +0,0 @@
-{-# OPTIONS_GHC -fbang-patterns -funbox-strict-fields -fvia-c -optc-funroll-all-loops -optc-O3 #-}
---
--- Module : Crypto.MD5
--- License : BSD3
--- Maintainer : Thomas.DuBuisson@gmail.com
--- Stability : experimental
--- Portability : portable, requires bang patterns and ByteString
--- Tested with : GHC-6.8.0
---
-
-module Main
- (main
- ,md5
- ,md5InitialContext
- ,md5Update
- ,md5Finalize
- ,MD5Context
- ,md5File
- ,applyMD5Rounds
- ) where
-
-import qualified Data.ByteString as B
-import qualified Data.ByteString.Lazy as L
-import Data.Array.Unboxed
-import Data.Array.IArray
-import Data.ByteString.Internal
-import Data.Bits
-import Data.List
-import Data.Int (Int64)
-import Data.Word
-import Foreign.Storable
-import Foreign.Ptr
-import Foreign.ForeignPtr
-import Numeric
-import System.Environment
-import System.IO
-import Data.Binary
-import Data.Binary.Get
-import Data.Binary.Put
-
-blockSize = 512 -- Block size in bits
-blockSizeBytes = blockSize `div` 8
-blockSizeBytesW64 = fromIntegral blockSizeBytes
-blockSizeBits = (fromIntegral blockSize) :: Word64
-
-sinConstList = [floor(abs(sin(i + 1)) * (2 ^ 32)) | i <- [0..63]]
-sinConst :: UArray Int Word32
-sinConst = listArray (0,63) sinConstList
-
-roundShiftList = [7, 12, 17, 22, 7, 12, 17, 22, 7, 12, 17, 22, 7, 12, 17, 22,
- 5, 9, 14, 20, 5, 9, 14, 20, 5, 9, 14, 20, 5, 9, 14, 20,
- 4, 11, 16, 23, 4, 11, 16, 23, 4, 11, 16, 23, 4, 11, 16, 23,
- 6, 10, 15, 21, 6, 10, 15, 21, 6, 10, 15, 21, 6, 10, 15, 21 ]
-
-roundShift :: UArray Int Int
-roundShift = listArray (0,length roundShiftList) roundShiftList
-
-data MD5Partial = MD5Par !Word32 !Word32 !Word32 !Word32
-data MD5Context = MD5Ctx { mdPartial :: MD5Partial,
- mdLeftOver :: ByteString,
- mdTotalLen :: Word64
- }
-
-md5InitialContext = MD5Ctx (MD5Par h0 h1 h2 h3) B.empty 0
-h0 = 0x67452301
-h1 = 0xEFCDAB89
-h2 = 0x98BADCFE
-h3 = 0x10325476
-
--- | Will read the lazy ByteString and return the md5 digest.
--- Some application might want to wrap this function for type safty.
-md5 :: L.ByteString -> L.ByteString
-md5 bs = md5Finalize $ md5Update md5InitialContext bs
-
-md5Finalize :: MD5Context -> L.ByteString
-md5Finalize !ctx@(MD5Ctx (MD5Par a b c d) rem !totLen) =
- let totLen' = (totLen + 8*fromIntegral l) :: Word64
- padBS = L.toChunks $ runPut ( do
- putWord8 0x80
- mapM_ putWord8 (replicate lenZeroPad 0)
- putWord64le totLen' )
- (MD5Ctx (MD5Par a' b' c' d') _ _) = md5Update ctx (L.fromChunks (rem:padBS))
- in runPut ( do
- putWord32le a'
- putWord32le b'
- putWord32le c'
- putWord32le d' )
-
- where
- l = B.length rem
- lenZeroPad = if (l+1) <= blockSizeBytes - 8
- then (blockSizeBytes - 8) - (l+1)
- else (2*blockSizeBytes - 8) - (l+1)
-
-md5Update :: MD5Context -> L.ByteString -> MD5Context
-md5Update ctx bsLazy =
- let blks = block bsLazy
- in foldl' performMD5Update ctx blks
-
-block :: L.ByteString -> [ByteString]
-block bs =
- case L.toChunks bs of
- [] -> []
- otherwise -> (B.concat . L.toChunks) top : block rest
- where
- (top,rest) = L.splitAt blockSizeBytesW64 bs
-{-# INLINE block #-}
-
--- Assumes ByteString length == blockSizeBytes, will fold the
--- context across calls to applyMD5Rounds.
-performMD5Update :: MD5Context -> ByteString -> MD5Context
-performMD5Update !ctx@(MD5Ctx !par@(MD5Par !a !b !c !d) _ !len) bs =
- let MD5Par a' b' c' d' = applyMD5Rounds par bs
- in if B.length bs == blockSizeBytes
- then MD5Ctx {
- mdPartial = MD5Par (a' + a) (b' + b) (c' + c) (d' + d),
- mdLeftOver = B.empty,
- mdTotalLen = len + blockSizeBits
- }
- else ctx { mdLeftOver = bs }
-
-applyMD5Rounds :: MD5Partial -> ByteString -> MD5Partial
-applyMD5Rounds par@(MD5Par a b c d) w =
- foldl' (md5Round w) par [0..63]
-
-md5Round :: ByteString -> MD5Partial -> Int -> MD5Partial
-md5Round w par@(MD5Par a b c d) !r
- | r <= 15 = let j = r
- b' = ff a b c d (w!!j) rs sc
- in MD5Par d b' b c
- | r <= 31 = let j = (5*r + 1) `mod` 16
- b' = gg a b c d (w!!j) rs sc
- in MD5Par d b' b c
- | r <= 47 = let j = (3*r + 5) `mod` 16
- b' = hh a b c d (w!!j) rs sc
- in MD5Par d b' b c
- | otherwise = let j = (7*r) `mod` 16
- b' = ii a b c d (w!!j) rs sc
- in MD5Par d b' b c
- where
- rs = roundShift!r
- sc = sinConst!r
- f !x !y !z = (x .&. y) .|. ((complement x) .&. z)
- {-# INLINE f #-}
- g !x !y !z = (x .&. z) .|. (y .&. (complement z))
- {-# INLINE g #-}
- h !x !y !z = (x `xor` y `xor` z)
- {-# INLINE h #-}
- i !x !y !z = y `xor` (x .|. (complement z))
- {-# INLINE i #-}
- ff a b c d x s ac = {-# SCC "ff" #-}
- let !a' = f b c d + x + ac + a
- !a'' = rotateL a' s
- in a'' + b
- {-# INLINE ff #-}
- gg a b c d x s ac = {-# SCC "gg" #-}
- let !a' = g b c d + x + ac + a
- !a'' = rotateL a' s
- in a'' + b
- {-# INLINE gg #-}
- hh a b c d x s ac = {-# SCC "hh" #-}
- let !a' = h b c d + x + ac + a
- !a'' = rotateL a' s
- in a'' + b
- {-# INLINE hh #-}
- ii a b c d x s ac = {-# SCC "ii" #-}
- let !a' = i b c d + x + ac + a
- !a'' = rotateL a' s
- in a'' + b
- {-# INLINE ii #-}
- (!!) word32s pos = getNthWord pos word32s
- {-# INLINE (!!) #-}
--- getNthWord n bs = runGet (skip (n*4) >> getWord32le) (L.fromChunks [bs])
- getNthWord n bs@(PS ptr off len) =
- inlinePerformIO $ withForeignPtr ptr $ \ptr' -> do
- let p = castPtr $ plusPtr ptr' off
- peekElemOff p n
- {-# INLINE getNthWord #-}
-{-# INLINE applyMD5Rounds #-}
-
-stringMD5 lazy =
- let x = L.toChunks lazy
- w = B.unpack (B.concat x)
- s = map (\x -> showHex x "") w
- s' = map (\x -> if length x == 1 then '0':x else x) s
- in concat s'
-
-md5File :: String -> IO ()
-md5File f = do
- h <- openFile f ReadMode
- s <- L.hGetContents h
- let hash = md5 s
- putStrLn (stringMD5 hash)
- return ()
-
-main :: IO ()
-main = do fs <- getArgs
- md5File (head fs)
- return ()
Oops, something went wrong.

0 comments on commit c4ee6e8

Please sign in to comment.