module Network.RADIUS.Microsoft (encodeMPPESendKeyAttribute,
encodeMPPERecvKeyAttribute,
encodeMPPEEncryptionPolicyAttribute,
encodeMPPEEncryptionTypesAttribute) where
import Prelude hiding (zipWith)
import Crypto.Hash.Algorithms (MD5)
import Crypto.Hash (Digest, hash)
import Data.Binary.Put (Put, putByteString, putWord8, putWord16be, runPut, putWord32be)
import Data.Bits ((.|.), xor)
import Data.ByteArray (convert)
import Data.ByteString (ByteString, pack, zipWith)
import Data.ByteString.Internal (w2c)
import Data.Monoid ((<>))
import Data.Word (Word8, Word16, Word32)
import Network.RADIUS.Types
import qualified Data.ByteString.Lazy.Char8 as LB
import qualified Data.ByteString.Char8 as B
vendorSpecificAttribute :: LB.ByteString -> PacketAttribute
vendorSpecificAttribute = VendorSpecificAttribute 311
encodeMPPESendKeyAttribute :: Word16
-> ByteString
-> ByteString
-> ByteString
-> PacketAttribute
encodeMPPESendKeyAttribute salt key secret authenticator =
vendorSpecificAttribute . runPut $ encodeMPPEKeyAttribute 16 salt key secret authenticator
encodeMPPERecvKeyAttribute :: Word16
-> ByteString
-> ByteString
-> ByteString
-> PacketAttribute
encodeMPPERecvKeyAttribute salt key secret authenticator =
vendorSpecificAttribute . runPut $ encodeMPPEKeyAttribute 17 salt key secret authenticator
encodeMPPEKeyAttribute :: Word8
-> Word16
-> ByteString
-> ByteString
-> ByteString
-> Put
encodeMPPEKeyAttribute vendorType salt key secret authenticator = do
putWord8 vendorType
let salt' = LB.toStrict . runPut . putWord16be $ salt .|. 0x8000
keyLength = w2c . fromIntegral $ B.length key
str = B.cons keyLength key
n = B.length str `mod` 16
m = if n == 0 then 0 else 16 n
str' = str <> B.replicate m '\NUL'
(_,result) = foldl encrypt ((authenticator <> salt'), B.empty) $ partition 16 str'
vendorLen = fromIntegral $ 4 + B.length result
putWord8 vendorLen
putByteString salt'
putByteString result
where md5 = convert . (hash :: ByteString -> Digest MD5)
partition n = partition' [] n
partition' acc _ "" = reverse acc
partition' acc n str =
let (x, xs) = B.splitAt n str
in partition' (x:acc) n xs
encrypt (bytes, acc) chunk =
let c = pack $ zipWith xor chunk (md5 $ secret <> bytes)
in (c, acc <> c)
encodeMPPEEncryptionPolicyAttribute :: Word32
-> PacketAttribute
encodeMPPEEncryptionPolicyAttribute policy =
vendorSpecificAttribute . runPut $ do
putWord8 7
putWord8 6
putWord32be policy
encodeMPPEEncryptionTypesAttribute :: Word32
-> PacketAttribute
encodeMPPEEncryptionTypesAttribute types =
vendorSpecificAttribute . runPut $ do
putWord8 8
putWord8 6
putWord32be types