diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,1 +1,2 @@ -# eap +# Extensible Authentication Protocol - EAP +This module provides types and definitions as well as on the wire encoding and decoding of EAP packets and messages as per RFC 3748 diff --git a/eap.cabal b/eap.cabal --- a/eap.cabal +++ b/eap.cabal @@ -1,5 +1,5 @@ name: eap -version: 0.1.0.0 +version: 0.6.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 @@ -15,11 +15,16 @@ library hs-source-dirs: src - exposed-modules: Network.EAP.Encoding + exposed-modules: Network.EAP.Authentication + , Network.EAP.Encoding , Network.EAP.Types build-depends: base >= 4.7 && < 5 , binary , bytestring + , cryptonite + , memory + , mtl + , pretty-hex default-language: Haskell2010 ghc-options: -Wall diff --git a/src/Network/EAP/Authentication.hs b/src/Network/EAP/Authentication.hs new file mode 100644 --- /dev/null +++ b/src/Network/EAP/Authentication.hs @@ -0,0 +1,102 @@ +{-# LANGUAGE NamedFieldPuns, RecordWildCards, OverloadedStrings, ScopedTypeVariables #-} +{-| +Module : Network.EAP.Authentication +Description : Collection of EAP authentication methods and related utility functions +Copyright : (c) Erick Gonzalez, 2017 +License : BSD3 +Maintainer : erick@codemonkeylabs.de +Stability : experimental +Portability : POSIX + +This module provides functions implements EAP authentication schemes. New authentication types +will be added as needed and contributions are very welcome. + +-} +module Network.EAP.Authentication (authenticateMSCHAPv2, + generateNTResponse) 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 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 + -> 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 + let peerChallenge = getMSCHAPv2ResponsePeerChallenge + username = getMSCHAPv2ResponseName + r <- generateNTResponse challenge peerChallenge username password + 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 + -> 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 + zPasswordHash = passwordHash `SB.append` SB.replicate 5 0 -- pad to 21 octets + (pHash0, rest) = SB.splitAt 7 zPasswordHash + (pHash1, pHash2) = SB.splitAt 7 rest + r0 <- encryptDES pHash0 challenge + 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" + +-- | Used internally to encrypt a message using a DES cipher in ECB mode +encryptDES :: SB.ByteString -> SB.ByteString -> Except CryptoError SB.ByteString +encryptDES key msg = do + (cipher :: DES) <- ExceptT . return $ initCipher + ExceptT . return . Right $ ecbEncrypt cipher msg + where initCipher = case cipherInit $ addParity key of + CryptoFailed e -> throwError e + CryptoPassed c -> Right c + +-- | Used internally to add the parity bits to a 56 bit (7 octet key) thus becoming an 8 +-- octet key +addParity :: SB.ByteString -> SB.ByteString +addParity = expand . SB.foldl f ((0, 0), SB.empty) + where f ((i, carry), acc) word = + let v = carry .|. (word `shiftR` i) + carry' = word `shiftL` (7 - i) + v' = v .&. 0xfe + v'' = v' .|. (complement $ parity v') .&. 1 + acc' = acc `SB.snoc` v'' + in ((i+1, carry'), acc') + expand ((_, carry), str) = str `SB.snoc` carry + parity x0 = foldl (\x i -> x `xor` (x `shiftR` i)) x0 [1, 2, 4, 8, 16] .&. 1 diff --git a/src/Network/EAP/Encoding.hs b/src/Network/EAP/Encoding.hs --- a/src/Network/EAP/Encoding.hs +++ b/src/Network/EAP/Encoding.hs @@ -9,20 +9,22 @@ Stability : experimental Portability : POSIX -This basically provides Binary instances for the EAP Packet type and the embedded messages it -encapsulates. So you basically decode a (lazy) bytestring and get an EAP Packet back or you can +This module provides Binary instances for the EAP Packet type and the embedded messages it +encapsulates. So you decode a (lazy) bytestring and get an EAP Packet back or you can encode an EAP packet to ByteString you can send on the wire as is. Simple as that. -} -module Network.EAP.Encoding where +module Network.EAP.Encoding () where -import Data.Binary (Binary(..), encode, decode) +import Control.Monad (when) +import Data.Binary (Binary(..), encode) import Data.Binary.Get (Get, getRemainingLazyByteString, getLazyByteString, getWord8, - getWord16be) -import Data.Binary.Put (putLazyByteString, putWord8, putWord16be) + getWord16be, + runGet) +import Data.Binary.Put (Put, putLazyByteString, putWord8, putWord16be, runPut) import Data.Word (Word16) import Network.EAP.Types @@ -30,7 +32,7 @@ instance Binary Packet where put Packet{..} = do - let packetData = encode getPacketMessage + let packetData = runPut $ putMessage getPacketType getPacketMessage packetLength = fromIntegral $ 4 + LB.length packetData -- EAP header length is 4 bytes put getPacketType putWord8 getPacketId @@ -42,43 +44,159 @@ packetId <- getWord8 packetLength <- getWord16be let dataLength = packetLength - 4 - packetMessage <- getMessage $ fromIntegral dataLength + packetMessage <- getMessage packetType $ fromIntegral dataLength return $ Packet packetType packetId packetMessage -- | Given the length of data to decode, decode an EAP message in the Get Monad. Used internally -- so you probably don't need to use this. -getMessage :: Word16 -> Get (Maybe Message) -getMessage 0 = return Nothing -getMessage dataLength = do +getMessage :: PacketType -> Word16 -> Get (Maybe Message) +getMessage _ 0 = return Nothing +getMessage packetType dataLength = do packetData <- getLazyByteString $ fromIntegral dataLength - return . Just . decode $ packetData + return . Just $ runGet (decodeMessage packetType) packetData -instance Binary Message where - put (IdentityMessage str) = putLazyByteString str - put (NotificationMessage str) = putLazyByteString str - put (NakMessage value) = putWord8 value - put MD5ChallengeMessage{..} = do - putWord8 . fromIntegral . LB.length $ getMD5ChallengeValue - putLazyByteString getMD5ChallengeValue - putLazyByteString getMD5ChallengeName - put (OTPMessage str) = putLazyByteString str - put (GenericTokenCardMessage str) = putLazyByteString str +-- | Given Maybe an EAP message to encode, do so in the Put Monad. Used internally. This is +-- necessary cause if one was to put the Maybe value directly on the wire, it would include the +-- coding for the Maybe type itself, as opposed to empty or *just* the data which is what we want +putMessage :: PacketType -> Maybe Message -> Put +putMessage _ Nothing = return () +putMessage packetType (Just msg) = encodeMessage packetType msg - get = do +encodeMessage :: PacketType -> Message -> Put +encodeMessage _ (IdentityMessage str) = putWord8 1 >> putLazyByteString str +encodeMessage _ (NotificationMessage str) = putWord8 2 >> putLazyByteString str +encodeMessage _ (NakMessage value) = putWord8 3 >> putWord8 value +encodeMessage _ MD5ChallengeMessage{..} = do + putWord8 4 -- MD5 Challenge + putWord8 . fromIntegral . LB.length $ getMD5ChallengeValue + putLazyByteString getMD5ChallengeValue + putLazyByteString getMD5ChallengeName +encodeMessage _ (OTPMessage str) = putWord8 5 >> putLazyByteString str +encodeMessage _ (GenericTokenCardMessage str) = putWord8 6 >> putLazyByteString str +encodeMessage packetType (MSCHAPv2Message op iD _len msgData) + | op == MSCHAPv2Success || op == MSCHAPv2Failure, packetType == ResponsePacket = do + putWord8 26 -- MSCHAPv2 + putWord8 . fromIntegral . fromEnum $ op + | otherwise = do + putWord8 26 -- MSCHAPv2 + putWord8 . fromIntegral . fromEnum $ op + putWord8 iD + let bytes = encode msgData + msgLen = fromIntegral $ 4 + LB.length bytes + putWord16be msgLen + putLazyByteString bytes + +decodeMessage :: PacketType -> Get Message +decodeMessage packetType = do messageType <- getWord8 getMessage' messageType - where getMessage' 1 = getRemainingLazyByteString >>= return . IdentityMessage - getMessage' 2 = getRemainingLazyByteString >>= return . NotificationMessage - getMessage' 3 = getWord8 >>= return . NakMessage - getMessage' 4 = do + where getMessage' 1 = getRemainingLazyByteString >>= return . IdentityMessage + getMessage' 2 = getRemainingLazyByteString >>= return . NotificationMessage + getMessage' 3 = getWord8 >>= return . NakMessage + getMessage' 4 = do valueSize <- getWord8 value <- getLazyByteString $ fromIntegral valueSize name <- getRemainingLazyByteString return $ MD5ChallengeMessage value name - getMessage' 5 = getRemainingLazyByteString >>= return . OTPMessage - getMessage' 6 = getRemainingLazyByteString >>= return . GenericTokenCardMessage + getMessage' 5 = getRemainingLazyByteString >>= return . OTPMessage + getMessage' 6 = getRemainingLazyByteString >>= return . GenericTokenCardMessage + getMessage' 26 = do + op <- getWord8 >>= return . toEnum . fromIntegral + if packetType == ResponsePacket && (op == MSCHAPv2Success || op == MSCHAPv2Failure) + then return $ MSCHAPv2Message op 0 0 MSCHAPv2NoData + else do + iD <- getWord8 + len <- getWord16be + let dataLen = fromIntegral $ len - 4 + when (dataLen < 0) $ error $ "Invalid MSCHAPv2 data length: " ++ show dataLen + bytes <- getLazyByteString dataLen + return $ MSCHAPv2Message op iD len $ runGet (decodeData op) bytes getMessage' n = fail $ "Invalid EAP Message Type " ++ show n instance Binary PacketType where put = putWord8 . fromIntegral . fromEnum get = getWord8 >>= return . toEnum . fromIntegral + +instance Binary MSCHAPv2Data where + put MSCHAPv2ChallengeData{..} + | msCHAPv2ChallengeLen == 16 = do + putWord8 . fromIntegral $ msCHAPv2ChallengeLen + putLazyByteString getMSCHAPv2Challenge + putLazyByteString getMSCHAPv2ChallengeName + | otherwise = error $ "Illegal MSCHAPv2 challenge length " ++ (show msCHAPv2ChallengeLen) + where msCHAPv2ChallengeLen = LB.length getMSCHAPv2Challenge + put MSCHAPv2ResponseData{..} = do + putWord8 49 -- fixed length as per RFC + put getMSCHAPv2ResponseData + put getMSCHAPv2ResponseName + put MSCHAPv2SuccessRequestData{..} = + putLazyByteString getMSCHAPv2SuccessRequestMessage + put MSCHAPv2FailureRequestData{..} = + putLazyByteString getMSCHAPv2FailureRequestMessage + put MSCHAPv2ChangePasswordData{..} = + if LB.length getMSCHAPv2EncryptedPassword /= 516 then + error $ "Invalid MSCHAPv2 encrypted password length " + ++ (show $ LB.length getMSCHAPv2EncryptedPassword) + else if LB.length getMSCHAPv2EncryptedHash /= 16 then + error $ "Invalid MSCHAPv2 encrypted hash length " + ++ (show $ LB.length getMSCHAPv2EncryptedHash) + else if LB.length getMSCHAPv2PeerChallenge /= 16 then + error $ "Invalid MSCHAPv2 peer challenge length " + ++ (show $ LB.length getMSCHAPv2PeerChallenge) + else if LB.length getMSCHAPv2NTResponse /= 24 then + error $ "Invalid MSCHAPv2 NT Response length " + ++ (show $ LB.length getMSCHAPv2NTResponse) + else do + putLazyByteString getMSCHAPv2EncryptedPassword + putLazyByteString getMSCHAPv2EncryptedHash + putLazyByteString getMSCHAPv2PeerChallenge + putLazyByteString $ LB.replicate 8 '\NUL' + putLazyByteString getMSCHAPv2NTResponse + putWord16be 0 -- flags unused + put MSCHAPv2NoData = return () + get = error "Impossible to decode MSCHAPv2 message data for an unknown opcode. Use decodeData" + +instance Binary MSCHAPv2ResponseDataField where + put MSCHAPv2ResponseDataField{..} + | dataLength == 49 = do + putLazyByteString getMSCHAPv2ResponsePeerChallenge + putLazyByteString getMSCHAPv2ResponseNTResponse + | otherwise = error $ "Invalid MSCHAPv2 Response Data length: " ++ show dataLength + where dataLength = LB.length getMSCHAPv2ResponsePeerChallenge + + LB.length getMSCHAPv2ResponseNTResponse + + 9 -- reserved 8 bytes + flags octet + get = error $ "Do not use get on MSCHAPv2ResponseDataField directly. Use decodeData instead" + +-- | Used internally to decode MSCHAPv2Data since it is not possible to do so in the Get Monad +-- cause the data itself is meaningless without the opcode of the enclosing packet. You normally +-- wouldn't need this. +decodeData :: MSCHAPv2OpCode -> Get MSCHAPv2Data +decodeData MSCHAPv2Challenge = do + valueLen <- getWord8 + when (valueLen /= 16) $ error $ "Invalid MSCHAPv2 Challenge length " ++ show valueLen + challenge <- getLazyByteString 16 + name <- getRemainingLazyByteString + return $ MSCHAPv2ChallengeData challenge name +decodeData MSCHAPv2Response = do + valueLen <- getWord8 + when (valueLen /= 49) $ error $ "Invalid MSCHAPv2 Response value length " ++ show valueLen + challenge <- getLazyByteString 16 + _reserved <- getLazyByteString 8 + ntResponse <- getLazyByteString 24 + _flagsUnused <- getWord8 + let msCHAPv2ResponseData = MSCHAPv2ResponseDataField challenge ntResponse + name <- getRemainingLazyByteString + return $ MSCHAPv2ResponseData msCHAPv2ResponseData name +decodeData MSCHAPv2Success = do + msg <- getRemainingLazyByteString + return $ MSCHAPv2SuccessRequestData msg +decodeData MSCHAPv2Failure = do + msg <- getRemainingLazyByteString + return $ MSCHAPv2FailureRequestData msg +decodeData MSCHAPv2ChangePassword = do + password <- getLazyByteString 516 + hash <- getLazyByteString 16 + challenge <- getLazyByteString 16 + _reserved <- getLazyByteString 8 + ntResponse <- getLazyByteString 24 + return $ MSCHAPv2ChangePasswordData password hash challenge ntResponse diff --git a/src/Network/EAP/Types.hs b/src/Network/EAP/Types.hs --- a/src/Network/EAP/Types.hs +++ b/src/Network/EAP/Types.hs @@ -11,12 +11,15 @@ The types in this module are pretty much self explanatory. See RFC 3748 for further information on what a given type or definition means. +Note that not nearly all 50+ EAP authentication types are supported. Contributions for further +types are definitely welcome. + -} module Network.EAP.Types where import Data.ByteString.Lazy.Char8 (ByteString) import Data.Data (Data) -import Data.Word (Word8) +import Data.Word (Word8, Word16) data Packet = Packet { getPacketType :: PacketType, getPacketId :: Word8, @@ -47,4 +50,70 @@ getMD5ChallengeName :: ByteString } | OTPMessage { getOTPMessage :: ByteString } | GenericTokenCardMessage { getGenericTokenCardMessage :: ByteString } + | MSCHAPv2Message { getMSCHAPv2OpCode :: MSCHAPv2OpCode, + getMSCHAPv2Id :: Word8, + getMSCHAPv2Length :: Word16, + getMSCHAPv2Data :: MSCHAPv2Data } deriving (Show, Eq, Data) + +data AuthType = MD5ChallengeAuth + | OTPAuth + | GenericTokenCardAuth + | RSAPubKeyAuth + | TLSAuth + | MSCHAPv2Auth + deriving (Show, Eq, Data) + +data MSCHAPv2OpCode = MSCHAPv2Challenge + | MSCHAPv2Response + | MSCHAPv2Success + | MSCHAPv2Failure + | MSCHAPv2ChangePassword + deriving (Show, Eq, Data) + +data MSCHAPv2Data = MSCHAPv2ChallengeData { getMSCHAPv2Challenge :: ByteString, + getMSCHAPv2ChallengeName :: ByteString } + | MSCHAPv2ResponseData { getMSCHAPv2ResponseData :: MSCHAPv2ResponseDataField, + getMSCHAPv2ResponseName :: ByteString } + | MSCHAPv2SuccessRequestData { getMSCHAPv2SuccessRequestMessage :: ByteString } + | MSCHAPv2FailureRequestData { getMSCHAPv2FailureRequestMessage :: ByteString } + | MSCHAPv2ChangePasswordData { getMSCHAPv2EncryptedPassword :: ByteString, + getMSCHAPv2EncryptedHash :: ByteString, + getMSCHAPv2PeerChallenge :: ByteString, + getMSCHAPv2NTResponse :: ByteString } + | MSCHAPv2NoData + deriving (Show, Eq, Data) + +data MSCHAPv2ResponseDataField = + MSCHAPv2ResponseDataField { getMSCHAPv2ResponsePeerChallenge :: ByteString, + getMSCHAPv2ResponseNTResponse :: ByteString } + deriving (Show, Eq, Data) + +instance Enum AuthType where + toEnum 4 = MD5ChallengeAuth + toEnum 5 = OTPAuth + toEnum 6 = GenericTokenCardAuth + toEnum 9 = RSAPubKeyAuth + toEnum 10 = RSAPubKeyAuth + toEnum 13 = TLSAuth + toEnum 26 = MSCHAPv2Auth + toEnum x = error $ "Unknown EAP authentication type " ++ show x + fromEnum MD5ChallengeAuth = 4 + fromEnum OTPAuth = 5 + fromEnum GenericTokenCardAuth = 6 + fromEnum RSAPubKeyAuth = 9 + fromEnum TLSAuth = 13 + fromEnum MSCHAPv2Auth = 26 + +instance Enum MSCHAPv2OpCode where + toEnum 1 = MSCHAPv2Challenge + toEnum 2 = MSCHAPv2Response + toEnum 3 = MSCHAPv2Success + toEnum 4 = MSCHAPv2Failure + toEnum 7 = MSCHAPv2ChangePassword + toEnum x = error $ "Unknown MSCHAPv2 Op Code: " ++ show x + fromEnum MSCHAPv2Challenge = 1 + fromEnum MSCHAPv2Response = 2 + fromEnum MSCHAPv2Success = 3 + fromEnum MSCHAPv2Failure = 4 + fromEnum MSCHAPv2ChangePassword = 7