From 3e82cc744ab30a49eb67a59b10f0c05291f9b556 Mon Sep 17 00:00:00 2001 From: Vincent Hanquez Date: Mon, 19 Nov 2012 09:39:35 +0000 Subject: [PATCH] fix issue when re-handshaking with a different cipher. tls was correctly accounting for the difference between pending state and active state in most place except for the actual cipher encryption/decryption functions in use. Hence when re-negociating with a different cipher than the current cipher, which is fairly unusual but perfectly allowed, the lowlevel function were switch at the server hello instead of being switch at the switch(Tx/Rx). --- core/Network/TLS/Handshake/Server.hs | 6 ++--- core/Network/TLS/Receiving.hs | 2 +- core/Network/TLS/Record/Disengage.hs | 2 +- core/Network/TLS/Record/Engage.hs | 2 +- core/Network/TLS/State.hs | 34 ++++++++++++++++------------ 5 files changed, 26 insertions(+), 20 deletions(-) diff --git a/core/Network/TLS/Handshake/Server.hs b/core/Network/TLS/Handshake/Server.hs index fa62c94..17e36bb 100644 --- a/core/Network/TLS/Handshake/Server.hs +++ b/core/Network/TLS/Handshake/Server.hs @@ -93,9 +93,9 @@ handshakeServerWith sparams ctx clientHello@(ClientHello ver _ clientSession cip when (null commonCompressions) $ throwCore $ Error_Protocol ("no compression in common with the client", True, HandshakeFailure) usingState_ ctx $ modify (\st -> st - { stVersion = ver - , stCipher = Just usedCipher - , stCompression = usedCompression + { stVersion = ver + , stPendingCipher = Just usedCipher + , stCompression = usedCompression }) resumeSessionData <- case clientSession of diff --git a/core/Network/TLS/Receiving.hs b/core/Network/TLS/Receiving.hs index bd64923..3ec402e 100644 --- a/core/Network/TLS/Receiving.hs +++ b/core/Network/TLS/Receiving.hs @@ -45,7 +45,7 @@ processPacket (Record ProtocolType_ChangeCipherSpec _ fragment) = do processPacket (Record ProtocolType_Handshake ver fragment) = do keyxchg <- getCipherKeyExchangeType - npn <- getExtensionNPN + npn <- getExtensionNPN let currentparams = CurrentParams { cParamsVersion = ver , cParamsKeyXchgType = maybe CipherKeyExchange_RSA id $ keyxchg diff --git a/core/Network/TLS/Record/Disengage.hs b/core/Network/TLS/Record/Disengage.hs index 36c1a8c..c49758d 100644 --- a/core/Network/TLS/Record/Disengage.hs +++ b/core/Network/TLS/Record/Disengage.hs @@ -66,7 +66,7 @@ decryptData :: Bytes -> TLSSt CipherData decryptData econtent = do st <- get - let cipher = fromJust "cipher" $ stCipher st + let cipher = fromJust "cipher" $ stActiveRxCipher st let bulk = cipherBulk cipher let cst = fromJust "rx crypt state" $ stActiveRxCryptState st let digestSize = hashSize $ cipherHash cipher diff --git a/core/Network/TLS/Record/Engage.hs b/core/Network/TLS/Record/Engage.hs index 1198a52..2644ab3 100644 --- a/core/Network/TLS/Record/Engage.hs +++ b/core/Network/TLS/Record/Engage.hs @@ -51,7 +51,7 @@ encryptData :: ByteString -> TLSSt ByteString encryptData content = do st <- get - let cipher = fromJust "cipher" $ stCipher st + let cipher = fromJust "cipher" $ stActiveTxCipher st let bulk = cipherBulk cipher let cst = fromJust "tx crypt state" $ stActiveTxCryptState st diff --git a/core/Network/TLS/State.hs b/core/Network/TLS/State.hs index 97e584b..30348b1 100644 --- a/core/Network/TLS/State.hs +++ b/core/Network/TLS/State.hs @@ -148,7 +148,9 @@ data TLSState = TLSState , stActiveRxMacState :: !(Maybe TLSMacState) , stPendingTxMacState :: !(Maybe TLSMacState) , stPendingRxMacState :: !(Maybe TLSMacState) - , stCipher :: Maybe Cipher + , stActiveTxCipher :: Maybe Cipher + , stActiveRxCipher :: Maybe Cipher + , stPendingCipher :: Maybe Cipher , stCompression :: Compression , stRandomGen :: StateRNG , stSecureRenegotiation :: Bool -- RFC 5746 @@ -193,7 +195,9 @@ newTLSState rng = TLSState , stActiveRxMacState = Nothing , stPendingTxMacState = Nothing , stPendingRxMacState = Nothing - , stCipher = Nothing + , stActiveTxCipher = Nothing + , stActiveRxCipher = Nothing + , stPendingCipher = Nothing , stCompression = nullCompression , stRandomGen = StateRNG rng , stSecureRenegotiation = False @@ -230,7 +234,7 @@ makeDigest w hdr content = do let ver = stVersion st let cst = fromJust "crypt state" $ if w then stActiveTxCryptState st else stActiveRxCryptState st let ms = fromJust "mac state" $ if w then stActiveTxMacState st else stActiveRxMacState st - let cipher = fromJust "cipher" $ stCipher st + let cipher = fromJust "cipher" $ if w then stActiveTxCipher st else stActiveRxCipher st let hashf = hashF $ cipherHash cipher let (macF, msg) = @@ -284,12 +288,14 @@ certVerifyHandshakeMaterial :: Handshake -> Bool certVerifyHandshakeMaterial = certVerifyHandshakeTypeMaterial . typeOfHandshake switchTxEncryption, switchRxEncryption :: MonadState TLSState m => m () -switchTxEncryption = modify (\st -> st { stTxEncrypted = True, - stActiveTxMacState = stPendingTxMacState st, - stActiveTxCryptState = stPendingTxCryptState st }) -switchRxEncryption = modify (\st -> st { stRxEncrypted = True, - stActiveRxMacState = stPendingRxMacState st, - stActiveRxCryptState = stPendingRxCryptState st }) +switchTxEncryption = modify (\st -> st { stTxEncrypted = True + , stActiveTxMacState = stPendingTxMacState st + , stActiveTxCryptState = stPendingTxCryptState st + , stActiveTxCipher = stPendingCipher st }) +switchRxEncryption = modify (\st -> st { stRxEncrypted = True + , stActiveRxMacState = stPendingRxMacState st + , stActiveRxCryptState = stPendingRxCryptState st + , stActiveRxCipher = stPendingCipher st }) setServerRandom :: MonadState TLSState m => ServerRandom -> m () setServerRandom ran = updateHandshake "srand" (\hst -> hst { hstServerRandom = Just ran }) @@ -359,7 +365,7 @@ getSessionData = get >>= \st -> return (stHandshake st >>= hstMasterSecret >>= w where wrapSessionData st masterSecret = do return $ SessionData { sessionVersion = stVersion st - , sessionCipher = cipherID $ fromJust "cipher" $ stCipher st + , sessionCipher = cipherID $ fromJust "cipher" $ stActiveTxCipher st , sessionSecret = masterSecret } @@ -375,7 +381,7 @@ isSessionResuming = gets stSessionResuming needEmptyPacket :: MonadState TLSState m => m Bool needEmptyPacket = gets f where f st = (stVersion st <= TLS10) - && (maybe False (\c -> bulkBlockSize (cipherBulk c) > 0) (stCipher st)) + && (maybe False (\c -> bulkBlockSize (cipherBulk c) > 0) (stActiveTxCipher st)) setKeyBlock :: MonadState TLSState m => m () setKeyBlock = modify setPendingState where @@ -386,7 +392,7 @@ setKeyBlock = modify setPendingState where } where hst = fromJust "handshake" $ stHandshake st cc = stClientContext st - cipher = fromJust "cipher" $ stCipher st + cipher = fromJust "cipher" $ stPendingCipher st keyblockSize = cipherKeyBlockSize cipher bulk = cipherBulk cipher @@ -410,7 +416,7 @@ setKeyBlock = modify setPendingState where msServer = TLSMacState { msSequence = 0 } setCipher :: MonadState TLSState m => Cipher -> m () -setCipher cipher = modify (\st -> st { stCipher = Just cipher }) +setCipher cipher = modify (\st -> st { stPendingCipher = Just cipher }) setVersion :: MonadState TLSState m => Version -> m () setVersion ver = modify (\st -> st { stVersion = ver }) @@ -446,7 +452,7 @@ getClientCertificateChain :: MonadState TLSState m => m (Maybe [X509]) getClientCertificateChain = gets stClientCertificateChain getCipherKeyExchangeType :: MonadState TLSState m => m (Maybe CipherKeyExchangeType) -getCipherKeyExchangeType = gets (\st -> cipherKeyExchange <$> stCipher st) +getCipherKeyExchangeType = gets (\st -> cipherKeyExchange <$> stPendingCipher st) getVerifiedData :: MonadState TLSState m => Bool -> m Bytes getVerifiedData client = gets (if client then stClientVerifiedData else stServerVerifiedData)