radius 0.6.0.2 → 0.6.0.3

raw patch · 3 files changed

+28/−44 lines, 3 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• radius.cabal +1/−1
• src/Network/RADIUS/Encoding.hs +25/−40
• src/Network/RADIUS/Types.hs +2/−3

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

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

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