diff --git a/radius.cabal b/radius.cabal --- a/radius.cabal +++ b/radius.cabal @@ -1,5 +1,5 @@ name: radius -version: 0.6.0.2 +version: 0.6.0.3 synopsis: Remote Authentication Dial In User Service (RADIUS) description: This module provides types and on the wire de/coding of RADIUS packets as per RFC2865 homepage: https://gitlab.com/codemonkeylabs/RADIUS diff --git a/src/Network/RADIUS/Encoding.hs b/src/Network/RADIUS/Encoding.hs --- a/src/Network/RADIUS/Encoding.hs +++ b/src/Network/RADIUS/Encoding.hs @@ -17,7 +17,7 @@ import Control.Monad (when) import Data.Binary (Binary(..), encode) -import Data.Binary.Put (Put, putLazyByteString, putWord8, putWord16be, putWord32be) +import Data.Binary.Put (Put, putLazyByteString, putWord8, putWord16be, putWord32be, runPut) import Data.Binary.Get (Get, getLazyByteString, getWord8, @@ -28,7 +28,7 @@ import Data.ByteString.Lazy.Char8 (ByteString, append) import Data.IP (IPv4, IPv6) import Data.Int (Int64) -import Data.Word (Word8, Word16) +import Data.Word (Word8) import Crypto.Hash.Algorithms (MD5) import Crypto.Hash (Digest, hashlazy) import Network.RADIUS.Types @@ -38,7 +38,7 @@ -- | Self explanatory. It can be useful when reading a RADIUS packet from a socket for example, -- so one can retrieve the packet header (containing the packet length) first and then use that -- to figure out how much data is left to read -radiusHeaderSize :: Word16 +radiusHeaderSize :: Num a => a radiusHeaderSize = 20 -- | Fixed authenticator length as per RFC 2865 @@ -50,7 +50,7 @@ let iD = fromIntegral $ getPacketId authLen = B.length getPacketAuthenticator attributes = encodeAttributes getPacketAttributes - attrsLen = fromIntegral . B.length $ attributes + attrsLen = fromIntegral $ B.length $ attributes when (authLen /= authenticatorLength) $ fail $ "RADIUS.Encoding: Invalid Authenticator length " ++ show authLen put getPacketType @@ -86,7 +86,7 @@ sign packet secret = let authenticator = hashMD5 $ packet `append` secret prologue = B.take 4 packet -- size of type, id, length - attributes = B.drop (fromIntegral radiusHeaderSize) packet + attributes = B.drop radiusHeaderSize packet in prologue `append` authenticator `append` attributes hashMD5 :: ByteString -> ByteString @@ -188,36 +188,23 @@ put (PasswordRetryAttribute value) = putAttribute 75 value put (PromptAttribute value) = putAttribute 76 value put (AcctInterimIntervalAttribute value) = putAttribute 85 value - put (FramedIPv6Prefix prefixLength prefix) = do - let attr = encode prefix - attrLen = 4 + (fromIntegral . B.length $ attr) - putWord8 97 -- Attribute type - putWord8 attrLen + put (UnknownAttribute attributeType value) = putAttribute attributeType value + put (FramedIPv6Prefix prefixLength prefix) = putAttributeM 97 $ do putWord8 0 -- reserved - putWord8 $ fromIntegral prefixLength - putLazyByteString attr - put (VendorSpecificAttribute vendorId str) = do - let attrLen = (fromIntegral . B.length $ str) + 6 -- Attribute header length + string - putWord8 26 -- Attribute Type - putWord8 attrLen + putWord8 prefixLength + putLazyByteString $ encode prefix + put (DelegatedIPv6Prefix prefixLength prefix) = putAttributeM 123 $ do + putWord8 0 -- reserved + putWord8 prefixLength + putLazyByteString $ encode prefix + put (VendorSpecificAttribute vendorId str) = putAttributeM 26 $ do + when (not $ B.null str) $ fail $ "Empty String not allowed in Vendor-Specific Attribute " putWord32be vendorId putLazyByteString str - put (CHAPPassword identity str) = do - let attrLen = (fromIntegral . B.length $ str) + 3 -- Attribute header plus string - when (attrLen /= 19) $ fail $ "Invalid RADIUS CHAP Password length " ++ show attrLen - putWord8 3 -- Attribute Type - putWord8 attrLen + put (CHAPPassword identity str) = putAttributeM 3 $ do + when (B.length str /= 16) $ fail $ "Invalid RADIUS CHAP Password length " ++ show str putWord8 identity putLazyByteString str - put (DelegatedIPv6Prefix prefixLength prefix) = do - let attr = encode prefix - attrLen = 4 + (fromIntegral . B.length $ attr) - putWord8 123 -- Attribute type - putWord8 attrLen - putWord8 0 -- reserved - putWord8 $ fromIntegral prefixLength - putLazyByteString attr - put (UnknownAttribute attributeType value) = putAttribute attributeType value get = do code <- getWord8 @@ -226,19 +213,17 @@ -- | For internal use putAttributeStr :: Word8 -> ByteString -> Put putAttributeStr code str = do - putWord8 code - putWord8 $ (fromIntegral . B.length $ str) + 2 -- attr length + code + len octets + putWord8 code -- Attribute type + putWord8 $ (fromIntegral $ B.length $ str) + 2 -- attr length + code + len octets putLazyByteString str -- | For internal use putAttribute :: (Binary a) => Word8 -> a -> Put -putAttribute code attribute = do - let attrData = encode attribute - attrLen = (fromIntegral . B.length $ attrData) + 2 -- attr length + code + len octets - putWord8 code - putWord8 attrLen - putLazyByteString attrData +putAttribute code = putAttributeStr code . encode +putAttributeM :: Word8 -> Put -> Put +putAttributeM code = putAttributeStr code . runPut + getAttribute :: Word8 -> Get PacketAttribute getAttribute 44 = getAttributeStr >>= return . AcctSessionIdAttribute getAttribute 50 = getAttributeStr >>= return . AcctMultiSessionIdAttribute @@ -321,7 +306,7 @@ when (attrLen /= 20) $ fail $ "Unsupported RADIUS Framed IPv6 Prefix attribute length " ++ show attrLen prefix <- get - return $ FramedIPv6Prefix (fromIntegral prefixLength) prefix + return $ FramedIPv6Prefix prefixLength prefix getAttribute 26 = do attrLen <- getWord8 iD <- get @@ -340,7 +325,7 @@ _reserved <- getWord8 prefixLength <- getWord8 prefix <- get - return $ DelegatedIPv6Prefix (fromIntegral prefixLength) prefix + return $ DelegatedIPv6Prefix prefixLength prefix getAttribute n = getAttributeStr >>= return . UnknownAttribute n -- | For internal use. diff --git a/src/Network/RADIUS/Types.hs b/src/Network/RADIUS/Types.hs --- a/src/Network/RADIUS/Types.hs +++ b/src/Network/RADIUS/Types.hs @@ -21,7 +21,6 @@ import Data.Data (Data) import Data.Word (Word8, Word16, Word32, Word64) import Data.IP (IPv4, IPv6) -import Data.Int (Int8) data Header = Header { getPacketType :: PacketType, getPacketId :: Word8, @@ -78,7 +77,7 @@ | FramedIPNetmaskAttribute { getFramedIPNetmaskAttribute :: IPv4 } | FramedRoutingAttribute { getFramedRoutingAttribute :: FramedRouting } | FramedInterfaceIdAttribute { getFramedInterfaceIdAttribute :: Word64 } - | FramedIPv6Prefix { getFramedIPv6PrefixLength :: Int8, + | FramedIPv6Prefix { getFramedIPv6PrefixLength :: Word8, getFramedIPv6Prefix :: IPv6 } | FramedIPv6Route { getFramedIPv6RouteAttribute :: ByteString } | FramedIPv6Pool { getFramedIPv6PoolAttribute :: ByteString } @@ -92,7 +91,7 @@ | ReplyMessageAttribute { getReplyMessageAttribute :: ByteString } | CallbackNumberAttribute { getCallbackNumberAttribute :: ByteString } | CallbackIdAttribute { getCallbackIdAttribute :: ByteString } - | DelegatedIPv6Prefix { getDelegatedIPv6PrefixLength :: Int8, + | DelegatedIPv6Prefix { getDelegatedIPv6PrefixLength :: Word8, getDelegatedIPv6Prefix :: IPv6 } | FramedRouteAttribute { getFramedRouteAttribute :: ByteString } | FramedIPXNetworkAttribute { getFramedIPXNetworkAttribute :: Word32 }