radius 0.6.1.0 → 0.7.1.0

raw patch · 4 files changed

+77/−28 lines, 4 filesdep +lensPVP ok

version bump matches the API change (PVP)

Dependencies added: lens

API changes (from Hackage documentation)

Files

• radius.cabal +2/−1
• src/Network/RADIUS/Encoding.hs +32/−20
• src/Network/RADIUS/Microsoft.hs +17/−1
• src/Network/RADIUS/Types.hs +26/−6

@@ -1,5 +1,5 @@ name:                radius-version:             0.6.1.0+version:             0.7.1.0 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@@ -24,6 +24,7 @@                      , cryptonite                      , iproute                      , memory+                     , lens   default-language:    Haskell2010   ghc-options:         -Wall 

@@ -16,7 +16,7 @@ module Network.RADIUS.Encoding where  import Control.Monad               (when)-import Data.Binary                 (Binary(..), encode)+import Data.Binary                 (Binary(..), decode, encode) import Data.Binary.Put             (Put, putLazyByteString, putWord8, putWord16be, putWord32be, runPut) import Data.Binary.Get             (Get,                                     getLazyByteString,@@ -46,17 +46,17 @@ authenticatorLength = 16  instance Binary Packet where-    put Packet{ getHeader = Header{..} , .. } = do-      let iD         = fromIntegral $ getPacketId-          authLen    = B.length getPacketAuthenticator-          attributes = encodeAttributes getPacketAttributes+    put Packet{ _getHeader = Header{..} , .. } = do+      let iD         = fromIntegral $ _getPacketId+          authLen    = B.length _getPacketAuthenticator+          attributes = encodeAttributes _getPacketAttributes           attrsLen   = fromIntegral $ B.length $ attributes       when (authLen /= authenticatorLength) $            error $ "RADIUS.Encoding: Invalid Authenticator length " ++ show authLen-      put getPacketType+      put _getPacketType       putWord8 iD       putWord16be $ attrsLen + radiusHeaderSize-      putLazyByteString getPacketAuthenticator+      putLazyByteString _getPacketAuthenticator       putLazyByteString attributes     get = do       header <- decodeHeader@@ -69,18 +69,18 @@   iD            <- getWord8   packetLength  <- getWord16be   authenticator <- getLazyByteString authenticatorLength-  return Header { getPacketType          = packetType,-                  getPacketId            = iD,-                  getPacketLength        = packetLength,-                  getPacketAuthenticator = authenticator }+  return Header { _getPacketType          = packetType,+                  _getPacketId            = iD,+                  _getPacketLength        = packetLength,+                  _getPacketAuthenticator = authenticator }  -- | Given an already decoded header, this function can be used to decode the complete packet -- from the available data decodePacket :: Header -> Get Packet decodePacket header@Header{..} = do   attributes <- decodeAttributes []-  return Packet { getHeader           = header,-                  getPacketAttributes = attributes }+  return Packet { _getHeader           = header,+                  _getPacketAttributes = attributes }  sign :: ByteString -> ByteString -> ByteString sign packet secret =@@ -188,6 +188,7 @@     put (PasswordRetryAttribute value)          = putAttribute     75 value     put (PromptAttribute value)                 = putAttribute     76 value     put (AcctInterimIntervalAttribute value)    = putAttribute     85 value+    put (DNSServerIPv6AddressAttribute value)   = putAttribute    169 value     put (UnknownAttribute attributeType value)  = putAttribute attributeType value     put (FramedIPv6Prefix prefixLength prefix)    = putAttributeM  97 $ do       putWord8 0  -- reserved@@ -198,7 +199,7 @@       putWord8 prefixLength       putLazyByteString $ encode prefix     put (VendorSpecificAttribute vendorId str)    = putAttributeM  26 $ do-      when (not $ B.null str) $ error $ "Empty String not allowed in Vendor-Specific Attribute "+      when (B.null str) $ error "Empty String not allowed in Vendor-Specific Attribute "       putWord32be vendorId       putLazyByteString str     put (CHAPPassword identity str)               = putAttributeM   3 $ do@@ -299,13 +300,15 @@ getAttribute 75 = getAttributeValue >>= return . PasswordRetryAttribute getAttribute 76 = getAttributeValue >>= return . PromptAttribute getAttribute 85 = getAttributeValue >>= return . AcctInterimIntervalAttribute+getAttribute 169 = getAttributeValue >>= return . DNSServerIPv6AddressAttribute getAttribute 97 = do   attrLen      <- getWord8   _reserved    <- getWord8   prefixLength <- getWord8-  when (attrLen /= 20) $ error $ "Unsupported RADIUS Framed IPv6 Prefix attribute length "-           ++ show attrLen-  prefix <- get+  when (attrLen < 4 || attrLen > 20) $+    error $ show attrLen ++ " is an invalid RADIUS Framed IPv6 Prefix attribute length"+  let available = fromIntegral $ attrLen - 4+  prefix <- getFromBytes available 20   return $ FramedIPv6Prefix prefixLength prefix getAttribute 26 = do   attrLen  <- getWord8@@ -320,15 +323,24 @@   return $ CHAPPassword identity attrData getAttribute 123 = do   attrLen      <- getWord8-  when (attrLen /= 20) $ error $ "Unsupported RADIUS Delegated IPv6 Prefix attribute length "-           ++ show attrLen+  when (attrLen < 4 || attrLen > 20) $+    error $ show attrLen +++              " is an invalid RADIUS Delegated IPv6 Prefix attribute length"   _reserved    <- getWord8   prefixLength <- getWord8-  prefix       <- get+  let available = fromIntegral $ attrLen - 4+  prefix <- getFromBytes available 20   return $ DelegatedIPv6Prefix prefixLength prefix getAttribute n  = getAttributeStr >>= return . UnknownAttribute n  -- | For internal use.+getFromBytes :: Binary a => Int64 -> Int64 -> Get a+getFromBytes len size = do+  let padBytes    = size - len+      pad         = B.replicate padBytes '\0'+  str <- getLazyByteString len+  return . decode $ B.append str pad+ getAttributeStr :: Get ByteString getAttributeStr = getWord8 >>= getLazyByteString . fromIntegral . (subtract 2) -- minus type + len 

@@ -15,7 +15,9 @@ module Network.RADIUS.Microsoft (encodeMPPESendKeyAttribute,                                  encodeMPPERecvKeyAttribute,                                  encodeMPPEEncryptionPolicyAttribute,-                                 encodeMPPEEncryptionTypesAttribute) where+                                 encodeMPPEEncryptionTypesAttribute,+                                 encodePrimaryDNSServer,+                                 encodeSecondaryDNSServer) where  import Prelude hiding (zipWith) import Crypto.Hash.Algorithms    (MD5)@@ -25,7 +27,9 @@ 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@@ -100,3 +104,15 @@       putWord8 8 -- for MS-MPPE-Encryption-Types.       putWord8 6 -- fixed length       putWord32be types++-- | Encode MS-DNS-Primary-DNA-Server as per [RFC2548]+encodePrimaryDNSServer :: IPv4+                       -> PacketAttribute+encodePrimaryDNSServer =+    vendorSpecificAttribute . runPut . putAttribute 28++-- | Encode MS-DNS-Secondary-DNA-Server as per [RFC2548]+encodeSecondaryDNSServer :: IPv4+                       -> PacketAttribute+encodeSecondaryDNSServer =+    vendorSpecificAttribute . runPut . putAttribute 29

@@ -1,4 +1,5 @@ {-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE TemplateHaskell    #-} {-| Module      : Network.RADIUS.Types Description : Provides types and definitions for RADIUS as per RFC 2865@@ -21,15 +22,16 @@ import Data.Data                     (Data) import Data.Word                     (Word8, Word16, Word32, Word64) import Data.IP                       (IPv4, IPv6)+import Control.Lens.TH               (makePrisms, makeLenses) -data Header = Header { getPacketType          :: PacketType,-                       getPacketId            :: Word8,-                       getPacketLength        :: Word16,-                       getPacketAuthenticator :: ByteString }+data Header = Header { _getPacketType          :: PacketType,+                       _getPacketId            :: Word8,+                       _getPacketLength        :: Word16,+                       _getPacketAuthenticator :: ByteString }               deriving (Show, Eq) -data Packet = Packet { getHeader           :: Header,-                       getPacketAttributes :: [PacketAttribute] }+data Packet = Packet { _getHeader           :: Header,+                       _getPacketAttributes :: [PacketAttribute] }               deriving (Show, Eq)  data PacketType = AccessRequest@@ -146,6 +148,7 @@   | AcctTerminateCauseAttribute     { getAcctTerminateCauseAttribute     :: TerminateCause    }   | AcctMultiSessionIdAttribute     { getAcctMultiSessionIdAttribute     :: ByteString        }   | AcctLinkCountAttribute          { getAcctLinkCountAttribute          :: Word32            }+  | DNSServerIPv6AddressAttribute   { getDNSServerIPv6AddressAttribute   :: IPv6              }   | UnknownAttribute                { getUnknownType                     :: Word8,                                       getUnknownAttribute                :: ByteString        }   deriving (Show, Eq, Data)@@ -484,3 +487,20 @@     fromEnum UseZoneFilterInclusivelyARAPAccess = 2     fromEnum UseZoneFilterExclusivelyARAPAccess = 4     fromEnum (UnknownARAPZoneAccess x)          = x++makeLenses ''Header+makeLenses ''Packet+makePrisms ''PacketType+makePrisms ''PacketAttribute+makePrisms ''StatusType+makePrisms ''Authentic+makePrisms ''TerminateCause+makePrisms ''ServiceType+makePrisms ''FramedProtocol+makePrisms ''FramedRouting+makePrisms ''FramedCompression+makePrisms ''LoginService+makePrisms ''TerminationAction+makePrisms ''NASPortType+makePrisms ''ARAPZoneAccess+