apache-md5 (empty) → 0.5.0.0
raw patch · 8 files changed
+555/−0 lines, 8 filesdep +HUnitdep +MonadRandomdep +basebuild-type:Customsetup-changed
Dependencies added: HUnit, MonadRandom, base, bytestring, criterion, process, random, test-framework, test-framework-hunit, transformers
Files
- LICENSE +30/−0
- README.md +62/−0
- Setup.hs +2/−0
- apache-md5.cabal +133/−0
- src/Data/Digest/ApacheMD5.hs +162/−0
- src/Data/Digest/ApacheMD5/Internal.hs +34/−0
- test/benchmark-main.hs +51/−0
- test/unit-tests-main.hs +81/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2009, 2010, 2012, 2013, Peter Trsko++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * 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.++ * Neither the name of Peter Trsko nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS 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 COPYRIGHT+OWNER 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.md view
@@ -0,0 +1,62 @@+Apache MD5+==========+++Description+-----------++Haskell implementation of Apache specific MD5 digest algorithm that uses+OpenSSL MD5.+++Installation+------------++Requires OpenSSL library with header files. On Debian and Ubuntu Linux it's+provided by [`libssl-dev`][libssl-dev] package that can be installed using+`apt-get`:++ $ apt-get install libssl-dev++For more see `apt-get(8)` manual page or e.g. [Ubuntu Documentation: AptGet+Howto][apt-get-howto].++After that just use [`cabal-install`][cabal-install] as you would normally do.+For details see [HaskellWiki: How to install a Cabal package][].+++Unit Tests+----------++Requires `htpasswd` command line utility installed. On Debian and Ubuntu Linux+it is provided by [`apache2-utils`][apache2-utils] package that can be+installed using `apt-get`:++ $ apt-get install apache2-utils++For more see `apt-get(8)` manual page or e.g. [Ubuntu Documentation: AptGet+Howto][apt-get-howto].++To run tests use command similar to this:++ $ cabal configure --enable-tests && cabal build && cabal test+++Contributions+-------------++Contributions, pull requests and bug reports are welcome! Please don't be+afraid to contact author using GitHub or by e-mail (see `.cabal` file for+that).+++[apt-get-howto]:+ https://help.ubuntu.com/community/AptGet/Howto+[libssl-dev]:+ http://packages.debian.org/lenny/libssl-dev+[cabal-install]:+ http://haskell.org/haskellwiki/Cabal-Install+[HaskellWiki: How to install a Cabal package]:+ http://haskell.org/haskellwiki/Cabal/How_to_install_a_Cabal_package+[apache2-utils]:+ http://packages.debian.org/stable/apache2-utils
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ apache-md5.cabal view
@@ -0,0 +1,133 @@+name: apache-md5+version: 0.5.0.0+synopsis: Apache server specific MD5 digest algorighm.+description:+ Haskell implementation of Apache HTTP server specific MD5 digest algorithm+ that uses OpenSSL @MD5()@ function.+license: BSD3+license-File: LICENSE+copyright: 2009, 2010, 2012, 2013 Peter Trško+author: Peter Trško <peter.trsko@gmail.com>+maintainer: peter.trsko@gmail.com+category: Data, Cryptography+build-Type: Custom+cabal-Version: >= 1.9.1+ -- Benchmark section is available since Cabal >= 1.9.1+extra-source-files: README.md+++flag pedantic+ description:+ Pass additional warning flags including -Werror to GHC during compilation.+ default: False++library+ hs-Source-Dirs: src+ exposed-Modules: Data.Digest.ApacheMD5+ other-Modules: Data.Digest.ApacheMD5.Internal+ build-Depends:+ base >= 4 && < 5+ , bytestring >= 0.10 && < 0.11+ includes: openssl/md5.h+ extra-Libraries: crypto++ ghc-options: -Wall+ if impl(ghc >= 6.8)+ ghc-options: -fwarn-tabs+ if flag(pedantic)+ ghc-options: -Werror++test-suite apache-md5-unit-tests+ hs-source-dirs: src, test+ type: exitcode-stdio-1.0+ main-is: unit-tests-main.hs+ other-modules:+ Data.Digest.ApacheMD5+ , Data.Digest.ApacheMD5.Internal++ build-depends:+ base >= 4 && < 5+ , bytestring >= 0.10 && < 0.11+ , transformers < 0.4++ , MonadRandom+ , process+ , random++ -- Test dependencies:+ , HUnit >= 1.2 && < 2+ -- ^ Same constraints as test-framework-hunit+ -- , QuickCheck >= 2.4 && < 2.6+ -- ^ Same constraints as test-framework-quickcheck2+ , test-framework >= 0.8 && < 1+ -- ^ Same constraint as test-framework-skip, other packages that+ -- depend on it have less restrictive bounds.+ , test-framework-hunit >= 0.2.6+ -- ^ Lower versions have more restrictive bounds on test-framework.+ -- , test-framework-quickcheck2 >= 0.3+ -- ^ There were changes in QuickCheck bounds in 0.2 branch and last one+ -- on it had a compilation failure on Hackage.++ -- Not required right now:+ -- , test-framework-skip == 1.*+ -- ^ Currently there is only version 1.0.++ Includes: openssl/md5.h+ Extra-Libraries: crypto++ ghc-options: -Wall+ if impl(ghc >= 6.8)+ ghc-options: -fwarn-tabs+ if flag(pedantic)+ ghc-options: -Werror++benchmark apache-md5-benchmark+ hs-source-dirs: src, test+ type: exitcode-stdio-1.0+ main-is: benchmark-main.hs+ other-modules:+ Data.Digest.ApacheMD5+ , Data.Digest.ApacheMD5.Internal++ build-depends:+ base >= 4 && < 5+ , bytestring >= 0.10 && < 0.11++ , criterion+ , MonadRandom++ -- Test dependencies:+ , HUnit >= 1.2 && < 2+ -- ^ Same constraints as test-framework-hunit+ -- , QuickCheck >= 2.4 && < 2.6+ -- ^ Same constraints as test-framework-quickcheck2+ , test-framework >= 0.8 && < 1+ -- ^ Same constraint as test-framework-skip, other packages that+ -- depend on it have less restrictive bounds.+ , test-framework-hunit >= 0.2.6+ -- ^ Lower versions have more restrictive bounds on test-framework.+ -- , test-framework-quickcheck2 >= 0.3+ -- ^ There were changes in QuickCheck bounds in 0.2 branch and last one+ -- on it had a compilation failure on Hackage.++ -- Not required right now:+ -- , test-framework-skip == 1.*+ -- ^ Currently there is only version 1.0.++ includes: openssl/md5.h+ extra-libraries: crypto++ ghc-options: -Wall+ if impl(ghc >= 6.8)+ ghc-options: -fwarn-tabs+ if flag(pedantic)+ ghc-options: -Werror++source-repository head+ type: git+ location: git://github.com/trskop/apache-md5.git++source-repository this+ type: git+ location: git://github.com/trskop/apache-md5.git+ tag: v0.5.0.0
+ src/Data/Digest/ApacheMD5.hs view
@@ -0,0 +1,162 @@+{-# LANGUAGE BangPatterns #-}+-- |+-- Module: Data.Digest.ApacheMD5+-- Copyright: (c) 2009, 2010, 2012, 2013 Peter Trško+-- License: BSD3+-- Maintainer: Peter Trško <peter.trsko@gmail.com>+-- Stability: Provisional+-- Portability: non-portable (BangPatterns)+--+-- ApacheMD5 is one of the hash algorithms used by Apache HTTP server for basic+-- authentication. It is Apache specific, but e.g. nginx supports this+-- algorithm since version 1.0.3+-- <http://wiki.nginx.org/HttpAuthBasicModule#auth_basic_user_file>.+--+-- This is a naive implementation that doesn't aim for high speed, but to be+-- reasonably fast it uses @MD5()@ function from OpenSSL library so during+-- compilation you'll nead to have it installed including header files.+-- Many Linux distributions have separate dev packages for this.+module Data.Digest.ApacheMD5+ (+ -- * Htpasswd+ --+ -- | Apache comes with utility named @htpasswd@ that allows to create,+ -- delete and update flat files normally named @.htpasswd@ that store pairs+ -- of usernames and passwords. While both this utility and Apache support+ -- more algorithms most of them rely on UNIX @crypt()@ function. ApacheMD5+ -- is not one of them and therefore it is suitable for cross-platform+ -- usage. See also @htpasswd@ documentation on+ -- <http://httpd.apache.org/docs/current/programs/htpasswd.html>.++ -- ** Example: Creating htpasswd-like entry+ --+ -- | Output of this function is not identical to what @htpasswd@ does. To+ -- create @htpasswd@-like entry do:+ --+ -- > import Data.ByteString (ByteString)+ -- > import qualified Data.ByteString.Char8 as C8 (concat, pack, singleton)+ -- > import Data.Digest.ApacheMD5 (apacheMD5)+ -- >+ -- > htpasswdEntry :: ByteString -> ByteString -> ByteString -> ByteString+ -- > htpasswdEntry username password salt = C8.concat+ -- > [ username+ -- > , C8.pack ":$apr1$"+ -- > , salt+ -- > , C8.singleton '$'+ -- > , apacheMD5 password salt+ -- > ]++ -- * API Documentation+ apacheMD5+ , apacheMD5'+ , alpha64+ , encode64+ , md5DigestLength+ )+ where++import Data.Bits (Bits((.|.), (.&.), shiftL, shiftR))+import Data.Word (Word8, Word16, Word32)++import Data.ByteString (ByteString)+import qualified Data.ByteString as BS+ ( append+ , concat+ , cons+ , empty+ , head+ , index+ , length+ , null+ , pack+ , take+ )+import qualified Data.ByteString.Char8 as C8 (pack)++import Data.Digest.ApacheMD5.Internal (md5BS, md5DigestLength)+++-- | Taking password and salt this function produces resulting ApacheMD5 hash+-- which is already base 64 encoded.+apacheMD5 :: ByteString -> ByteString -> ByteString+apacheMD5 = (encode64 .) . apacheMD5' md5BS++-- | Raw Apache MD5 implementation that is parametrized by MD5 implementation+-- and doesn't encode result in to base 64.+apacheMD5'+ :: (ByteString -> ByteString)+ -- ^ MD5 hash function.+ -> ByteString+ -- ^ Password+ -> ByteString+ -- ^ Salt+ -> ByteString+ -- ^ Apache MD5 Hash+apacheMD5' md5 !password !salt = g . f . md5 $ password <> salt <> password+ where+ (<>) = BS.append++ f :: ByteString -> ByteString+ f !digest = md5 $ password <> C8.pack "$apr1$" <> salt+ <> BS.concat (replicate (passwordLength `div` md5DigestLength) digest)+ <> BS.take (passwordLength `rem` md5DigestLength) digest+ <> f' pwHead passwordLength+ where+ !passwordLength = BS.length password+ pwHead = if BS.null password then 0 else BS.head password+ -- Consistent with htpasswd implementation.++ f' :: Word8 -> Int -> ByteString+ f' !pwhead !i+ | i == 0 = BS.empty+ | otherwise = (if i .&. 1 == 1 then 0 else pwhead)+ `BS.cons` f' pwhead (i `shiftR` 1)++ g :: ByteString -> ByteString+ g = g' 0+ where+ -- Iterate this function 1000 times, starting with 0 and ending with+ -- 999.+ g' :: Word16 -> ByteString -> ByteString+ g' !i !digest+ | i < 1000 = g' (i + 1) . md5+ $ (if i .&. 1 == 1 then password else digest)+ <> (if i `mod` 3 > 0 then salt else BS.empty)+ <> (if i `mod` 7 > 0 then password else BS.empty)+ <> (if i .&. 1 == 1 then digest else password)+ | otherwise = digest++-- | Alphabet used by 'encode64'.+alpha64 :: ByteString+alpha64 = C8.pack+ "./0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"++encode64 :: ByteString -> ByteString+encode64 str = BS.pack $ concatMap (encode64' str)+ -- Index --. ,-- Shift bits left this much+ -- V V+ [ (4, [( 0, 16), ( 6, 8), (12, 0)])+ , (4, [( 1, 16), ( 7, 8), (13, 0)])+ , (4, [( 2, 16), ( 8, 8), (14, 0)])+ , (4, [( 3, 16), ( 9, 8), (15, 0)])+ , (4, [( 4, 16), (10, 8), ( 5, 0)])+ , (2, [(11, 0) ])+ -- ^ `-----------. ,------------'+ -- | V+ -- | Do bitwise OR on results+ -- |+ -- `-- How many characters from alpa64+ -- will be used to encode the row.+ ]+ where+ encode64' :: ByteString -> (Int, [(Int, Int)]) -> [Word8]+ encode64' !s (!n, xs) =+ to64 n . foldl1 (.|.) . (`map` xs) $ \ (!i, !t) ->+ conv (s `BS.index` i) `shiftL` t++ conv :: (Integral i, Num n, Integral n, Bits n) => i -> n+ conv = fromInteger . toInteger++ to64 :: Int -> Word32 -> [Word8]+ to64 !n !c = take n . map ((alpha64 `BS.index`) . conv . (.&. 0x3f))+ $ iterate (`shiftR` 6) c
+ src/Data/Digest/ApacheMD5/Internal.hs view
@@ -0,0 +1,34 @@+{-# LANGUAGE ForeignFunctionInterface #-}+module Data.Digest.ApacheMD5.Internal+ ( md5BS+ , md5DigestLength+ )+ where++import Control.Monad (void)+import Data.Word (Word8)+import Foreign (Ptr)+import Foreign.C.Types (CChar(..), CULong(..))+import System.IO.Unsafe (unsafePerformIO)++import Data.ByteString (ByteString)+import qualified Data.ByteString.Internal as BS (create)+import qualified Data.ByteString.Unsafe as BS (unsafeUseAsCStringLen)+++-- Inspired by nano-md5 <http://hackage.haskell.org/package/nano-md5> package+-- by Don Stewart+--+-- From MD5(3SSL) man page:+--+-- 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 Word8 -> IO (Ptr Word8)++md5DigestLength :: Int+md5DigestLength = 16++md5BS :: ByteString -> ByteString+md5BS bs = unsafePerformIO . BS.unsafeUseAsCStringLen bs $ \ (ptr, len) ->+ BS.create md5DigestLength $ void . c_md5 ptr (fromIntegral len)
+ test/benchmark-main.hs view
@@ -0,0 +1,51 @@+{-# LANGUAGE BangPatterns #-}+module Main+ where++import Control.Applicative ((<$>))+import Control.Arrow ((***), first)+import Control.Monad (replicateM)+import Data.Word (Word8)++import Control.Monad.Random+import Criterion.Main+import qualified Data.ByteString as BS+import qualified Data.ByteString.Char8 as C8++import Data.Digest.ApacheMD5 (alpha64, apacheMD5)+++genSalt :: RandT StdGen IO [Word8]+genSalt = replicateM 8 $ BS.index alpha64 <$> getRandomR (0, 63)++genPassword :: Int -> RandT StdGen IO String+genPassword len = replicateM len (getRandomR ('!', '~'))++genData :: Int -> RandT StdGen IO ([Word8], String)+genData len = do+ s <- genSalt+ p <- genPassword len+ return (s, p)++main :: IO ()+main = do+ (!inputData8, _) <- genData' 8+ (!inputData16, _) <- genData' 16+ (!inputData32, _) <- genData' 32+ (!inputData64, _) <- genData' 64+ (!inputData128, _) <- genData' 128+ (!inputData256, _) <- genData' 256++ defaultMain+ [ bench "Random passwords of length 8" $ test inputData8+ , bench "Random passwords of length 16" $ test inputData16+ , bench "Random passwords of length 32" $ test inputData32+ , bench "Random passwords of length 64" $ test inputData64+ , bench "Random passwords of length 128" $ test inputData128+ , bench "Random passwords of length 256" $ test inputData256+ ]+ where+ test = nf $ uncurry apacheMD5++ genData' n = getStdGen+ >>= (first (BS.pack *** C8.pack) <$>) . runRandT (genData n)
+ test/unit-tests-main.hs view
@@ -0,0 +1,81 @@+module Main (main)+ where++import Control.Arrow ((***), second)+import Control.Monad (replicateM, replicateM_, void, when)+import Control.Monad.IO.Class (liftIO)+import Control.Monad.Random+import qualified Data.ByteString.Char8 as C8+import System.Exit (ExitCode(..))+import System.Process (readProcessWithExitCode)+import Test.Framework+import Test.Framework.Providers.HUnit+import Test.HUnit++import Data.Digest.ApacheMD5 (apacheMD5)+++-- Settings -------------------------------------------------------------------++numberOfTests :: Int+numberOfTests = 1000++maxPasswordLength :: Int+maxPasswordLength = 255++runHtpasswd+ :: String+ -- ^ Password+ -> IO (String, String)+ -- ^ (Salt, Hash)+runHtpasswd password = do+ (ec,out,err) <- readProcessWithExitCode "htpasswd"+ ["-nbm", "foo", password] ""+ -- ^^^^^ Username is irelevant+ when (ec /= ExitSuccess)+ -- Missing command, ...+ . error $ unlines+ [ "Command htpasswd returned: "+ , err+ , show ec+ ]+ return $ parse out+ where+ -- Split "<username>:$apr1$<salt>$<hash>\n" to pair (Salt,Hash)+ parse :: String -> (String, String)+ parse = second (drop 1) -- ("<salt>","<hash>")+ . break (== '$') -- ("<salt>","$<hash>")+ . drop 7 -- "<salt>$<hash>"+ . dropWhile (/= ':') -- ":$apr1$<salt>$<hash>"+ . takeWhile (/= '\n') -- "<username>:$apr1$<salt>$<hash>"++testApacheMD5' :: (String -> String -> String) -> Int -> RandT StdGen IO ()+testApacheMD5' toTest n = replicateM_ n $ do+ password <- genPassword+ (salt, hash) <- liftIO $ runHtpasswd password++ liftIO $ assertEqual (msg salt password) hash+ $ toTest password salt+ where+ msg :: String -> String -> String+ msg s p = concat+ [ "Hash does not match for salt = "+ , show s+ , " and password "+ , show p+ ]++ genPassword :: RandT StdGen IO String+ genPassword = getRandomR (0, maxPasswordLength)+ >>= flip replicateM (getRandomR ('!', '~'))++testApacheMD5 :: (String -> String -> String) -> Int -> Assertion+testApacheMD5 f n = void $ getStdGen >>= runRandT (testApacheMD5' f n)++main :: IO ()+main = defaultMain . hUnitTestToTests $ TestList+ [ TestLabel ("apacheMD5 (" ++ show numberOfTests ++ " tests)")+ . TestCase $ testApacheMD5 apacheMD5' numberOfTests+ ]+ where+ apacheMD5' = curry $ C8.unpack . uncurry apacheMD5 . (C8.pack *** C8.pack)