Separate finish from certificate verify digests. Will make it easier to support TLS1.2.
This commit is contained in:
parent
2ca69771a4
commit
039c7d254e
3 changed files with 46 additions and 5 deletions
|
@ -74,6 +74,7 @@ processHandshake hs = do
|
||||||
Finished fdata -> processClientFinished fdata
|
Finished fdata -> processClientFinished fdata
|
||||||
_ -> return ()
|
_ -> return ()
|
||||||
when (finishHandshakeTypeMaterial $ typeOfHandshake hs) (updateHandshakeDigest $ encodeHandshake hs)
|
when (finishHandshakeTypeMaterial $ typeOfHandshake hs) (updateHandshakeDigest $ encodeHandshake hs)
|
||||||
|
when (certVerifyHandshakeTypeMaterial $ typeOfHandshake hs) (updateCertVerifyDigest $ encodeHandshake hs)
|
||||||
where
|
where
|
||||||
-- secure renegotiation
|
-- secure renegotiation
|
||||||
processClientExtension (0xff01, content) = do
|
processClientExtension (0xff01, content) = do
|
||||||
|
|
|
@ -69,6 +69,7 @@ preProcessPacket (Handshake hss) = forM_ hss $ \hs -> do
|
||||||
Finished fdata -> updateVerifiedData True fdata
|
Finished fdata -> updateVerifiedData True fdata
|
||||||
_ -> return ()
|
_ -> return ()
|
||||||
when (finishHandshakeTypeMaterial $ typeOfHandshake hs) (updateHandshakeDigest $ encodeHandshake hs)
|
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
|
- writePacket transform a packet into marshalled data related to current state
|
||||||
|
|
|
@ -24,6 +24,8 @@ module Network.TLS.State
|
||||||
, updateVerifiedData
|
, updateVerifiedData
|
||||||
, finishHandshakeTypeMaterial
|
, finishHandshakeTypeMaterial
|
||||||
, finishHandshakeMaterial
|
, finishHandshakeMaterial
|
||||||
|
, certVerifyHandshakeTypeMaterial
|
||||||
|
, certVerifyHandshakeMaterial
|
||||||
, makeDigest
|
, makeDigest
|
||||||
, setMasterSecret
|
, setMasterSecret
|
||||||
, setMasterSecretFromPre
|
, setMasterSecretFromPre
|
||||||
|
@ -31,6 +33,7 @@ module Network.TLS.State
|
||||||
, setPrivateKey
|
, setPrivateKey
|
||||||
, setClientPublicKey
|
, setClientPublicKey
|
||||||
, setClientPrivateKey
|
, setClientPrivateKey
|
||||||
|
, getHandshakeMessages
|
||||||
, setClientCertSent
|
, setClientCertSent
|
||||||
, getClientCertSent
|
, getClientCertSent
|
||||||
, setClientCertChain
|
, setClientCertChain
|
||||||
|
@ -63,6 +66,7 @@ module Network.TLS.State
|
||||||
, startHandshakeClient
|
, startHandshakeClient
|
||||||
, updateHandshakeDigest
|
, updateHandshakeDigest
|
||||||
, getHandshakeDigest
|
, getHandshakeDigest
|
||||||
|
, updateCertVerifyDigest
|
||||||
, getCertVerifyDigest
|
, getCertVerifyDigest
|
||||||
, endHandshake
|
, endHandshake
|
||||||
) where
|
) where
|
||||||
|
@ -113,6 +117,8 @@ data TLSHandshakeState = TLSHandshakeState
|
||||||
, hstRSAClientPublicKey :: !(Maybe PublicKey)
|
, hstRSAClientPublicKey :: !(Maybe PublicKey)
|
||||||
, hstRSAClientPrivateKey :: !(Maybe PrivateKey)
|
, hstRSAClientPrivateKey :: !(Maybe PrivateKey)
|
||||||
, hstHandshakeDigest :: !HashCtx
|
, hstHandshakeDigest :: !HashCtx
|
||||||
|
, hstCertVerifyDigest :: !HashCtx
|
||||||
|
, hstHandshakeMessages :: [Bytes]
|
||||||
, hstClientCertRequest :: !(Maybe ClientCertRequestData) -- ^ Set to Just-value when certificate request was received
|
, hstClientCertRequest :: !(Maybe ClientCertRequestData) -- ^ Set to Just-value when certificate request was received
|
||||||
, hstClientCertSent :: !Bool -- ^ Set to true when a client certificate chain was sent
|
, hstClientCertSent :: !Bool -- ^ Set to true when a client certificate chain was sent
|
||||||
, hstClientCertChain :: !(Maybe [X509])
|
, hstClientCertChain :: !(Maybe [X509])
|
||||||
|
@ -250,6 +256,22 @@ finishHandshakeTypeMaterial HandshakeType_NPN = True
|
||||||
finishHandshakeMaterial :: Handshake -> Bool
|
finishHandshakeMaterial :: Handshake -> Bool
|
||||||
finishHandshakeMaterial = finishHandshakeTypeMaterial . typeOfHandshake
|
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, switchRxEncryption :: MonadState TLSState m => m ()
|
||||||
switchTxEncryption = modify (\st -> st { stTxEncrypted = True })
|
switchTxEncryption = modify (\st -> st { stTxEncrypted = True })
|
||||||
switchRxEncryption = modify (\st -> st { stRxEncrypted = 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 :: MonadState TLSState m => PrivateKey -> m ()
|
||||||
setClientPrivateKey pk = updateHandshake "client privatekey" (\hst -> hst { hstRSAClientPrivateKey = Just pk })
|
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 :: MonadState TLSState m => Bool -> m ()
|
||||||
setClientCertSent b = updateHandshake "client cert sent" (\hst -> hst { hstClientCertSent = b })
|
setClientCertSent b = updateHandshake "client cert sent" (\hst -> hst { hstClientCertSent = b })
|
||||||
|
|
||||||
|
@ -418,8 +448,8 @@ isClientContext :: MonadState TLSState m => m Bool
|
||||||
isClientContext = get >>= return . stClientContext
|
isClientContext = get >>= return . stClientContext
|
||||||
|
|
||||||
-- create a new empty handshake state
|
-- create a new empty handshake state
|
||||||
newEmptyHandshake :: Version -> ClientRandom -> HashCtx -> TLSHandshakeState
|
newEmptyHandshake :: Version -> ClientRandom -> HashCtx -> HashCtx -> TLSHandshakeState
|
||||||
newEmptyHandshake ver crand digestInit = TLSHandshakeState
|
newEmptyHandshake ver crand digestInit certVerifyInit = TLSHandshakeState
|
||||||
{ hstClientVersion = ver
|
{ hstClientVersion = ver
|
||||||
, hstClientRandom = crand
|
, hstClientRandom = crand
|
||||||
, hstServerRandom = Nothing
|
, hstServerRandom = Nothing
|
||||||
|
@ -429,6 +459,8 @@ newEmptyHandshake ver crand digestInit = TLSHandshakeState
|
||||||
, hstRSAClientPublicKey = Nothing
|
, hstRSAClientPublicKey = Nothing
|
||||||
, hstRSAClientPrivateKey = Nothing
|
, hstRSAClientPrivateKey = Nothing
|
||||||
, hstHandshakeDigest = digestInit
|
, hstHandshakeDigest = digestInit
|
||||||
|
, hstCertVerifyDigest = certVerifyInit
|
||||||
|
, hstHandshakeMessages = []
|
||||||
, hstClientCertRequest = Nothing
|
, hstClientCertRequest = Nothing
|
||||||
, hstClientCertSent = False
|
, hstClientCertSent = False
|
||||||
, hstClientCertChain = Nothing
|
, hstClientCertChain = Nothing
|
||||||
|
@ -438,9 +470,11 @@ startHandshakeClient :: MonadState TLSState m => Version -> ClientRandom -> m ()
|
||||||
startHandshakeClient ver crand = do
|
startHandshakeClient ver crand = do
|
||||||
-- FIXME check if handshake is already not null
|
-- FIXME check if handshake is already not null
|
||||||
let initCtx = if ver < TLS12 then hashMD5SHA1 else hashSHA256
|
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
|
chs <- get >>= return . stHandshake
|
||||||
when (isNothing chs) $
|
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 :: MonadState TLSState m => String -> m ()
|
||||||
hasValidHandshake name = get >>= \st -> assert name [ ("valid handshake", isNothing $ stHandshake st) ]
|
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 :: MonadState TLSState m => Bytes -> m ()
|
||||||
updateHandshakeDigest content = updateHandshake "update digest" $ \hs ->
|
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 :: MonadState TLSState m => Bool -> m Bytes
|
||||||
getHandshakeDigest client = do
|
getHandshakeDigest client = do
|
||||||
|
@ -462,11 +497,15 @@ getHandshakeDigest client = do
|
||||||
let msecret = fromJust "master secret" $ hstMasterSecret hst
|
let msecret = fromJust "master secret" $ hstMasterSecret hst
|
||||||
return $ (if client then generateClientFinished else generateServerFinished) (stVersion st) msecret hashctx
|
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 :: MonadState TLSState m => m Bytes
|
||||||
getCertVerifyDigest = do
|
getCertVerifyDigest = do
|
||||||
st <- get
|
st <- get
|
||||||
let hst = fromJust "handshake" $ stHandshake st
|
let hst = fromJust "handshake" $ stHandshake st
|
||||||
let hashctx = hstHandshakeDigest hst
|
let hashctx = hstCertVerifyDigest hst
|
||||||
return (hashFinal hashctx)
|
return (hashFinal hashctx)
|
||||||
|
|
||||||
endHandshake :: MonadState TLSState m => m ()
|
endHandshake :: MonadState TLSState m => m ()
|
||||||
|
|
Loading…
Reference in a new issue