diff --git a/eap.cabal b/eap.cabal --- a/eap.cabal +++ b/eap.cabal @@ -1,5 +1,5 @@ name: eap -version: 0.6.0.0 +version: 0.7.0.0 synopsis: Extensible Authentication Protocol (EAP) description: This module provides types and on the wire de/coding of EAP packets as per RFC 3748 homepage: https://github.com/erickg/eap#readme diff --git a/src/Network/EAP/Authentication.hs b/src/Network/EAP/Authentication.hs --- a/src/Network/EAP/Authentication.hs +++ b/src/Network/EAP/Authentication.hs @@ -13,55 +13,64 @@ -} module Network.EAP.Authentication (authenticateMSCHAPv2, - generateNTResponse) where + generateAuthenticatorResponse, + generateNTResponse, + ntPasswordHash) where import Prelude hiding (concatMap) -import Data.Bits ((.|.), (.&.), complement, shiftL, shiftR, xor) -import Data.ByteString.Lazy (ByteString, cons, concatMap, toStrict) -import Data.ByteArray (convert) -import Control.Monad.Except (ExceptT(..), Except, throwError) -import Control.Monad.State.Lazy (execState, modify) -import Crypto.Cipher.DES (DES) -import Crypto.Cipher.Types (cipherInit, ecbEncrypt) -import Crypto.Hash.Algorithms (MD4, SHA1(..)) -import Crypto.Hash (Digest, hashFinalize, hashInitWith, hashUpdate, hashlazy) -import Crypto.Error (CryptoError, CryptoFailable(..)) +import Data.Bits ((.|.), (.&.), complement, shiftL, shiftR, xor) +import Data.ByteString.Lazy.Char8 (pack, unpack) +import Data.ByteString.Builder (toLazyByteString, byteStringHex) +import Data.ByteString.Lazy (ByteString, append, cons, concatMap, fromStrict, toStrict) +import Data.ByteArray (convert) +import Data.Char (toUpper) +import Control.Monad.Except (ExceptT(..), Except, throwError) +import Control.Monad.State.Lazy (State, execState, modify) +import Crypto.Cipher.DES (DES) +import Crypto.Cipher.Types (cipherInit, ecbEncrypt) +import Crypto.Hash.Algorithms (MD4, SHA1(..)) +import Crypto.Hash (Context, + Digest, + hashFinalize, + hashInitWith, + hashUpdate, + hashlazy) +import Crypto.Error (CryptoError, CryptoFailable(..)) import Network.EAP.Types import qualified Data.ByteString as SB -- | Authenticate the MSCHAPv2 response data to a given challenge request, using the supplied -- cleartext password. authenticateMSCHAPv2 - :: MSCHAPv2Data -- ^ Decoded data from the MSCHAPv2 response - -> ByteString -- ^ Authenticator challenge sent to the peer on a previous request - -> ByteString -- ^ Authenticating user password + :: MSCHAPv2Data -- ^ Decoded data from the MSCHAPv2 response + -> ByteString -- ^ Authenticator challenge sent to the peer on a previous request + -> SB.ByteString -- ^ Authenticating user password NT hash (MD4) -> Except CryptoError Bool -- ^ Returns either an error from one of the encryption -- routines or a boolean indicating whether the user -- response matches the expected value authenticateMSCHAPv2 MSCHAPv2ResponseData{ getMSCHAPv2ResponseData = MSCHAPv2ResponseDataField{..}, .. } challenge - password = do + passwordHash = do let peerChallenge = getMSCHAPv2ResponsePeerChallenge username = getMSCHAPv2ResponseName - r <- generateNTResponse challenge peerChallenge username password + r <- generateNTResponse challenge peerChallenge username passwordHash return $ r == toStrict getMSCHAPv2ResponseNTResponse authenticateMSCHAPv2 msCHAPv2Data _ _ = error $ "Invalid authentication attempt of " ++ show msCHAPv2Data -- | Calculate the NT Response as per [RFC2759], Section 8.1 -generateNTResponse :: ByteString -- ^ Authenticator challenge sent to the peer on a previous - -- request - -> ByteString -- ^ Challenge sent back by authenticating peer - -> ByteString -- ^ MSCHAP username - -> ByteString -- ^ Cleartext user password +generateNTResponse :: ByteString -- ^ Authenticator challenge sent to the peer on a previous + -- request + -> ByteString -- ^ Challenge sent back by authenticating peer + -> ByteString -- ^ MSCHAP username + -> SB.ByteString -- ^ NT hash (MD4) of user password -> Except CryptoError SB.ByteString -- ^ Returns either an error from one of -- the encryption routines or the -- calculated NT response -generateNTResponse authenticatorChallenge peerChallenge username password = do - let challenge = challengeHash - passwordHash = ntPasswordHash password +generateNTResponse authenticatorChallenge peerChallenge username passwordHash = do + let challenge = challengeHash peerChallenge authenticatorChallenge username zPasswordHash = passwordHash `SB.append` SB.replicate 5 0 -- pad to 21 octets (pHash0, rest) = SB.splitAt 7 zPasswordHash (pHash1, pHash2) = SB.splitAt 7 rest @@ -69,14 +78,60 @@ r1 <- encryptDES pHash1 challenge r2 <- encryptDES pHash2 challenge return $ r0 `SB.append` r1 `SB.append` r2 - where challengeHash = SB.take 8 . convert . hashFinalize . flip execState ctx0 $ do - hash peerChallenge - hash authenticatorChallenge - hash username - hash = modify . flip hashUpdate . toStrict - ctx0 = hashInitWith SHA1 - ntPasswordHash = convert . (hashlazy :: ByteString -> Digest MD4) . concatMap with0s - with0s = flip cons "\NUL" + +-- | Calculate authenticator response as per [RFC2759], Section 8.7 +generateAuthenticatorResponse :: ByteString -- ^ Username + -> ByteString -- ^ NT password hash (MD4) + -> ByteString -- ^ NT Response + -> ByteString -- ^ Authenticator challenge + -> ByteString -- ^ Peer challenge + -> Except CryptoError ByteString -- ^ Returns either an error from + -- one of the crypto routines or + -- upon success, a 42 byte + -- authenticator response +generateAuthenticatorResponse username passwordHash ntResponse authChallenge peerChallenge = do + let passwordHashHash = md4Hash passwordHash + digest1 = sha1Hash $ do + hash . fromStrict $ passwordHashHash + hash ntResponse + hash magic1 + challenge = challengeHash peerChallenge authChallenge username + digest2 = sha1Hash $ do + hash . fromStrict $ digest1 + hash . fromStrict $ challenge + hash magic2 + return $ "S=" `append` (pack . fmap toUpper . unpack . toLazyByteString $ byteStringHex digest2) + where magic1 = "Magic server to client signing constant" -- seriously Microsoft? + magic2 = "Pad to make it do more than one iteration" + +challengeHash :: ByteString -- ^ Peer challenge + -> ByteString -- ^ Authenticator challenge + -> ByteString -- ^ Username + -> SB.ByteString -- ^ Resulting SHA1 hash +challengeHash peerChallenge authenticatorChallenge username = + SB.take 8 . sha1Hash $ do + hash peerChallenge + hash authenticatorChallenge + hash username + +-- | Hash an NT ascii plain-text. Password with MD4. Note that this function converts then +-- password internally to Unicode, so feeding a Unicode password to it will *not* work +ntPasswordHash :: ByteString -> SB.ByteString +ntPasswordHash = md4Hash . concatMap with0s + where with0s = flip cons "\NUL" + +-- | Used internally to calculate an MD4 hash. +md4Hash :: ByteString -> SB.ByteString +md4Hash = convert . (hashlazy :: ByteString -> Digest MD4) + +-- | Used internally to calculate a hash digest incrementally +sha1Hash :: State (Context SHA1) () -> SB.ByteString +sha1Hash = convert . hashFinalize . flip execState ctx0 + where ctx0 = hashInitWith SHA1 + +-- | Used internally to update an incremental hash function in the state monad +hash :: ByteString -> State (Context SHA1) () +hash = modify . flip hashUpdate . toStrict -- | Used internally to encrypt a message using a DES cipher in ECB mode encryptDES :: SB.ByteString -> SB.ByteString -> Except CryptoError SB.ByteString