Add a way to delay interpreting the SKX structure until actually needed.
In some case, with efficient servers, we end up parsing the SKX structure without having yet set the pending cipher. The cipher key exchange type being unknown at this stage, lead to not knowing how to parse the SKX structure. Fix it by keeping the byte un-interpreted when the cipher key exchange is not known, and properly parse later on. Fix #53.
This commit is contained in:
parent
5af55db180
commit
ffd061ef95
3 changed files with 47 additions and 18 deletions
|
@ -314,16 +314,24 @@ expectFinish (Finished _) = return RecvStateDone
|
|||
expectFinish p = unexpected (show p) (Just "Handshake Finished")
|
||||
|
||||
processServerKeyExchange :: Context -> Handshake -> IO (RecvState IO)
|
||||
processServerKeyExchange ctx (ServerKeyXchg skx) = do
|
||||
processServerKeyExchange ctx (ServerKeyXchg origSkx) = do
|
||||
cipher <- usingHState ctx getPendingCipher
|
||||
processWithCipher cipher origSkx
|
||||
return $ RecvStateHandshake (processCertificateRequest ctx)
|
||||
where processWithCipher cipher skx =
|
||||
case (cipherKeyExchange cipher, skx) of
|
||||
(CipherKeyExchange_DHE_RSA, SKX_DHE_RSA dhparams signature) -> do
|
||||
doDHESignature dhparams signature SignatureRSA
|
||||
(CipherKeyExchange_DHE_DSS, SKX_DHE_DSS dhparams signature) -> do
|
||||
doDHESignature dhparams signature SignatureDSS
|
||||
(cke, SKX_Unparsed bytes) -> do
|
||||
ver <- usingState_ ctx getVersion
|
||||
case decodeReallyServerKeyXchgAlgorithmData ver cke bytes of
|
||||
Left _ -> throwCore $ Error_Protocol ("unknown server key exchange received, expecting: " ++ show cke, True, HandshakeFailure)
|
||||
Right realSkx -> processWithCipher cipher realSkx
|
||||
-- we need to resolve the result. and recall processWithCipher ..
|
||||
(c,_) -> throwCore $ Error_Protocol ("unknown server key exchange received, expecting: " ++ show c, True, HandshakeFailure)
|
||||
return $ RecvStateHandshake (processCertificateRequest ctx)
|
||||
where doDHESignature dhparams signature signatureType = do
|
||||
doDHESignature dhparams signature signatureType = do
|
||||
-- TODO verify DHParams
|
||||
expectedData <- generateSignedDHParams ctx dhparams
|
||||
verified <- signatureVerify ctx signatureType expectedData signature
|
||||
|
|
|
@ -42,6 +42,8 @@ module Network.TLS.Packet
|
|||
, encodePreMasterSecret
|
||||
, encodeSignedDHParams
|
||||
|
||||
, decodeReallyServerKeyXchgAlgorithmData
|
||||
|
||||
-- * generate things for packet content
|
||||
, generateMasterSecret
|
||||
, generateKeyBlock
|
||||
|
@ -295,26 +297,31 @@ decodeServerKeyXchg_RSA :: Get ServerRSAParams
|
|||
decodeServerKeyXchg_RSA = ServerRSAParams <$> getInteger16 -- modulus
|
||||
<*> getInteger16 -- exponent
|
||||
|
||||
decodeServerKeyXchg :: CurrentParams -> Get Handshake
|
||||
decodeServerKeyXchg cp =
|
||||
case cParamsKeyXchgType cp of
|
||||
Just cke -> ServerKeyXchg <$> toCKE cke
|
||||
Nothing -> error "no server key exchange type"
|
||||
where toCKE cke = case cke of
|
||||
decodeServerKeyXchgAlgorithmData :: Version
|
||||
-> CipherKeyExchangeType
|
||||
-> Get ServerKeyXchgAlgorithmData
|
||||
decodeServerKeyXchgAlgorithmData ver cke = toCKE
|
||||
where toCKE = case cke of
|
||||
CipherKeyExchange_RSA -> SKX_RSA . Just <$> decodeServerKeyXchg_RSA
|
||||
CipherKeyExchange_DH_Anon -> SKX_DH_Anon <$> decodeServerKeyXchg_DH
|
||||
CipherKeyExchange_DHE_RSA -> do
|
||||
dhparams <- getServerDHParams
|
||||
signature <- getDigitallySigned (cParamsVersion cp)
|
||||
signature <- getDigitallySigned ver
|
||||
return $ SKX_DHE_RSA dhparams signature
|
||||
CipherKeyExchange_DHE_DSS -> do
|
||||
dhparams <- getServerDHParams
|
||||
signature <- getDigitallySigned (cParamsVersion cp)
|
||||
signature <- getDigitallySigned ver
|
||||
return $ SKX_DHE_DSS dhparams signature
|
||||
_ -> do
|
||||
bs <- remaining >>= getBytes
|
||||
return $ SKX_Unknown bs
|
||||
|
||||
decodeServerKeyXchg :: CurrentParams -> Get Handshake
|
||||
decodeServerKeyXchg cp =
|
||||
case cParamsKeyXchgType cp of
|
||||
Just cke -> ServerKeyXchg <$> decodeServerKeyXchgAlgorithmData (cParamsVersion cp) cke
|
||||
Nothing -> ServerKeyXchg . SKX_Unparsed <$> (remaining >>= getBytes)
|
||||
|
||||
encodeHandshake :: Handshake -> ByteString
|
||||
encodeHandshake o =
|
||||
let content = runPut $ encodeHandshakeContent o in
|
||||
|
@ -362,7 +369,8 @@ encodeHandshakeContent (ServerKeyXchg skg) =
|
|||
SKX_DH_Anon params -> putServerDHParams params
|
||||
SKX_DHE_RSA params sig -> putServerDHParams params >> putDigitallySigned sig
|
||||
SKX_DHE_DSS params sig -> putServerDHParams params >> putDigitallySigned sig
|
||||
_ -> error "cannot handle"
|
||||
SKX_Unparsed bytes -> putBytes bytes
|
||||
_ -> error ("encodeHandshakeContent: cannot handle: " ++ show skg)
|
||||
|
||||
encodeHandshakeContent (HelloRequest) = return ()
|
||||
encodeHandshakeContent (ServerHelloDone) = return ()
|
||||
|
@ -488,6 +496,18 @@ decodePreMasterSecret = runGetErr "pre-master-secret" $ do
|
|||
encodePreMasterSecret :: Version -> Bytes -> Bytes
|
||||
encodePreMasterSecret version bytes = runPut (putVersion version >> putBytes bytes)
|
||||
|
||||
-- | in certain cases, we haven't manage to decode ServerKeyExchange properly,
|
||||
-- because the decoding was too eager and the cipher wasn't been set yet.
|
||||
-- we keep the Server Key Exchange in it unparsed format, and this function is
|
||||
-- able to really decode the server key xchange if it's unparsed.
|
||||
decodeReallyServerKeyXchgAlgorithmData :: Version
|
||||
-> CipherKeyExchangeType
|
||||
-> Bytes
|
||||
-> Either TLSError ServerKeyXchgAlgorithmData
|
||||
decodeReallyServerKeyXchgAlgorithmData ver cke =
|
||||
runGetErr "server-key-xchg-algorithm-data" (decodeServerKeyXchgAlgorithmData ver cke)
|
||||
|
||||
|
||||
{-
|
||||
- generate things for packet content
|
||||
-}
|
||||
|
|
|
@ -238,6 +238,7 @@ data ServerKeyXchgAlgorithmData =
|
|||
| SKX_RSA (Maybe ServerRSAParams)
|
||||
| SKX_DH_DSS (Maybe ServerRSAParams)
|
||||
| SKX_DH_RSA (Maybe ServerRSAParams)
|
||||
| SKX_Unparsed Bytes -- if we parse the server key xchg before knowing the actual cipher, we end up with this structure.
|
||||
| SKX_Unknown Bytes
|
||||
deriving (Show,Eq)
|
||||
|
||||
|
|
Loading…
Reference in a new issue