explicitly pass role and version to setMasterSecret and derivative
This commit is contained in:
Vincent Hanquez
parent
a2c062c772
commit
7489fdbbec
4 changed files with 20 additions and 17 deletions
|
|
@ -23,6 +23,7 @@ import Network.TLS.Sending
|
|||
import Network.TLS.Receiving
|
||||
import Network.TLS.Measurement
|
||||
import Network.TLS.Wire (encodeWord16)
|
||||
import Network.TLS.Types
|
||||
import Network.TLS.X509
|
||||
import Data.Maybe
|
||||
import Data.List (find)
|
||||
|
|
@ -119,7 +120,7 @@ handshakeClient cparams ctx = do
|
|||
case resumingSession of
|
||||
Nothing -> return $ RecvStateHandshake processCertificate
|
||||
Just sessionData -> do
|
||||
usingState_ ctx (setMasterSecret $ sessionSecret sessionData)
|
||||
usingState_ ctx (setMasterSecret rver ClientRole $ sessionSecret sessionData)
|
||||
return $ RecvStateNext expectChangeCipher
|
||||
onServerHello _ p = unexpected (show p) (Just "server hello")
|
||||
|
||||
|
|
@ -192,7 +193,7 @@ sendClientData cparams ctx = sendCertificate >> sendClientKeyXchg >> sendCertifi
|
|||
xver <- getVersion
|
||||
prerand <- genRandom 46
|
||||
let premaster = encodePreMasterSecret xver prerand
|
||||
setMasterSecretFromPre premaster
|
||||
setMasterSecretFromPre xver ClientRole premaster
|
||||
|
||||
-- SSL3 implementation generally forget this length field since it's redundant,
|
||||
-- however TLS10 make it clear that the length field need to be present.
|
||||
|
|
|
|||
|
|
@ -20,6 +20,7 @@ import Network.TLS.Compression
|
|||
import Network.TLS.Packet
|
||||
import Network.TLS.Extension
|
||||
import Network.TLS.IO
|
||||
import Network.TLS.Types
|
||||
import Network.TLS.State hiding (getNegotiatedProtocol)
|
||||
import Network.TLS.Handshake.State
|
||||
import Network.TLS.Receiving
|
||||
|
|
@ -114,7 +115,7 @@ handshakeServerWith sparams ctx clientHello@(ClientHello ver _ clientSession cip
|
|||
usingState_ ctx (setSession clientSession True)
|
||||
serverhello <- makeServerHello clientSession
|
||||
sendPacket ctx $ Handshake [serverhello]
|
||||
usingState_ ctx $ setMasterSecret $ sessionSecret sessionData
|
||||
usingState_ ctx $ setMasterSecret ver ServerRole $ sessionSecret sessionData
|
||||
sendChangeCipherAndFinish ctx False
|
||||
recvChangeCipherAndFinish ctx
|
||||
handshakeTerminate ctx
|
||||
|
|
|
|||
|
|
@ -135,16 +135,18 @@ processServerHello _ = error "processServerHello called on wrong type"
|
|||
-- in case the version mismatch, generate a random master secret
|
||||
processClientKeyXchg :: ByteString -> TLSSt ()
|
||||
processClientKeyXchg encryptedPremaster = do
|
||||
ver <- getVersion
|
||||
role <- isClientContext
|
||||
expectedVer <- hstClientVersion . fromJust "handshake" . stHandshake <$> get
|
||||
random <- genRandom 48
|
||||
ePremaster <- decryptRSA encryptedPremaster
|
||||
case ePremaster of
|
||||
Left _ -> setMasterSecretFromPre random
|
||||
Left _ -> setMasterSecretFromPre ver role random
|
||||
Right premaster -> case decodePreMasterSecret premaster of
|
||||
Left _ -> setMasterSecretFromPre random
|
||||
Left _ -> setMasterSecretFromPre ver role random
|
||||
Right (ver, _)
|
||||
| ver /= expectedVer -> setMasterSecretFromPre random
|
||||
| otherwise -> setMasterSecretFromPre premaster
|
||||
| ver /= expectedVer -> setMasterSecretFromPre ver role random
|
||||
| otherwise -> setMasterSecretFromPre ver role premaster
|
||||
|
||||
processClientFinished :: FinishedData -> TLSSt ()
|
||||
processClientFinished fdata = do
|
||||
|
|
|
|||
|
|
@ -190,19 +190,19 @@ switchRxEncryption = modify (\st -> st { stRxState = fromJust "pending-rx" $ stP
|
|||
setServerRandom :: MonadState TLSState m => ServerRandom -> m ()
|
||||
setServerRandom ran = updateHandshake "srand" (\hst -> hst { hstServerRandom = Just ran })
|
||||
|
||||
setMasterSecret :: MonadState TLSState m => Bytes -> m ()
|
||||
setMasterSecret masterSecret = do
|
||||
setMasterSecret :: MonadState TLSState m => Version -> Role -> Bytes -> m ()
|
||||
setMasterSecret ver role masterSecret = do
|
||||
hasValidHandshake "master secret"
|
||||
|
||||
updateHandshake "master secret" (\hst -> hst { hstMasterSecret = Just masterSecret } )
|
||||
setKeyBlock
|
||||
setKeyBlock ver role
|
||||
return ()
|
||||
|
||||
setMasterSecretFromPre :: MonadState TLSState m => Bytes -> m ()
|
||||
setMasterSecretFromPre premasterSecret = do
|
||||
setMasterSecretFromPre :: MonadState TLSState m => Version -> Role -> Bytes -> m ()
|
||||
setMasterSecretFromPre ver role premasterSecret = do
|
||||
hasValidHandshake "generate master secret"
|
||||
st <- get
|
||||
setMasterSecret $ genSecret st
|
||||
setMasterSecret ver role $ genSecret st
|
||||
where genSecret st =
|
||||
let hst = fromJust "handshake" $ stHandshake st in
|
||||
generateMasterSecret (stVersion $ stRecordState st)
|
||||
|
|
@ -237,13 +237,12 @@ needEmptyPacket = gets f
|
|||
&& stClientContext st == ClientRole
|
||||
&& (maybe False (\c -> bulkBlockSize (cipherBulk c) > 0) (stCipher $ stTxState st))
|
||||
|
||||
setKeyBlock :: MonadState TLSState m => m ()
|
||||
setKeyBlock = modify setPendingState
|
||||
setKeyBlock :: MonadState TLSState m => Version -> Role -> m ()
|
||||
setKeyBlock ver cc = modify setPendingState
|
||||
where
|
||||
setPendingState st = st { stRecordState = newRst }
|
||||
where hst = fromJust "handshake" $ stHandshake st
|
||||
rst = stRecordState st
|
||||
cc = stClientContext rst
|
||||
cipher = fromJust "cipher" $ stPendingCipher rst
|
||||
keyblockSize = cipherKeyBlockSize cipher
|
||||
|
||||
|
|
@ -251,7 +250,7 @@ setKeyBlock = modify setPendingState
|
|||
digestSize = hashSize $ cipherHash cipher
|
||||
keySize = bulkKeySize bulk
|
||||
ivSize = bulkIVSize bulk
|
||||
kb = generateKeyBlock (stVersion rst) (hstClientRandom hst)
|
||||
kb = generateKeyBlock ver (hstClientRandom hst)
|
||||
(fromJust "server random" $ hstServerRandom hst)
|
||||
(fromJust "master secret" $ hstMasterSecret hst) keyblockSize
|
||||
|
||||
|
|
|
|||
Loading…
Reference in a new issue