diff --git a/Network/CommSec.hs b/Network/CommSec.hs --- a/Network/CommSec.hs +++ b/Network/CommSec.hs @@ -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 diff --git a/Network/CommSec/BitWindow.hs b/Network/CommSec/BitWindow.hs new file mode 100644 --- /dev/null +++ b/Network/CommSec/BitWindow.hs @@ -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 #-} + diff --git a/Network/CommSec/Package.hs b/Network/CommSec/Package.hs --- a/Network/CommSec/Package.hs +++ b/Network/CommSec/Package.hs @@ -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 diff --git a/Network/CommSec/Types.hs b/Network/CommSec/Types.hs new file mode 100644 --- /dev/null +++ b/Network/CommSec/Types.hs @@ -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 diff --git a/commsec.cabal b/commsec.cabal --- a/commsec.cabal +++ b/commsec.cabal @@ -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