diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -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. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -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 diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/apache-md5.cabal b/apache-md5.cabal new file mode 100644 --- /dev/null +++ b/apache-md5.cabal @@ -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 +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 diff --git a/src/Data/Digest/ApacheMD5.hs b/src/Data/Digest/ApacheMD5.hs new file mode 100644 --- /dev/null +++ b/src/Data/Digest/ApacheMD5.hs @@ -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 +-- 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 +-- . +-- +-- 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 + -- . + + -- ** 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 diff --git a/src/Data/Digest/ApacheMD5/Internal.hs b/src/Data/Digest/ApacheMD5/Internal.hs new file mode 100644 --- /dev/null +++ b/src/Data/Digest/ApacheMD5/Internal.hs @@ -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 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) diff --git a/test/benchmark-main.hs b/test/benchmark-main.hs new file mode 100644 --- /dev/null +++ b/test/benchmark-main.hs @@ -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) diff --git a/test/unit-tests-main.hs b/test/unit-tests-main.hs new file mode 100644 --- /dev/null +++ b/test/unit-tests-main.hs @@ -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 ":$apr1$$\n" to pair (Salt,Hash) + parse :: String -> (String, String) + parse = second (drop 1) -- ("","") + . break (== '$') -- ("","$") + . drop 7 -- "$" + . dropWhile (/= ':') -- ":$apr1$$" + . takeWhile (/= '\n') -- ":$apr1$$" + +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)