eap 0.1.0.0 → 0.6.0.0

raw patch · 5 files changed

+328/−33 lines, 5 filesdep +cryptonitedep +memorydep +mtlPVP ok

version bump matches the API change (PVP)

Dependencies added: cryptonite, memory, mtl, pretty-hex

API changes (from Hackage documentation)

Files

• README.md +2/−1
• eap.cabal +7/−2
• src/Network/EAP/Authentication.hs +102/−0
• src/Network/EAP/Encoding.hs +147/−29
• src/Network/EAP/Types.hs +70/−1

@@ -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

@@ -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 

@@ -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

@@ -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

@@ -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