packages feed

nano-md5 (empty) → 0.1

raw patch · 7 files changed

+250/−0 lines, 7 filesdep +basedep +bytestringbuild-type:Customsetup-changed

Dependencies added: base, bytestring

Files

+ Data/Digest/OpenSSL/MD5.hs view
@@ -0,0 +1,66 @@+{-# OPTIONS -#include "openssl/md5.h" #-}++--------------------------------------------------------------------+-- |+-- Module    :  Data.Digest.OpenSSL.MD5+-- Copyright :  (c) Galois, Inc. 2007+-- License   :  BSD3+-- Maintainer:  Don Stewart <dons@galois.com>+-- Stability :  provisional+-- Portability: Requires FFI+--+--------------------------------------------------------------------+--+-- | ByteString-based, zero-copying binding to OpenSSL's md5 interface+--++module Data.Digest.OpenSSL.MD5 where+++--+-- A few imports, should tidy these up one day.+--+#if __GLASGOW_HASKELL__ >= 608+import qualified Data.ByteString.Unsafe as B (unsafeUseAsCStringLen)+#else+import qualified Data.ByteString.Base   as B (unsafeUseAsCStringLen)+#endif+import qualified Data.ByteString      as B+import Foreign+import Foreign.C.Types+import Numeric                        (showHex)++--+-- | Fast md5 using OpenSSL. The md5 hash should be referentially transparent..+-- The ByteString is guaranteed not to be copied.+--+-- The result string should be identical to the output of MD5(1).+-- That is:+--+-- > $ md5 /usr/share/dict/words +-- > MD5 (/usr/share/dict/words) = e5c152147e93b81424c13772330e74b3+--+-- While this md5sum binding will return:+--+md5sum :: B.ByteString -> String+md5sum p = unsafePerformIO $ B.unsafeUseAsCStringLen p $ \(ptr,n) -> do+    digest  <- c_md5 ptr (fromIntegral n) nullPtr+    go digest 0 []+  where++    -- print it in 0-padded hex format+    go :: Ptr Word8 -> Int -> [String] -> IO String+    go !q !n acc+        | n >= 16   = return $ concat (reverse acc)+        | otherwise = do w <- peekElemOff q n+                         go q (n+1) (draw w : acc)++    draw w = 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)
+ LICENSE view
@@ -0,0 +1,27 @@+Copyright :  (c) Galois, Inc. 2007++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.
+ README view
@@ -0,0 +1,1 @@+Minimal bytestring binding to openssl's md5sum
+ Setup.lhs view
@@ -0,0 +1,3 @@+#!/usr/bin/env runhaskell+> import Distribution.Simple+> main = defaultMain
+ nano-md5.cabal view
@@ -0,0 +1,24 @@+name:                nano-md5+version:             0.1+description:         Efficient, ByteString bindings to OpenSSL.+synopsis:            Efficient, ByteString bindings to OpenSSL.+license:             BSD3+license-file:        LICENSE+homepage:            http://code.haskell.org/~dons/code/nano-md5+author:              Don Stewart +category:            Codec+maintainer:          <dons@galois.com>+Cabal-Version: >= 1.2++flag split-base+library+  if flag(split-base)+    build-depends:     base >= 3, bytestring+  else+    build-depends:     base < 3+  exposed-modules:     Data.Digest.OpenSSL.MD5+  ghc-options:    -Wall -Werror -O2 -fvia-C+  extensions:          ForeignFunctionInterface, BangPatterns, CPP+  includes:            openssl/md5.h+  extra-libraries:     crypto+
+ tests/Main.hs view
@@ -0,0 +1,62 @@+module Main where++import Test.QuickCheck+import System.IO.Unsafe+import System.IO+import System.Process+import Data.ByteString (pack)+import Data.ByteString.Char8 (unpack)+import Data.Char+import Data.Word+import System.Random+import System.Directory++import Data.Digest.OpenSSL.MD5+import Run++main = quickCheck prop_md5sum++prop_md5sum :: [Word8] -> Bool+prop_md5sum x = md5sum (pack x) == model_md5 (toString x)++toString :: [Word8] -> String+toString = unpack . pack++-- [] --> "d41d8cd98f00b204e9800998ecf8427e"++model_md5 :: String -> String+model_md5 x = unsafePerformIO $ do+        f <- do writeFile "test.txt" x+                return "test.txt"++        v <- readProcess "md5" [f] []+        removeFile f+        return $! case v of+            Left e   -> "ERROR: " ++ show e+            Right s  -> reverse. tail. takeWhile (/= ' ') . reverse $ s++            -- "MD5 (test.txt) = d41d8cd98f00b204e9800998ecf8427e\n"++{- +*Main> quickCheck prop_md5sum +OK, passed 100 tests.+-}+++------------------------------------------------------------------------++instance Arbitrary Word8 where+    arbitrary     = choose (minBound, maxBound)+    coarbitrary c = variant (fromIntegral ((fromIntegral c) `rem` 4))++instance Random Word8 where+  randomR = integralRandomR+  random = randomR (minBound,maxBound)++integralRandomR :: (Integral a, RandomGen g) => (a,a) -> g -> (a,g)+integralRandomR  (a,b) g = case randomR (fromIntegral a :: Integer,+                                         fromIntegral b :: Integer) g of+                            (x,g) -> (fromIntegral x, g)+++------------------------------------------------------------------------
+ tests/Run.hs view
@@ -0,0 +1,67 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  System.Process.Run+-- Copyright   :  (c) Don Stewart 2006+-- License     :  BSD-style (see the file libraries/base/LICENSE)+-- +-- Maintainer  :  dons@cse.unsw.edu.au+-- Stability   :  experimental+-- Portability :  currently non-portable (Control.Concurrent)+--+-- Convenient interface to external processes +--++module Run (++        -- * Running processes+        readProcess++    ) where++import System.Process+import System.Exit+import System.IO++import Control.Monad+import Control.Concurrent+import qualified Control.Exception as C++--+-- | readProcess forks an external process, reads its standard output,+-- waits for the process to terminate, and returns either the output+-- string, or an exitcode.+--+readProcess :: FilePath                     -- ^ command to run+            -> [String]                     -- ^ any arguments+            -> String                       -- ^ standard input+            -> IO (Either ExitCode String)  -- ^ either the stdout, or an exitcode++readProcess cmd args input = C.handle (return . handler) $ do++    (inh,outh,errh,pid) <- runInteractiveProcess cmd args Nothing Nothing++    -- fork off a thread to start consuming the output+    output  <- hGetContents outh+    outMVar <- newEmptyMVar+    forkIO $ C.evaluate (length output) >> putMVar outMVar ()++    -- now write and flush any input+    when (not (null input)) $ hPutStr inh input+    hClose inh          -- done with stdin+    hClose errh         -- ignore stderr++    -- wait on the output+    takeMVar outMVar+    hClose outh++    -- wait on the process+    ex <- C.catch (waitForProcess pid) (\_ -> return ExitSuccess)++    return $ case ex of+        ExitSuccess   -> Right output+        ExitFailure _ -> Left ex++  where+    handler (C.ExitException e) = Left e+    handler e                   = Left (ExitFailure 1)+