tls 1.1.3 → 1.1.4
raw patch · 5 files changed
+51/−63 lines, 5 files
Files
- Network/TLS/Cipher.hs +1/−2
- Network/TLS/Record/Disengage.hs +48/−47
- Network/TLS/Record/Engage.hs +0/−1
- Tests/Connection.hs +1/−12
- tls.cabal +1/−1
Network/TLS/Cipher.hs view
@@ -30,8 +30,7 @@ type IV = B.ByteString data BulkFunctions =- BulkNoneF -- special value for 0- | BulkBlockF (Key -> IV -> B.ByteString -> B.ByteString)+ BulkBlockF (Key -> IV -> B.ByteString -> B.ByteString) (Key -> IV -> B.ByteString -> B.ByteString) | BulkStreamF (Key -> IV) (IV -> B.ByteString -> (B.ByteString, IV))
Network/TLS/Record/Disengage.hs view
@@ -36,7 +36,7 @@ decryptRecord record = onRecordFragment record $ fragmentUncipher $ \e -> do st <- get if stRxEncrypted st- then decryptData e >>= getCipherData record+ then get >>= decryptData record e else return e getCipherData :: Record a -> CipherData -> TLSSt ByteString@@ -62,53 +62,54 @@ return $ cipherDataContent cdata -decryptData :: Bytes -> TLSSt CipherData-decryptData econtent = do- st <- get+decryptData :: Record Ciphertext -> Bytes -> TLSState -> TLSSt Bytes+decryptData record econtent st = decryptOf (bulkF bulk)+ where cipher = fromJust "cipher" $ stActiveRxCipher st+ bulk = cipherBulk cipher+ cst = fromJust "rx crypt state" $ stActiveRxCryptState st+ macSize = hashSize $ cipherHash cipher+ writekey = cstKey cst+ blockSize = bulkBlockSize bulk+ econtentLen = B.length econtent - let cipher = fromJust "cipher" $ stActiveRxCipher st- let bulk = cipherBulk cipher- let cst = fromJust "rx crypt state" $ stActiveRxCryptState st- let digestSize = hashSize $ cipherHash cipher- let writekey = cstKey cst+ explicitIV = hasExplicitBlockIV $ stVersion st - case bulkF bulk of- BulkNoneF -> do- let contentlen = B.length econtent - digestSize- (content, mac) <- get2 econtent (contentlen, digestSize)- return $ CipherData- { cipherDataContent = content- , cipherDataMAC = Just mac- , cipherDataPadding = Nothing- }- BulkBlockF _ decryptF -> do- {- update IV -}- (iv, econtent') <- if hasExplicitBlockIV $ stVersion st- then get2 econtent (bulkIVSize bulk, B.length econtent - bulkIVSize bulk)- else return (cstIV cst, econtent)- let newiv = fromJust "new iv" $ takelast (bulkBlockSize bulk) econtent'- put $ st { stActiveRxCryptState = Just $ cst { cstIV = newiv } }+ sanityCheckError = throwError (Error_Packet "encrypted content too small for encryption parameters") - let content' = decryptF writekey iv econtent'- let paddinglength = fromIntegral (B.last content') + 1- let contentlen = B.length content' - paddinglength - digestSize- (content, mac, padding) <- get3 content' (contentlen, digestSize, paddinglength)- return $ CipherData- { cipherDataContent = content- , cipherDataMAC = Just mac- , cipherDataPadding = Just padding- }- BulkStreamF initF _ decryptF -> do- let iv = cstIV cst- let (content', newiv) = decryptF (if iv /= B.empty then iv else initF writekey) econtent- {- update Ctx -}- let contentlen = B.length content' - digestSize- (content, mac) <- get2 content' (contentlen, digestSize)- put $ st { stActiveRxCryptState = Just $ cst { cstIV = newiv } }- return $ CipherData- { cipherDataContent = content- , cipherDataMAC = Just mac- , cipherDataPadding = Nothing- }- where get3 s ls = maybe (throwError $ Error_Packet "record bad format") return $ partition3 s ls+ decryptOf :: BulkFunctions -> TLSSt Bytes+ decryptOf (BulkBlockF _ decryptF) = do+ let minContent = (if explicitIV then bulkIVSize bulk else 0) + max (macSize + 1) blockSize+ when ((econtentLen `mod` blockSize) /= 0 || econtentLen < minContent) $ sanityCheckError+ {- update IV -}+ (iv, econtent') <- if explicitIV+ then get2 econtent (bulkIVSize bulk, econtentLen - bulkIVSize bulk)+ else return (cstIV cst, econtent)+ let newiv = fromJust "new iv" $ takelast (bulkBlockSize bulk) econtent'+ put $ st { stActiveRxCryptState = Just $ cst { cstIV = newiv } }++ let content' = decryptF writekey iv econtent'+ let paddinglength = fromIntegral (B.last content') + 1+ let contentlen = B.length content' - paddinglength - macSize+ (content, mac, padding) <- get3 content' (contentlen, macSize, paddinglength)+ getCipherData record $ CipherData+ { cipherDataContent = content+ , cipherDataMAC = Just mac+ , cipherDataPadding = Just padding+ }++ decryptOf (BulkStreamF initF _ decryptF) = do+ when (econtentLen < macSize) $ sanityCheckError+ let iv = cstIV cst+ let (content', newiv) = decryptF (if iv /= B.empty then iv else initF writekey) econtent+ {- update Ctx -}+ let contentlen = B.length content' - macSize+ (content, mac) <- get2 content' (contentlen, macSize)+ put $ st { stActiveRxCryptState = Just $ cst { cstIV = newiv } }+ getCipherData record $ CipherData+ { cipherDataContent = content+ , cipherDataMAC = Just mac+ , cipherDataPadding = Nothing+ }++ get3 s ls = maybe (throwError $ Error_Packet "record bad format") return $ partition3 s ls get2 s (d1,d2) = get3 s (d1,d2,0) >>= \(r1,r2,_) -> return (r1,r2)
Network/TLS/Record/Engage.hs view
@@ -58,7 +58,6 @@ let writekey = cstKey cst case bulkF bulk of- BulkNoneF -> return content BulkBlockF encrypt _ -> do let blockSize = fromIntegral $ bulkBlockSize bulk let msg_len = B.length content
Tests/Connection.hs view
@@ -47,19 +47,8 @@ } } -nullCipher = blockCipher- { cipherID = 0xff14- , cipherBulk = Bulk- { bulkName = "null"- , bulkKeySize = 0- , bulkIVSize = 0- , bulkBlockSize = 0- , bulkF = BulkNoneF- }- }- supportedCiphers :: [Cipher]-supportedCiphers = [blockCipher,streamCipher,nullCipher]+supportedCiphers = [blockCipher,streamCipher] supportedVersions :: [Version] supportedVersions = [SSL3,TLS10,TLS11,TLS12]
tls.cabal view
@@ -1,5 +1,5 @@ Name: tls-Version: 1.1.3+Version: 1.1.4 Description: Native Haskell TLS and SSL protocol implementation for server and client. .