commsec 0.2 → 0.2.1
raw patch · 5 files changed
+230/−185 lines, 5 filesdep ~network
Dependency ranges changed: network
Files
- Network/CommSec.hs +54/−95
- Network/CommSec/BitWindow.hs +42/−0
- Network/CommSec/Package.hs +95/−84
- Network/CommSec/Types.hs +27/−0
- commsec.cabal +12/−6
Network/CommSec.hs view
@@ -2,107 +2,79 @@ module Network.CommSec ( -- * Types- Connection(..), Safe, Unsafe+ Connection(..)+ , CommSecError(..) -- * Send and receive operations , send, recv , sendPtr, recvPtr- , sendUnsafe, recvUnsafe- , sendPtrUnsafe, recvPtrUnsafe -- * Establishing a connection from a shared secret- -- ** Thread Safe , accept , connect- -- ** Non-threadsafe- , acceptUnsafe- , connectUnsafe -- * Establishing a connection from a public identity (PKI) -- , acceptId -- , connectId- -- * Re-exports- , SocketType(..) ) where import Crypto.Classes (buildKey) import Crypto.Cipher.AES128.Internal (encryptCTR) import Crypto.Cipher.AES128 (AESKey) import Network.CommSec.Package-import Network.Socket (Socket, SocketType(..), sendBuf, recvBuf, HostName, PortNumber)+import Network.CommSec.Types+import Network.Socket ( Socket, SocketType(..), SockAddr, AddrInfo(..)+ , defaultHints , getAddrInfo, sendBuf, addrAddress+ , recvBuf, HostName, PortNumber) import qualified Network.Socket as Net-import Data.IORef import Control.Concurrent.MVar import Control.Exception (throw)+import Control.Monad import qualified Data.ByteString as B import qualified Data.ByteString.Unsafe as B import qualified Data.ByteString.Internal as B import Foreign.Ptr import Foreign.Marshal.Alloc import Data.Word---- | Unsafe connections are not thread safe. Concurrent use can compromise--- security.-type Unsafe = IORef---- | Safe connections are more expensive due to the use of an 'MVar' but,--- unlike their 'Unsafe' counterparts, Safe connections can be used--- concurrently.-type Safe = MVar+import Data.Maybe (listToMaybe) -- | A connection is a secure bidirectional communication channel.-data Connection c- = Conn { inCtx :: c InContext- , outCtx :: c OutContext+data Connection+ = Conn { inCtx :: MVar InContext+ , outCtx :: MVar OutContext , socket :: Socket } -send :: Connection Safe -> B.ByteString -> IO ()-send = sendWith takeMVar putMVar--recv :: Connection Safe -> IO B.ByteString-recv = recvWith takeMVar putMVar---- |Sends a message over the connection.-sendPtr :: Connection Safe -> Ptr Word8 -> Int -> IO ()-sendPtr = sendPtrWith takeMVar putMVar---- |Blocks till it receives a valid message, placing the resulting plaintext--- in the provided buffer. If the incoming message is larger that the--- provided buffer then the message is truncated. This process also incurs--- an additional copy.-recvPtr :: Connection Safe -> Ptr Word8 -> Int -> IO Int-recvPtr = recvPtrWith takeMVar putMVar+pMVar :: MVar v -> v -> IO ()+pMVar m v = v `seq` putMVar m v --- |Sends a message.-sendUnsafe :: Connection Unsafe -> B.ByteString -> IO ()-sendUnsafe = sendWith readIORef writeIORef+send :: Connection -> B.ByteString -> IO ()+send = sendWith takeMVar pMVar --- |Receives a message.-recvUnsafe :: Connection Unsafe -> IO B.ByteString-recvUnsafe = recvWith readIORef writeIORef+recv :: Connection -> IO B.ByteString+recv = recvWith takeMVar pMVar --- |Sends a message.-sendPtrUnsafe :: Connection Unsafe -> Ptr Word8 -> Int -> IO ()-sendPtrUnsafe = sendPtrWith readIORef writeIORef+-- |Sends a message over the connection.+sendPtr :: Connection -> Ptr Word8 -> Int -> IO ()+sendPtr = sendPtrWith takeMVar pMVar -- |Blocks till it receives a valid message, placing the resulting plaintext -- in the provided buffer. If the incoming message is larger that the -- provided buffer then the message is truncated. This process also incurs -- an additional copy.-recvPtrUnsafe :: Connection Unsafe -> Ptr Word8 -> Int -> IO Int-recvPtrUnsafe = recvPtrWith readIORef writeIORef+recvPtr :: Connection -> Ptr Word8 -> Int -> IO Int+recvPtr = recvPtrWith takeMVar pMVar --- helper for send, sendUnsafe-sendWith :: (c OutContext -> IO OutContext) -> (c OutContext -> OutContext -> IO ()) -> Connection c -> B.ByteString -> IO ()+-- helper for send+sendWith :: (MVar OutContext -> IO OutContext) -> (MVar OutContext -> OutContext -> IO ()) -> Connection -> B.ByteString -> IO () sendWith get put conn msg = B.useAsCStringLen msg $ \(ptPtr, ptLen) -> sendPtrWith get put conn (castPtr ptPtr) ptLen {-# INLINE sendWith #-} data RecvRes = Good | Small | Err deriving (Eq) --- helper for recv, recvUnsafe-recvWith :: (c InContext -> IO InContext) -> (c InContext -> InContext -> IO ()) -> Connection c -> IO B.ByteString+-- helper for recv+recvWith :: (MVar InContext -> IO InContext) -> (MVar InContext -> InContext -> IO ()) -> Connection -> IO B.ByteString recvWith get put conn@(Conn {..}) = allocGo baseSize where- baseSize = 1024+ baseSize = 2048 allocGo :: Int -> IO B.ByteString allocGo n = allocaBytes sizeTagLen (go n) @@ -114,7 +86,7 @@ | otherwise = do recvBytesPtr socket tmpPtr sizeTagLen sz <- fromIntegral `fmap` peekBE32 tmpPtr- (b,res) <- B.createAndTrim' sz $ \ptPtr -> do+ (b, res) <- B.createAndTrim' sz $ \ptPtr -> do resSz <- recvPtrOfSz get put conn ptPtr sz case resSz of Left err -> if err `elem` retryOn then return (0,0,Err)@@ -132,8 +104,8 @@ retryOn :: [CommSecError] retryOn = [DuplicateSeq, InvalidICV, BadPadding] --- helper for sendPtr, sendPtrUnsafe-sendPtrWith :: (c OutContext -> IO OutContext) -> (c OutContext -> OutContext -> IO ()) -> Connection c -> Ptr Word8 -> Int -> IO ()+-- helper for sendPtr+sendPtrWith :: (MVar OutContext -> IO OutContext) -> (MVar OutContext -> OutContext -> IO ()) -> Connection -> Ptr Word8 -> Int -> IO () sendPtrWith get put c@(Conn {..}) ptPtr ptLen = do let ctLen = encBytes ptLen pktLen = sizeTagLen + ctLen@@ -143,11 +115,11 @@ o <- get outCtx o2 <- encodePtr o ptPtr ctPtr ptLen put outCtx o2- Net.sendBuf socket pktPtr pktLen+ sendBytesPtr socket pktPtr pktLen return () --- helper for recvPtr, recvPtrUnsafe-recvPtrWith :: (c InContext -> IO InContext) -> (c InContext -> InContext -> IO ()) -> Connection c -> Ptr Word8 -> Int -> IO Int+-- helper for recvPtr+recvPtrWith :: (MVar InContext -> IO InContext) -> (MVar InContext -> InContext -> IO ()) -> Connection -> Ptr Word8 -> Int -> IO Int recvPtrWith get put c@(Conn{..}) ptPtr maxLen = do r <- go case r of@@ -176,7 +148,7 @@ else finish ptPtr -- Receive sz bytes and decode it into ptPtr, helper for recvWith-recvPtrOfSz :: (c InContext -> IO InContext) -> (c InContext -> InContext -> IO ()) -> Connection c -> Ptr Word8 -> Int -> IO (Either CommSecError Int)+recvPtrOfSz :: (MVar InContext -> IO InContext) -> (MVar InContext -> InContext -> IO ()) -> Connection -> Ptr Word8 -> Int -> IO (Either CommSecError Int) recvPtrOfSz get put (Conn {..}) ptPtr sz = allocaBytes sz $ \ct -> do recvBytesPtr socket ct sz@@ -190,7 +162,7 @@ recvBytesPtr :: Socket -> Ptr Word8 -> Int -> IO () recvBytesPtr s p 0 = return () recvBytesPtr s p l = do- nr <- recvBuf s l p+ nr <- recvBuf s p l recvBytesPtr s (p `plusPtr` nr) (l - nr) -- Retry until we have sent exactly the specified number of bytes@@ -215,26 +187,26 @@ enc k i pt = B.unsafeCreate sz $ \ctPtr -> B.useAsCString pt $ \ptPtr -> B.useAsCString i $ \iv ->- encryptCTR k (castPtr iv) (castPtr ctPtr) (castPtr ptPtr) sz+ encryptCTR k (castPtr iv) nullPtr (castPtr ctPtr) (castPtr ptPtr) sz -- |Expands the provided 128 (or more) bit secret into two -- keys to create a connection. ----- ex: accept ent me.com 3134 Stream-accept :: B.ByteString -> PortNumber -> SocketType -> IO (Connection Safe)+-- ex: accept ent 3134+accept :: B.ByteString -> PortNumber -> IO Connection accept = doAccept newMVar -doAccept :: (forall x. x -> IO (c x)) -> B.ByteString -> PortNumber -> SocketType -> IO (Connection c)-doAccept create s p streamOrDgram+doAccept :: (forall x. x -> IO (MVar x)) -> B.ByteString -> PortNumber -> IO Connection+doAccept create s p | B.length s < 16 = error "Invalid input entropy" | otherwise = do let ent = expandSecret s 64 k1 = B.take 32 ent k2 = B.drop 32 ent- iCtx = newInContext k1+ iCtx = newInContext k1 Sequential oCtx = newOutContext k2 sockaddr = Net.SockAddrInet p Net.iNADDR_ANY- sock <- Net.socket Net.AF_INET streamOrDgram Net.defaultProtocol+ sock <- Net.socket Net.AF_INET Net.Stream Net.defaultProtocol Net.setSocketOption sock Net.ReuseAddr 1 Net.bind sock sockaddr Net.listen sock 10@@ -245,50 +217,37 @@ outCtx <- create oCtx return (Conn {..}) -doConnect :: (forall x. x -> IO (c x)) -> B.ByteString -> HostName -> PortNumber -> SocketType -> IO (Connection c)-doConnect create s hn p streamOrDgram+doConnect :: (forall x. x -> IO (MVar x)) -> B.ByteString -> HostName -> PortNumber -> IO Connection+doConnect create s hn p | B.length s < 16 = error "Invalid input entropy" | otherwise = do- ha <- Net.inet_addr hn+ sockaddr <- resolve hn p let ent = expandSecret s 64 k2 = B.take 32 ent k1 = B.drop 32 ent- iCtx = newInContext k1+ iCtx = newInContext k1 Sequential oCtx = newOutContext k2- sockaddr = Net.SockAddrInet p ha- socket <- Net.socket Net.AF_INET streamOrDgram Net.defaultProtocol+ socket <- Net.socket Net.AF_INET Net.Stream Net.defaultProtocol Net.connect socket sockaddr Net.setSocketOption socket Net.NoDelay 1 Net.setSocketOption socket Net.ReuseAddr 1 inCtx <- create iCtx outCtx <- create oCtx return (Conn {..})+ where+ resolve :: HostName -> PortNumber -> IO SockAddr+ resolve h port = do+ ai <- getAddrInfo (Just $ defaultHints { addrFamily = Net.AF_INET, addrSocketType = Stream } ) (Just h) (Just (show port))+ return (maybe (error $ "Could not resolve host " ++ h) addrAddress (listToMaybe ai)) -- |Expands the provided 128 (or more) bit secret into two -- keys to create a connection. connect :: B.ByteString -> HostName -> PortNumber- -> SocketType- -> IO (Connection Safe)+ -> IO Connection connect = doConnect newMVar --- |Expands the provided 128 (or more) bit secret into two--- keys to create a connection.-acceptUnsafe :: B.ByteString- -> PortNumber- -> SocketType- -> IO (Connection Unsafe)-acceptUnsafe = doAccept newIORef---- |Expands the provided 128 (or more) bit secret into two--- keys to create a connection.-connectUnsafe :: B.ByteString- -> HostName- -> PortNumber- -> SocketType- -> IO (Connection Unsafe)-connectUnsafe = doConnect newIORef- -- |We use a word32 to indicate the size of a datagram+sizeTagLen :: Int sizeTagLen = 4
+ Network/CommSec/BitWindow.hs view
@@ -0,0 +1,42 @@+{-# LANGUAGE BangPatterns, UnboxedTuples #-}+module Network.CommSec.BitWindow+ ( BitWindow+ , zeroWindow+ , updateBitWindow+ ) where++import Data.Bits+import Network.CommSec.Types+import Data.Word (Word64)++-- | A Bit Window is just an unpacked tuple of base and mask+type BitWindow = (Word64,Word64)++zeroWindow :: BitWindow+zeroWindow = (0,0)++updateBitWindow :: BitWindow -> Word64 -> Either CommSecError BitWindow+updateBitWindow !(!base,!mask) !sqn+ | base >= maxBound - 63 && mask == maxBound = Left OldContext+ | base <= sqn && base >= seqBase =+ let pos = fromIntegral $ sqn - base+ in if testBit mask pos+ then Left DuplicateSeq+ else let new = setBit mask pos+ in new `seq` Right (base, new)+ | base < seqBase =+ let newBase = seqBase+ newMask+ | seqBase - base > 63 = 0+ | otherwise = mask `shiftR` fromIntegral (seqBase - base)+ shiftIt !b !m+ | testBit m 0 = shiftIt (b+1) (shiftR m 1)+ | otherwise = (b,m)+ (finalBase, finalMask) = shiftIt newBase newMask+ in updateBitWindow (finalBase,finalMask) sqn+ | base > sqn = Left DuplicateSeq+ where+ !seqBase | sqn < 64 = 0+ | otherwise = sqn - 63+{-# INLINE updateBitWindow #-}+
Network/CommSec/Package.hs view
@@ -1,8 +1,8 @@ {-# LANGUAGE CPP, BangPatterns, RecordWildCards, DeriveDataTypeable #-} -- | CommSec is a package that provides communication security for--- a datagram (vs streaming) style of communications. Using an ephemeral shared--- secret you can build contexts for sending to or receiving from with one or more--- peers.+-- use with Haskell sockets. Using an ephemeral shared+-- secret you can build contexts for sending or receiving data between one+-- or more peers. -- -- Do not reuse the shared secret! Key agreement mechanisms that leverage -- PKI might be added later.@@ -11,6 +11,7 @@ OutContext(..) , InContext(..) , CommSecError(..)+ , SequenceMode(..) -- , Secret, Socket -- * Build contexts for use sending and receiving , newInContext, newOutContext -- , newSecret@@ -57,6 +58,9 @@ import Data.Typeable import Control.Exception +import Network.CommSec.Types+import Network.CommSec.BitWindow+ gPadMax,gBlockLen,gTagLen,gCtrSize :: Int gPadMax = 16 gBlockLen = 16@@ -75,45 +79,48 @@ } -- | A context useful for receiving data.-data InContext =- In { base :: {-# UNPACK #-} !Word64- , mask :: {-# UNPACK #-} !Word64+data InContext+ = In { bitWindow :: {-# UNPACK #-} !BitWindow , saltIn :: {-# UNPACK #-} !Word32 , inKey :: AESKey }+ | InStrict+ { seqVal :: {-# UNPACK #-} !Word64+ , saltIn :: {-# UNPACK #-} !Word32+ , inKey :: AESKey+ }+ | InSequential+ { seqVal :: {-# UNPACK #-} !Word64+ , saltIn :: {-# UNPACK #-} !Word32+ , inKey :: AESKey+ } --- |Errors that can be returned by the decoding/receicing operations.-data CommSecError- = OldContext -- The context is too old (sequence number rollover)- | DuplicateSeq -- The sequence number we previously seen (possible replay attack)- | InvalidICV -- The integrity check value is invalid- | BadPadding -- The padding was invalid (corrupt sender?)- deriving (Eq,Ord,Show,Enum,Data,Typeable) -instance Exception CommSecError- -- | Given at least 24 bytes of entropy, produce an out context that can -- communicate with an identically initialized in context. newOutContext :: ByteString -> OutContext newOutContext bs | B.length bs < 24 = error $ "Not enough entropy: " ++ show (B.length bs) | otherwise =- let aesCtr = 0+ let aesCtr = 1 saltOut = unsafePerformIO $ B.unsafeUseAsCString bs $ peekBE32 . castPtr outKey = fromMaybe (error "Could not build a key") $ buildKey $ B.drop (sizeOf saltOut) bs in Out {..} -- | Given at least 24 bytes of entropy, produce an in context that can -- communicate with an identically initialized out context.-newInContext :: ByteString -> InContext-newInContext bs+newInContext :: ByteString -> SequenceMode -> InContext+newInContext bs md | B.length bs < 24 = error $ "Not enough entropy: " ++ show (B.length bs) | otherwise =- let base = 0- mask = 0+ let bitWindow = zeroWindow+ seqVal = 0 saltIn = unsafePerformIO $ B.unsafeUseAsCString bs $ peekBE32 . castPtr inKey = fromMaybe (error "Could not build a key") $ buildKey $ B.drop (sizeOf saltIn) bs- in In {..}+ in case md of+ AllowOutOfOrder -> In {..}+ StrictOrdering -> InStrict {..}+ Sequential -> InSequential {..} -- Encrypts multiple-of-block-sized input, returing a bytestring of the -- [ctr, ct, tag].@@ -228,7 +235,7 @@ | aesCtr == maxBound = throw OldContext | otherwise = let !iv_ct_tag = encryptGCM outKey aesCtr saltOut (pad pt)- in (iv_ct_tag, ctx { aesCtr = 1 + aesCtr })+ in (iv_ct_tag, ctx { aesCtr = ((fromIntegral $ B.length pt + 31) `rem` 16) + 1 + aesCtr }) -- |Given a message length, returns the number of bytes an encoded message -- will consume.@@ -263,7 +270,7 @@ copyBytes ptPaddedPtr ptPtr ptLen memset (ptPaddedPtr `plusPtr` ptLen) padding (fromIntegral padding) encryptGCMPtr outKey aesCtr saltOut ptPaddedPtr totalLen pkgPtr- return (ctx { aesCtr = 1 + aesCtr })+ return (ctx { aesCtr = (fromIntegral totalLen `rem` 16) + 1 + aesCtr }) where memset :: Ptr Word8 -> Int -> Word8 -> IO () memset ptr1 len val = mapM_ (\o -> pokeElemOff ptr1 o val) [0..len-1]@@ -273,51 +280,89 @@ -- location @msg@ and its size is returned along with a new context (or -- error). decodePtr :: InContext -> Ptr Word8 -> Ptr Word8 -> Int -> IO (Either CommSecError (Int,InContext))-decodePtr (In {..}) pkgPtr msgPtr pkgLen- | base >= maxBound - 64 = return $ Left OldContext- | otherwise = do+decodePtr ctx pkgPtr msgPtr pkgLen = do cnt <- peekBE pkgPtr let !ctPtr = pkgPtr `plusPtr` sizeOf cnt !ctLen = pkgLen - tagLen - sizeOf cnt !tagPtr = pkgPtr `plusPtr` (pkgLen - tagLen) tagLen = gTagLen paddedLen = ctLen- r <- decryptGCMPtr inKey cnt saltIn ctPtr ctLen tagPtr tagLen msgPtr+ r <- decryptGCMPtr (inKey ctx) cnt (saltIn ctx) ctPtr ctLen tagPtr tagLen msgPtr case r of- Left err -> return (Left err)- Right () -> do- case updateBaseMask base mask cnt of- Nothing -> return (Left DuplicateSeq)- Just (base',mask') -> do- pdLen <- padLenPtr msgPtr paddedLen- case pdLen of- Nothing -> return $ Left BadPadding- Just l -> return $ Right (paddedLen - l, In base' mask' saltIn inKey)+ Left err -> return (Left err)+ Right () -> helper ctx cnt paddedLen+ where+ {-# INLINE helper #-}+ helper :: InContext -> Word64 -> Int+ -> IO (Either CommSecError (Int,InContext))+ helper (InStrict {..}) cnt paddedLen+ | cnt > seqVal = do+ pdLen <- padLenPtr msgPtr paddedLen+ case pdLen of+ Nothing -> return $ Left BadPadding+ Just l -> return $ Right (paddedLen - l, InStrict cnt saltIn inKey)+ | otherwise = return (Left DuplicateSeq)+ helper (InSequential {..}) cnt paddedLen+ | cnt == seqVal + 1 = do+ pdLen <- padLenPtr msgPtr paddedLen+ case pdLen of+ Nothing -> return $ Left BadPadding+ Just l -> return $ Right (paddedLen - l, InSequential cnt saltIn inKey)+ | otherwise = return (Left DuplicateSeq) + helper (In {..}) cnt paddedLen = do+ case updateBitWindow bitWindow cnt of+ Left e -> return (Left e)+ Right newMask -> do+ pdLen <- padLenPtr msgPtr paddedLen+ case pdLen of+ Nothing -> return $ Left BadPadding+ Just l -> return $ Right (paddedLen - l, In newMask saltIn inKey)+ -- |Use an 'InContext' to decrypt a message, verifying the ICV and sequence -- number. Unlike sending, receiving is more likely to result in an -- exceptional condition and thus it returns an 'Either' value. -- -- Message format: [ctr, ct, padding, tag]. decode :: InContext -> ByteString -> Either CommSecError (ByteString, InContext)-decode (In {..}) pkg- | base >= maxBound - 64 = Left OldContext- | otherwise =+decode ctx pkg = let cnt = unsafePerformIO $ B.unsafeUseAsCString pkg (peekBE . castPtr) cntLen = sizeOf cnt tagLen = gTagLen tag = B.drop (B.length pkg - tagLen) pkg ct = let st = (B.drop cntLen pkg) in B.take (B.length st - tagLen) st- ptpd = decryptGCM inKey cnt saltIn ct tag- in case updateBaseMask base mask cnt of- Nothing -> Left DuplicateSeq- Just (base',mask') ->- case ptpd of- Left err -> Left err- Right ptPad ->- case unpad ptPad of- Nothing -> Left BadPadding- Just pt -> Right (pt, In base' mask' saltIn inKey)+ ptpd = decryptGCM (inKey ctx) cnt (saltIn ctx) ct tag+ in helper ctx cnt ptpd+ where+ {-# INLINE helper #-}+ helper (In {..}) cnt ptpd =+ case updateBitWindow bitWindow cnt of+ Left e -> Left e+ Right bw ->+ case ptpd of+ Left err -> Left err+ Right ptPad ->+ case unpad ptPad of+ Nothing -> Left BadPadding+ Just pt -> Right (pt, In bw saltIn inKey)+ helper (InStrict {..}) cnt ptpd+ | cnt > seqVal =+ case ptpd of+ Left err -> Left err+ Right ptPad ->+ case unpad ptPad of+ Nothing -> Left BadPadding+ Just pt -> Right (pt, InStrict cnt saltIn inKey)+ | otherwise = Left DuplicateSeq+ helper (InSequential {..}) cnt ptpd+ | cnt == seqVal + 1 =+ case ptpd of+ Left err -> Left err+ Right ptPad ->+ case unpad ptPad of+ Nothing -> Left BadPadding+ Just pt -> Right (pt, InSequential cnt saltIn inKey)+ | otherwise = Left DuplicateSeq -- |Pad a bytestring to block size pad :: ByteString -> ByteString@@ -348,44 +393,10 @@ -- Perhaps this should be called 'unpadPtr' padLenPtr :: Ptr Word8 -> Int -> IO (Maybe Int) padLenPtr ptr len- | len <= gPadMax = return Nothing+ | len < gPadMax = return Nothing | otherwise = do r <- fromIntegral `fmap` (peekElemOff ptr (len-1) :: IO Word8) if r <= gPadMax then return (Just r) else return Nothing--updateBaseMask :: Word64 -> Word64 -> Word64 -> Maybe (Word64,Word64)-updateBaseMask !base !mask !seq- | base <= seq && base >= seqBase =- let pos = fromIntegral $ seq - base- in if testBit mask pos- then Nothing- else Just (base, setBit mask pos)-#ifdef SEQ_WINDOW_JUMPS- -- If all packets are received iun order, you will hit this case on every- -- 64th packet and perform a single shiftR operation. If packets are- -- received out of order then this method is more likely to incorrectly- -- mark packets as duplicate.- | base < seqBase = updateBaseMask seq (mask `shiftR` fromIntegral (seq - base)) seq-#else- -- If all packets are received in order, you will theoretically hit this- -- case on every 64th packet, perform 64 shiftRight operations (due to lack of- -- a msnzb operation), and- -- proceed with the next 63 packets incurring only a bitSet operation.- | base < seqBase =- let newBase = seqBase- newMask = mask `shiftR` fromIntegral (seqBase - base)- shiftIt !b !m- | testBit m 0 = shiftIt (b+1) (shiftR m 1)- | otherwise = (b,m)- (finalBase, finalMask) = shiftIt newBase newMask- in updateBaseMask finalBase finalMask seq-#endif- | base > seq = Nothing- where- !seqBase | seq < 64 = 0- | otherwise = seq-63-{-# INLINE updateBaseMask #-}- peekBE :: Ptr Word8 -> IO Word64 peekBE p = do
+ Network/CommSec/Types.hs view
@@ -0,0 +1,27 @@+{-# LANGUAGE DeriveDataTypeable #-}++module Network.CommSec.Types where++import Control.Exception+import Data.Data+import Data.Typeable+import Control.Concurrent.MVar++-- |Errors that can be returned by the decoding/receicing operations.+data CommSecError+ = OldContext -- The context is too old (sequence number rollover)+ | DuplicateSeq -- The sequence number we previously seen (possible replay attack)+ | InvalidICV -- The integrity check value is invalid+ | BadPadding -- The padding was invalid (corrupt sender?)+ deriving (Eq,Ord,Show,Enum,Data,Typeable)++-- |Policy for misordered packets. Notice StrictOrdering does not mean+-- every sequence numbered packet will be received, only that the sequence+-- number will always increase.+data SequenceMode+ = AllowOutOfOrder -- In IPSec style, allow for datagrams to be recieved out of order+ | StrictOrdering -- Allow messages with newer sequence numbers than previously observed, but drop any with older.+ | Sequential -- Allows messages only if the sequence number matches the expected value+ deriving (Eq,Ord,Show,Enum,Data,Typeable)++instance Exception CommSecError
commsec.cabal view
@@ -2,9 +2,15 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: commsec-version: 0.2-synopsis: Communications security- description: A basic communications security package that provides confidentiallity, integrity and replay detection.+version: 0.2.1+synopsis: Provide communications security using symmetric ephemeral keys+ description: This package provides confidentiallity,+ integrity and replay detection. Users must+ provide ephemeral keys for one time use (reuse+ will compromise the security guarentees).+ Starting with shared secret, this package+ builds bi-directional channels for datagram+ based communication. license: BSD3 license-file: LICENSE author: Thomas M. DuBuisson@@ -15,10 +21,10 @@ cabal-version: >=1.8 library- exposed-modules: Network.CommSec, Network.CommSec.Package- -- other-modules: + exposed-modules: Network.CommSec, Network.CommSec.Package, Network.CommSec.BitWindow, Network.CommSec.Types+ -- other-modules: Network.CommSec.BitWindow, Network.CommSec.Types build-depends: base >4.5 && < 5, cipher-aes128 >= 0.2, bytestring, crypto-api,- network >= 2.5+ network >= 2.4.1