Separate finish from certificate verify digests. Will make it easier to support TLS1.2.

This commit is contained in:
Martin Grabmueller 2012-07-16 16:19:48 +02:00
parent 2ca69771a4
commit 039c7d254e
3 changed files with 46 additions and 5 deletions

View file

@ -74,6 +74,7 @@ processHandshake hs = do
Finished fdata -> processClientFinished fdata
_ -> return ()
when (finishHandshakeTypeMaterial $ typeOfHandshake hs) (updateHandshakeDigest $ encodeHandshake hs)
when (certVerifyHandshakeTypeMaterial $ typeOfHandshake hs) (updateCertVerifyDigest $ encodeHandshake hs)
where
-- secure renegotiation
processClientExtension (0xff01, content) = do

View file

@ -69,6 +69,7 @@ preProcessPacket (Handshake hss) = forM_ hss $ \hs -> do
Finished fdata -> updateVerifiedData True fdata
_ -> return ()
when (finishHandshakeTypeMaterial $ typeOfHandshake hs) (updateHandshakeDigest $ encodeHandshake hs)
when (certVerifyHandshakeTypeMaterial $ typeOfHandshake hs) (updateCertVerifyDigest $ encodeHandshake hs)
{-
- writePacket transform a packet into marshalled data related to current state

View file

@ -24,6 +24,8 @@ module Network.TLS.State
, updateVerifiedData
, finishHandshakeTypeMaterial
, finishHandshakeMaterial
, certVerifyHandshakeTypeMaterial
, certVerifyHandshakeMaterial
, makeDigest
, setMasterSecret
, setMasterSecretFromPre
@ -31,6 +33,7 @@ module Network.TLS.State
, setPrivateKey
, setClientPublicKey
, setClientPrivateKey
, getHandshakeMessages
, setClientCertSent
, getClientCertSent
, setClientCertChain
@ -63,6 +66,7 @@ module Network.TLS.State
, startHandshakeClient
, updateHandshakeDigest
, getHandshakeDigest
, updateCertVerifyDigest
, getCertVerifyDigest
, endHandshake
) where
@ -113,6 +117,8 @@ data TLSHandshakeState = TLSHandshakeState
, hstRSAClientPublicKey :: !(Maybe PublicKey)
, hstRSAClientPrivateKey :: !(Maybe PrivateKey)
, hstHandshakeDigest :: !HashCtx
, hstCertVerifyDigest :: !HashCtx
, hstHandshakeMessages :: [Bytes]
, hstClientCertRequest :: !(Maybe ClientCertRequestData) -- ^ Set to Just-value when certificate request was received
, hstClientCertSent :: !Bool -- ^ Set to true when a client certificate chain was sent
, hstClientCertChain :: !(Maybe [X509])
@ -250,6 +256,22 @@ finishHandshakeTypeMaterial HandshakeType_NPN = True
finishHandshakeMaterial :: Handshake -> Bool
finishHandshakeMaterial = finishHandshakeTypeMaterial . typeOfHandshake
certVerifyHandshakeTypeMaterial :: HandshakeType -> Bool
certVerifyHandshakeTypeMaterial HandshakeType_ClientHello = True
certVerifyHandshakeTypeMaterial HandshakeType_ServerHello = True
certVerifyHandshakeTypeMaterial HandshakeType_Certificate = True
certVerifyHandshakeTypeMaterial HandshakeType_HelloRequest = False
certVerifyHandshakeTypeMaterial HandshakeType_ServerHelloDone = True
certVerifyHandshakeTypeMaterial HandshakeType_ClientKeyXchg = True
certVerifyHandshakeTypeMaterial HandshakeType_ServerKeyXchg = True
certVerifyHandshakeTypeMaterial HandshakeType_CertRequest = True
certVerifyHandshakeTypeMaterial HandshakeType_CertVerify = False
certVerifyHandshakeTypeMaterial HandshakeType_Finished = False
certVerifyHandshakeTypeMaterial HandshakeType_NPN = False
certVerifyHandshakeMaterial :: Handshake -> Bool
certVerifyHandshakeMaterial = certVerifyHandshakeTypeMaterial . typeOfHandshake
switchTxEncryption, switchRxEncryption :: MonadState TLSState m => m ()
switchTxEncryption = modify (\st -> st { stTxEncrypted = True })
switchRxEncryption = modify (\st -> st { stRxEncrypted = True })
@ -290,6 +312,14 @@ setClientPublicKey pk = updateHandshake "client publickey" (\hst -> hst { hstRSA
setClientPrivateKey :: MonadState TLSState m => PrivateKey -> m ()
setClientPrivateKey pk = updateHandshake "client privatekey" (\hst -> hst { hstRSAClientPrivateKey = Just pk })
getHandshakeMessages :: MonadState TLSState m => m [Bytes]
getHandshakeMessages = do
st <- get
case stHandshake st of
Nothing -> return []
Just hst -> return $ hstHandshakeMessages hst
setClientCertSent :: MonadState TLSState m => Bool -> m ()
setClientCertSent b = updateHandshake "client cert sent" (\hst -> hst { hstClientCertSent = b })
@ -418,8 +448,8 @@ isClientContext :: MonadState TLSState m => m Bool
isClientContext = get >>= return . stClientContext
-- create a new empty handshake state
newEmptyHandshake :: Version -> ClientRandom -> HashCtx -> TLSHandshakeState
newEmptyHandshake ver crand digestInit = TLSHandshakeState
newEmptyHandshake :: Version -> ClientRandom -> HashCtx -> HashCtx -> TLSHandshakeState
newEmptyHandshake ver crand digestInit certVerifyInit = TLSHandshakeState
{ hstClientVersion = ver
, hstClientRandom = crand
, hstServerRandom = Nothing
@ -429,6 +459,8 @@ newEmptyHandshake ver crand digestInit = TLSHandshakeState
, hstRSAClientPublicKey = Nothing
, hstRSAClientPrivateKey = Nothing
, hstHandshakeDigest = digestInit
, hstCertVerifyDigest = certVerifyInit
, hstHandshakeMessages = []
, hstClientCertRequest = Nothing
, hstClientCertSent = False
, hstClientCertChain = Nothing
@ -438,9 +470,11 @@ startHandshakeClient :: MonadState TLSState m => Version -> ClientRandom -> m ()
startHandshakeClient ver crand = do
-- FIXME check if handshake is already not null
let initCtx = if ver < TLS12 then hashMD5SHA1 else hashSHA256
initCertVerify = if ver < TLS12 then hashMD5SHA1 else hashSHA256
-- FIXME: may be other hash as determined by certificate request.
chs <- get >>= return . stHandshake
when (isNothing chs) $
modify (\st -> st { stHandshake = Just $ newEmptyHandshake ver crand initCtx })
modify (\st -> st { stHandshake = Just $ newEmptyHandshake ver crand initCtx initCertVerify })
hasValidHandshake :: MonadState TLSState m => String -> m ()
hasValidHandshake name = get >>= \st -> assert name [ ("valid handshake", isNothing $ stHandshake st) ]
@ -452,7 +486,8 @@ updateHandshake n f = do
updateHandshakeDigest :: MonadState TLSState m => Bytes -> m ()
updateHandshakeDigest content = updateHandshake "update digest" $ \hs ->
hs { hstHandshakeDigest = hashUpdate (hstHandshakeDigest hs) content }
hs { hstHandshakeDigest = hashUpdate (hstHandshakeDigest hs) content
, hstHandshakeMessages = content : hstHandshakeMessages hs }
getHandshakeDigest :: MonadState TLSState m => Bool -> m Bytes
getHandshakeDigest client = do
@ -462,11 +497,15 @@ getHandshakeDigest client = do
let msecret = fromJust "master secret" $ hstMasterSecret hst
return $ (if client then generateClientFinished else generateServerFinished) (stVersion st) msecret hashctx
updateCertVerifyDigest :: MonadState TLSState m => Bytes -> m ()
updateCertVerifyDigest content = updateHandshake "update certverify digest" $ \hs ->
hs { hstCertVerifyDigest = hashUpdate (hstCertVerifyDigest hs) content }
getCertVerifyDigest :: MonadState TLSState m => m Bytes
getCertVerifyDigest = do
st <- get
let hst = fromJust "handshake" $ stHandshake st
let hashctx = hstHandshakeDigest hst
let hashctx = hstCertVerifyDigest hst
return (hashFinal hashctx)
endHandshake :: MonadState TLSState m => m ()