[Haskell-cafe] haskell crypto is reaaaaaaaaaally slow
Donald Bruce Stewart
dons at cse.unsw.edu.au
Wed Jun 20 01:21:05 EDT 2007
> > aeyakovenko:
> > > $ time ./md5sum ./md5sum
> > > [105,252,52,138,187,192,216,17,225,123,185,3,124,101,86,132]
> > >
> > > real 0m4.790s
> > > user 0m3.688s
> > > sys 0m0.492s
> > >
> > > $ time md5sum ./md5sum
> > > 69fc348abbc0d811e17bb9037c655684 ./md5sum
> > >
> > > real 0m0.023s
> > > user 0m0.000s
> > > sys 0m0.008s
> > >
I wasn't happy with the hex printing loop. Here's a shorter version.
{-# OPTIONS -O2 -fffi #-}
--
-- ghc MD5.hs -o hsmd5 -lcrypto
--
import System.Environment
import qualified Data.ByteString.Base as B (unsafeUseAsCStringLen)
import qualified Data.ByteString as B
import Foreign
import Foreign.C.Types
import Numeric
import Text.Printf
import Control.Monad
main = do
(f:_) <- getArgs
src <- B.readFile f
printf "MD5 (%s) = %s \n" f (md5sum src)
-- Fast md5 using OpenSSL and non-copying bytestrings
md5sum :: B.ByteString -> String
md5sum p = unsafePerformIO $ B.unsafeUseAsCStringLen p $ \(ptr,n) -> do
digest <- c_md5 ptr (fromIntegral n) nullPtr
liftM concat $ forM [0..15] $ \n -> do
w <- peekElemOff digest n
return $ case showHex w [] of [x] -> ['0', x]; x -> x
-- unsigned char *MD5(const unsigned char *d, unsigned long n, unsigned char *md);
foreign import ccall "openssl/md5.h MD5" c_md5
:: Ptr CChar -> CULong -> Ptr CChar -> IO (Ptr Word8)
ByteStrings were designed for this zero-copy passing of big data to C,
by the way, so its a perfect fit.
-- Don
More information about the Haskell-Cafe
mailing list