tls 1.3.1 → 1.3.2
raw patch · 17 files changed
+144/−47 lines, 17 filesdep −byteable
Dependencies removed: byteable
Files
- Network/TLS.hs +4/−1
- Network/TLS/Cipher.hs +2/−0
- Network/TLS/Context/Internal.hs +13/−4
- Network/TLS/Extra/Cipher.hs +35/−0
- Network/TLS/Handshake/Common.hs +9/−2
- Network/TLS/Handshake/Process.hs +10/−3
- Network/TLS/Handshake/Server.hs +12/−0
- Network/TLS/Parameters.hs +15/−1
- Network/TLS/Receiving.hs +5/−7
- Network/TLS/Record.hs +1/−0
- Network/TLS/Record/Disengage.hs +14/−5
- Network/TLS/Record/Engage.hs +8/−12
- Network/TLS/Record/Types.hs +2/−5
- Network/TLS/Struct.hs +5/−2
- Network/TLS/Types.hs +1/−1
- Tests/Tests.hs +7/−2
- tls.cabal +1/−2
Network/TLS.hs view
@@ -58,6 +58,8 @@ -- * Information gathering , Information(..)+ , unClientRandom+ , unServerRandom , contextGetInformation -- * Credentials@@ -115,7 +117,8 @@ import Network.TLS.Struct ( TLSError(..), TLSException(..) , HashAndSignatureAlgorithm, HashAlgorithm(..), SignatureAlgorithm(..) , Header(..), ProtocolType(..), CertificateType(..)- , AlertDescription(..))+ , AlertDescription(..)+ , ClientRandom(..), ServerRandom(..)) import Network.TLS.Crypto (KxError(..)) import Network.TLS.Cipher import Network.TLS.Hooks
Network/TLS/Cipher.hs view
@@ -102,6 +102,8 @@ { bulkName :: String , bulkKeySize :: Int , bulkIVSize :: Int+ , bulkExplicitIV :: Int -- Explicit size for IV for AEAD Cipher, 0 otherwise+ , bulkAuthTagLen :: Int -- Authentication tag length in bytes for AEAD Cipher, 0 otherwise , bulkBlockSize :: Int , bulkF :: BulkFunctions }
Network/TLS/Context/Internal.hs view
@@ -76,9 +76,12 @@ -- | Information related to a running context, e.g. current cipher data Information = Information- { infoVersion :: Version- , infoCipher :: Cipher- , infoCompression :: Compression+ { infoVersion :: Version+ , infoCipher :: Cipher+ , infoCompression :: Compression+ , infoMasterSecret :: Maybe Bytes+ , infoClientRandom :: Maybe ClientRandom+ , infoServerRandom :: Maybe ServerRandom } deriving (Show,Eq) -- | A TLS Context keep tls specific state, parameters and backend information.@@ -125,9 +128,15 @@ contextGetInformation :: Context -> IO (Maybe Information) contextGetInformation ctx = do ver <- usingState_ ctx $ gets stVersion+ hstate <- getHState ctx+ let (ms, cr, sr) = case hstate of+ Just st -> (hstMasterSecret st,+ Just (hstClientRandom st),+ hstServerRandom st)+ Nothing -> (Nothing, Nothing, Nothing) (cipher,comp) <- failOnEitherError $ runRxState ctx $ gets $ \st -> (stCipher st, stCompression st) case (ver, cipher) of- (Just v, Just c) -> return $ Just $ Information v c comp+ (Just v, Just c) -> return $ Just $ Information v c comp ms cr sr _ -> return Nothing contextSend :: Context -> Bytes -> IO ()
Network/TLS/Extra/Cipher.hs view
@@ -35,6 +35,8 @@ , cipher_DHE_DSS_RC4_SHA1 , cipher_DHE_RSA_AES128GCM_SHA256 , cipher_ECDHE_RSA_AES128GCM_SHA256+ , cipher_ECDHE_RSA_AES128CBC_SHA256+ , cipher_ECDHE_RSA_AES128CBC_SHA ) where import qualified Data.ByteString as B@@ -151,6 +153,8 @@ { bulkName = "null" , bulkKeySize = 0 , bulkIVSize = 0+ , bulkExplicitIV = 0+ , bulkAuthTagLen = 0 , bulkBlockSize = 0 , bulkF = BulkStreamF passThrough }@@ -161,6 +165,8 @@ { bulkName = "RC4-128" , bulkKeySize = 16 , bulkIVSize = 0+ , bulkExplicitIV = 0+ , bulkAuthTagLen = 0 , bulkBlockSize = 0 , bulkF = BulkStreamF rc4 }@@ -169,6 +175,8 @@ { bulkName = "AES128" , bulkKeySize = 16 , bulkIVSize = 16+ , bulkExplicitIV = 0+ , bulkAuthTagLen = 0 , bulkBlockSize = 16 , bulkF = BulkBlockF aes128cbc }@@ -177,6 +185,8 @@ { bulkName = "AES128GCM" , bulkKeySize = 16 -- RFC 5116 Sec 5.1: K_LEN , bulkIVSize = 4 -- RFC 5288 GCMNonce.salt, fixed_iv_length+ , bulkExplicitIV = 8+ , bulkAuthTagLen = 16 , bulkBlockSize = 0 -- dummy, not used , bulkF = BulkAeadF aes128gcm }@@ -185,6 +195,8 @@ { bulkName = "AES256" , bulkKeySize = 32 , bulkIVSize = 16+ , bulkExplicitIV = 0+ , bulkAuthTagLen = 0 , bulkBlockSize = 16 , bulkF = BulkBlockF aes256cbc }@@ -193,6 +205,8 @@ { bulkName = "3DES-EDE-CBC" , bulkKeySize = 24 , bulkIVSize = 8+ , bulkExplicitIV = 0+ , bulkAuthTagLen = 0 , bulkBlockSize = 8 , bulkF = BulkBlockF tripledes_ede }@@ -371,6 +385,27 @@ { cipherID = 0xc02f , cipherName = "ECDHE-RSA-AES128GCM-SHA256" , cipherBulk = bulk_aes128gcm+ , cipherHash = SHA256+ , cipherKeyExchange = CipherKeyExchange_ECDHE_RSA+ , cipherMinVer = Just TLS12 -- RFC 5288 Sec 4+ }++cipher_ECDHE_RSA_AES128CBC_SHA :: Cipher+cipher_ECDHE_RSA_AES128CBC_SHA = Cipher+ { cipherID = 0xc013+ , cipherName = "ECDHE-RSA-AES128CBC-SHA"+ , cipherBulk = bulk_aes128+ , cipherHash = SHA1+ , cipherKeyExchange = CipherKeyExchange_ECDHE_RSA+ , cipherMinVer = Just TLS10+ }++--TLS_ECDHE_RSA_WITH_AES_128_CBC_SHA256 +cipher_ECDHE_RSA_AES128CBC_SHA256 :: Cipher+cipher_ECDHE_RSA_AES128CBC_SHA256 = Cipher+ { cipherID = 0xc027+ , cipherName = "ECDHE-RSA-AES128CBC-SHA"+ , cipherBulk = bulk_aes128 , cipherHash = SHA256 , cipherKeyExchange = CipherKeyExchange_ECDHE_RSA , cipherMinVer = Just TLS12 -- RFC 5288 Sec 4
Network/TLS/Handshake/Common.hs view
@@ -60,8 +60,15 @@ sessionData <- getSessionData ctx liftIO $ sessionEstablish (sharedSessionManager $ ctxShared ctx) sessionId (fromJust "session-data" sessionData) _ -> return ()- -- forget all handshake data now and reset bytes counters.- liftIO $ modifyMVar_ (ctxHandshake ctx) (return . const Nothing)+ -- forget most handshake data and reset bytes counters.+ liftIO $ modifyMVar_ (ctxHandshake ctx) $ \ mhshake ->+ case mhshake of+ Nothing -> return Nothing+ Just hshake ->+ return $ Just (newEmptyHandshake (hstClientVersion hshake) (hstClientRandom hshake))+ { hstServerRandom = hstServerRandom hshake+ , hstMasterSecret = hstMasterSecret hshake+ } updateMeasure ctx resetBytesCounters -- mark the secure connection up and running. setEstablished ctx True
Network/TLS/Handshake/Process.hs view
@@ -30,14 +30,19 @@ import Network.TLS.Handshake.State import Network.TLS.Handshake.Key import Network.TLS.Extension+import Network.TLS.Parameters import Data.X509 (CertificateChain(..), Certificate(..), getCertificate) processHandshake :: Context -> Handshake -> IO () processHandshake ctx hs = do role <- usingState_ ctx isClientContext case hs of- ClientHello cver ran _ _ _ ex _ -> when (role == ServerRole) $ do+ ClientHello cver ran _ cids _ ex _ -> when (role == ServerRole) $ do mapM_ (usingState_ ctx . processClientExtension) ex+ -- RFC 5746: secure renegotiation+ -- TLS_EMPTY_RENEGOTIATION_INFO_SCSV: {0x00, 0xFF}+ when (secureRenegotiation && (0xff `elem` cids)) $+ usingState_ ctx $ setSecureRenegotiation True startHandshake ctx cver ran Certificates certs -> processCertificates role certs ClientKeyXchg content -> when (role == ServerRole) $ do@@ -49,8 +54,10 @@ let encoded = encodeHandshake hs when (certVerifyHandshakeMaterial hs) $ usingHState ctx $ addHandshakeMessage encoded when (finishHandshakeTypeMaterial $ typeOfHandshake hs) $ usingHState ctx $ updateHandshakeDigest encoded- where -- secure renegotiation- processClientExtension (0xff01, content) = do+ where secureRenegotiation = supportedSecureRenegotiation $ ctxSupported ctx+ -- RFC5746: secure renegotiation+ -- the renegotiation_info extension: 0xff01+ processClientExtension (0xff01, content) | secureRenegotiation = do v <- getVerifiedData ClientRole let bs = extensionEncode (SecureRenegotiation v Nothing) unless (bs `bytesEq` content) $ throwError $ Error_Protocol ("client verified data not matching: " ++ show v ++ ":" ++ show content, True, HandshakeFailure)
Network/TLS/Handshake/Server.hs view
@@ -81,6 +81,12 @@ -- handshakeServerWith :: ServerParams -> Context -> Handshake -> IO () handshakeServerWith sparams ctx clientHello@(ClientHello clientVersion _ clientSession ciphers compressions exts _) = do+ -- rejecting client initiated renegotiation to prevent DOS.+ unless (supportedClientInitiatedRenegotiation (ctxSupported ctx)) $ do+ established <- ctxEstablished ctx+ eof <- ctxEOF ctx+ when (established && not eof) $+ throwCore $ Error_Protocol ("renegotiation is not allowed", False, NoRenegotiation) -- check if policy allow this new handshake to happens handshakeAuthorized <- withMeasure ctx (onNewHandshake $ serverHooks sparams) unless handshakeAuthorized (throwCore $ Error_HandshakePolicy "server: handshake denied")@@ -90,6 +96,12 @@ processHandshake ctx clientHello when (clientVersion == SSL2) $ throwCore $ Error_Protocol ("ssl2 is not supported", True, ProtocolVersion)+ -- Fallback SCSV: RFC7507+ -- TLS_FALLBACK_SCSV: {0x56, 0x00}+ when (supportedFallbackScsv (ctxSupported ctx) &&+ (0x5600 `elem` ciphers) &&+ clientVersion /= maxBound) $+ throwCore $ Error_Protocol ("fallback is not allowed", True, InappropriateFallback) chosenVersion <- case findHighestVersionFrom clientVersion (supportedVersions $ ctxSupported ctx) of Nothing -> throwCore $ Error_Protocol ("client version " ++ show clientVersion ++ " is not supported", True, ProtocolVersion) Just v -> return v
Network/TLS/Parameters.hs view
@@ -118,10 +118,22 @@ -- | All supported hash/signature algorithms pair for client -- certificate verification, ordered by decreasing priority. , supportedHashSignatures :: [HashAndSignatureAlgorithm]- -- | Set if we support secure renegotiation.+ -- | Secure renegotiation defined in RFC5746.+ -- If 'True', clients send the renegotiation_info extension.+ -- If 'True', servers handle the extension or the renegotiation SCSV+ -- then send the renegotiation_info extension. , supportedSecureRenegotiation :: Bool+ -- | If 'True', renegotiation is allowed from the client side.+ -- This is vulnerable to DOS attacks.+ -- If 'False', renegotiation is allowed only from the server side+ -- via HelloRequest.+ , supportedClientInitiatedRenegotiation :: Bool -- | Set if we support session. , supportedSession :: Bool+ -- | Support for fallback SCSV defined in RFC7507.+ -- If 'True', servers reject handshakes which suggest+ -- a lower protocol than the highest protocol supported.+ , supportedFallbackScsv :: Bool } deriving (Show,Eq) defaultSupported :: Supported@@ -137,7 +149,9 @@ , (Struct.HashSHA1, SignatureDSS) ] , supportedSecureRenegotiation = True+ , supportedClientInitiatedRenegotiation = False , supportedSession = True+ , supportedFallbackScsv = True } instance Default Supported where
Network/TLS/Receiving.hs view
@@ -28,16 +28,14 @@ import Network.TLS.Cipher import Network.TLS.Util -import Data.Byteable- processPacket :: Context -> Record Plaintext -> IO (Either TLSError Packet) -processPacket _ (Record ProtocolType_AppData _ fragment) = return $ Right $ AppData $ toBytes fragment+processPacket _ (Record ProtocolType_AppData _ fragment) = return $ Right $ AppData $ fragmentGetBytes fragment -processPacket _ (Record ProtocolType_Alert _ fragment) = return (Alert `fmapEither` (decodeAlerts $ toBytes fragment))+processPacket _ (Record ProtocolType_Alert _ fragment) = return (Alert `fmapEither` (decodeAlerts $ fragmentGetBytes fragment)) processPacket ctx (Record ProtocolType_ChangeCipherSpec _ fragment) =- case decodeChangeCipherSpec $ toBytes fragment of+ case decodeChangeCipherSpec $ fragmentGetBytes fragment of Left err -> return $ Left err Right _ -> do switchRxEncryption ctx return $ Right ChangeCipherSpec@@ -54,7 +52,7 @@ -- get back the optional continuation, and parse as many handshake record as possible. mCont <- gets stHandshakeRecordCont modify (\st -> st { stHandshakeRecordCont = Nothing })- hss <- parseMany currentParams mCont (toBytes fragment)+ hss <- parseMany currentParams mCont (fragmentGetBytes fragment) return $ Handshake hss where parseMany currentParams mCont bs = case maybe decodeHandshakeRecord id mCont $ bs of@@ -68,7 +66,7 @@ Right hh -> (hh:) `fmap` parseMany currentParams Nothing left processPacket _ (Record ProtocolType_DeprecatedHandshake _ fragment) =- case decodeDeprecatedHandshake $ toBytes fragment of+ case decodeDeprecatedHandshake $ fragmentGetBytes fragment of Left err -> return $ Left err Right hs -> return $ Right $ Handshake [hs]
Network/TLS/Record.hs view
@@ -15,6 +15,7 @@ ( Record(..) -- * Fragment manipulation types , Fragment+ , fragmentGetBytes , fragmentPlaintext , fragmentCiphertext , recordToRaw
Network/TLS/Record/Disengage.hs view
@@ -85,7 +85,10 @@ decryptOf :: BulkState -> RecordM Bytes decryptOf (BulkStateBlock decryptF) = do let minContent = (if explicitIV then bulkIVSize bulk else 0) + max (macSize + 1) blockSize++ -- check if we have enough bytes to cover the minimum for this cipher when ((econtentLen `mod` blockSize) /= 0 || econtentLen < minContent) $ sanityCheckError+ {- update IV -} (iv, econtent') <- if explicitIV then get2 econtent (bulkIVSize bulk, econtentLen - bulkIVSize bulk)@@ -103,7 +106,9 @@ } decryptOf (BulkStateStream (BulkStream decryptF)) = do+ -- check if we have enough bytes to cover the minimum for this cipher when (econtentLen < macSize) $ sanityCheckError+ let (content', bulkStream') = decryptF econtent {- update Ctx -} let contentlen = B.length content' - macSize@@ -116,13 +121,17 @@ } decryptOf (BulkStateAEAD decryptF) = do- let authtaglen = 16 -- FIXME: fixed_iv_length + record_iv_length- nonceexplen = 8 -- FIXME: record_iv_length- econtentlen = B.length econtent - authtaglen - nonceexplen- (enonce, econtent', authTag) <- get3 econtent (nonceexplen, econtentlen, authtaglen)+ let authTagLen = bulkAuthTagLen bulk+ nonceExpLen = bulkExplicitIV bulk+ cipherLen = econtentLen - authTagLen - nonceExpLen++ -- check if we have enough bytes to cover the minimum for this cipher+ when (econtentLen < (authTagLen + nonceExpLen)) $ sanityCheckError++ (enonce, econtent', authTag) <- get3 econtent (nonceExpLen, cipherLen, authTagLen) let encodedSeq = encodeWord64 $ msSequence $ stMacState tst Header typ v _ = recordToHeader record- hdr = Header typ v $ fromIntegral econtentlen+ hdr = Header typ v $ fromIntegral cipherLen ad = B.concat [ encodedSeq, encodeHeader hdr ] nonce = cstIV (stCryptState tst) `B.append` enonce (content, authTag2) = decryptF nonce econtent' ad
Network/TLS/Record/Engage.hs view
@@ -36,10 +36,9 @@ onRecordFragment record $ fragmentCompress $ \bytes -> do withCompression $ compressionDeflate bytes -{-- - when Tx Encrypted is set, we pass the data through encryptContent, otherwise- - we just return the packet- -}+-- when Tx Encrypted is set, we pass the data through encryptContent, otherwise+-- we just return the compress payload directly as the ciphered one+-- encryptRecord :: Record Compressed -> RecordM (Record Ciphertext) encryptRecord record = onRecordFragment record $ fragmentCipher $ \bytes -> do st <- get@@ -100,15 +99,12 @@ cst <- getCryptState encodedSeq <- encodeWord64 <$> getMacSequence - let hdr = recordToHeader record- ad = B.concat [ encodedSeq, encodeHeader hdr ]- let salt = cstIV cst- processorNum = encodeWord32 1 -- FIXME- counter = B.drop 4 encodedSeq -- FIXME: probably OK- nonce = B.concat [salt, processorNum, counter]- let (e, AuthTag authtag) = encryptF nonce content ad+ let hdr = recordToHeader record+ ad = B.concat [encodedSeq, encodeHeader hdr]+ nonce = B.concat [cstIV cst, encodedSeq]+ (e, AuthTag authtag) = encryptF nonce content ad modify incrRecordState- return $ B.concat [processorNum, counter, e, B.convert authtag]+ return $ B.concat [encodedSeq, e, B.convert authtag] getCryptState :: RecordM CryptState getCryptState = stCryptState <$> get
Network/TLS/Record/Types.hs view
@@ -20,6 +20,7 @@ , Record(..) -- * TLS Record fragment and constructors , Fragment+ , fragmentGetBytes , fragmentPlaintext , fragmentCiphertext , Plaintext@@ -40,13 +41,12 @@ import Network.TLS.Struct import Network.TLS.Record.State import qualified Data.ByteString as B-import Data.Byteable import Control.Applicative ((<$>)) -- | Represent a TLS record. data Record a = Record !ProtocolType !Version !(Fragment a) deriving (Show,Eq) -newtype Fragment a = Fragment Bytes deriving (Show,Eq)+newtype Fragment a = Fragment { fragmentGetBytes :: Bytes } deriving (Show,Eq) data Plaintext data Compressed@@ -57,9 +57,6 @@ fragmentCiphertext :: Bytes -> Fragment Ciphertext fragmentCiphertext bytes = Fragment bytes--instance Byteable (Fragment a) where- toBytes (Fragment b) = b onRecordFragment :: Record a -> (Fragment a -> RecordM (Fragment b)) -> RecordM (Record b) onRecordFragment (Record pt ver frag) f = Record pt ver <$> f frag
Network/TLS/Struct.hs view
@@ -174,8 +174,8 @@ data Header = Header ProtocolType Version Word16 deriving (Show,Eq) -newtype ServerRandom = ServerRandom Bytes deriving (Show, Eq)-newtype ClientRandom = ClientRandom Bytes deriving (Show, Eq)+newtype ServerRandom = ServerRandom { unServerRandom :: Bytes } deriving (Show, Eq)+newtype ClientRandom = ClientRandom { unClientRandom :: Bytes } deriving (Show, Eq) newtype Session = Session (Maybe SessionID) deriving (Show, Eq) type FinishedData = Bytes@@ -218,6 +218,7 @@ | ProtocolVersion | InsufficientSecurity | InternalError+ | InappropriateFallback -- RFC7507 | UserCanceled | NoRenegotiation | UnsupportedExtension@@ -447,6 +448,7 @@ valOfType ProtocolVersion = 70 valOfType InsufficientSecurity = 71 valOfType InternalError = 80+ valOfType InappropriateFallback = 86 valOfType UserCanceled = 90 valOfType NoRenegotiation = 100 valOfType UnsupportedExtension = 110@@ -476,6 +478,7 @@ valToType 70 = Just ProtocolVersion valToType 71 = Just InsufficientSecurity valToType 80 = Just InternalError+ valToType 86 = Just InappropriateFallback valToType 90 = Just UserCanceled valToType 100 = Just NoRenegotiation valToType 110 = Just UnsupportedExtension
Network/TLS/Types.hs view
@@ -22,7 +22,7 @@ -- | Versions known to TLS -- -- SSL2 is just defined, but this version is and will not be supported.-data Version = SSL2 | SSL3 | TLS10 | TLS11 | TLS12 deriving (Show, Eq, Ord)+data Version = SSL2 | SSL3 | TLS10 | TLS11 | TLS12 deriving (Show, Eq, Ord, Bounded) -- | A session ID type SessionID = ByteString
Tests/Tests.hs view
@@ -100,8 +100,13 @@ prop_handshake_renegociation :: PropertyM IO () prop_handshake_renegociation = do- params <- pick arbitraryPairParams- runTLSPipe params tlsServer tlsClient+ (cparams, sparams) <- pick arbitraryPairParams+ let sparams' = sparams {+ serverSupported = (serverSupported sparams) {+ supportedClientInitiatedRenegotiation = True+ }+ }+ runTLSPipe (cparams, sparams') tlsServer tlsClient where tlsServer ctx queue = do handshake ctx d <- recvDataNonNull ctx
tls.cabal view
@@ -1,5 +1,5 @@ Name: tls-Version: 1.3.1+Version: 1.3.2 Description: Native Haskell TLS and SSL protocol implementation for server and client. .@@ -37,7 +37,6 @@ , transformers , cereal >= 0.4 , bytestring- , byteable , network , data-default-class -- crypto related