module Network.EAP.Encoding () where
import Control.Monad (when)
import Data.Binary (Binary(..), encode)
import Data.Binary.Get (Get,
getRemainingLazyByteString,
getLazyByteString,
getWord8,
getWord16be,
runGet)
import Data.Binary.Put (Put, putLazyByteString, putWord8, putWord16be, runPut)
import Data.Word (Word16)
import Network.EAP.Types
import qualified Data.ByteString.Lazy.Char8 as LB
instance Binary Packet where
put Packet{..} = do
let packetData = runPut $ putMessage getPacketType getPacketMessage
packetLength = fromIntegral $ 4 + LB.length packetData
put getPacketType
putWord8 getPacketId
putWord16be packetLength
putLazyByteString packetData
get = do
packetType <- get
packetId <- getWord8
packetLength <- getWord16be
let dataLength = packetLength 4
packetMessage <- getMessage packetType $ fromIntegral dataLength
return $ Packet packetType packetId packetMessage
getMessage :: PacketType -> Word16 -> Get (Maybe Message)
getMessage _ 0 = return Nothing
getMessage packetType dataLength = do
packetData <- getLazyByteString $ fromIntegral dataLength
return . Just $ runGet (decodeMessage packetType) packetData
putMessage :: PacketType -> Maybe Message -> Put
putMessage _ Nothing = return ()
putMessage packetType (Just msg) = encodeMessage packetType msg
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
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
putWord8 . fromIntegral . fromEnum $ op
| otherwise = do
putWord8 26
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
valueSize <- getWord8
value <- getLazyByteString $ fromIntegral valueSize
name <- getRemainingLazyByteString
return $ MD5ChallengeMessage value name
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
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
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
get = error $ "Do not use get on MSCHAPv2ResponseDataField directly. Use decodeData instead"
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