{-# LANGUAGE RecordWildCards, OverloadedStrings #-}
module Network.RADIUS.Microsoft (encodeMPPESendKeyAttribute,
encodeMPPERecvKeyAttribute,
encodeMPPEEncryptionPolicyAttribute,
encodeMPPEEncryptionTypesAttribute,
encodePrimaryDNSServer,
encodeSecondaryDNSServer) 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.IP (IPv4)
import Data.Word (Word8, Word16, Word32)
import Network.RADIUS.Encoding (putAttribute)
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
encodePrimaryDNSServer :: IPv4
-> PacketAttribute
encodePrimaryDNSServer =
vendorSpecificAttribute . runPut . putAttribute 28
encodeSecondaryDNSServer :: IPv4
-> PacketAttribute
encodeSecondaryDNSServer =
vendorSpecificAttribute . runPut . putAttribute 29