Accept non-fatal UnrecognizedName alert after ClientHello.
Misconfigured servers send an "Unrecognized Name" warning in the SSL handshake which is ignored by most clients. Some stack would fail the same way (i.e. Java 7 with SNI enabled). Improve state machine slightly. Fix #53.
This commit is contained in:
parent
3e9a67761b
commit
14eb3c686c
3 changed files with 26 additions and 10 deletions
|
@ -103,7 +103,19 @@ handshakeClient cparams ctx = do
|
||||||
-- client didn't offer. do nothing.
|
-- client didn't offer. do nothing.
|
||||||
(Nothing, _) -> return ()
|
(Nothing, _) -> return ()
|
||||||
|
|
||||||
recvServerHello sentExts = runRecvState ctx (RecvStateHandshake $ onServerHello ctx cparams sentExts)
|
recvServerHello sentExts = runRecvState ctx recvState
|
||||||
|
where recvState = RecvStateNext $ \p ->
|
||||||
|
case p of
|
||||||
|
Handshake hs -> onRecvStateHandshake ctx (RecvStateHandshake $ onServerHello ctx cparams sentExts) hs
|
||||||
|
Alert a ->
|
||||||
|
case a of
|
||||||
|
[(AlertLevel_Warning, UnrecognizedName)] ->
|
||||||
|
if clientUseServerNameIndication cparams
|
||||||
|
then return recvState
|
||||||
|
else throwAlert a
|
||||||
|
_ -> throwAlert a
|
||||||
|
_ -> fail ("unexepected type received. expecting handshake and got: " ++ show p)
|
||||||
|
throwAlert a = usingState_ ctx $ throwError $ Error_Protocol ("expecting server hello, got alert : " ++ show a, True, HandshakeFailure)
|
||||||
|
|
||||||
-- | send client Data after receiving all server data (hello/certificates/key).
|
-- | send client Data after receiving all server data (hello/certificates/key).
|
||||||
--
|
--
|
||||||
|
|
|
@ -12,6 +12,7 @@ module Network.TLS.Handshake.Common
|
||||||
, RecvState(..)
|
, RecvState(..)
|
||||||
, runRecvState
|
, runRecvState
|
||||||
, recvPacketHandshake
|
, recvPacketHandshake
|
||||||
|
, onRecvStateHandshake
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Concurrent.MVar
|
import Control.Concurrent.MVar
|
||||||
|
@ -98,18 +99,19 @@ recvPacketHandshake ctx = do
|
||||||
Right x -> fail ("unexpected type received. expecting handshake and got: " ++ show x)
|
Right x -> fail ("unexpected type received. expecting handshake and got: " ++ show x)
|
||||||
Left err -> throwCore err
|
Left err -> throwCore err
|
||||||
|
|
||||||
|
-- | process a list of handshakes message in the recv state machine.
|
||||||
|
onRecvStateHandshake :: Context -> RecvState IO -> [Handshake] -> IO (RecvState IO)
|
||||||
|
onRecvStateHandshake _ recvState [] = return recvState
|
||||||
|
onRecvStateHandshake ctx (RecvStateHandshake f) (x:xs) = do
|
||||||
|
nstate <- f x
|
||||||
|
processHandshake ctx x
|
||||||
|
onRecvStateHandshake ctx nstate xs
|
||||||
|
onRecvStateHandshake _ _ _ = unexpected "spurious handshake" Nothing
|
||||||
|
|
||||||
runRecvState :: Context -> RecvState IO -> IO ()
|
runRecvState :: Context -> RecvState IO -> IO ()
|
||||||
runRecvState _ (RecvStateDone) = return ()
|
runRecvState _ (RecvStateDone) = return ()
|
||||||
runRecvState ctx (RecvStateNext f) = recvPacket ctx >>= either throwCore f >>= runRecvState ctx
|
runRecvState ctx (RecvStateNext f) = recvPacket ctx >>= either throwCore f >>= runRecvState ctx
|
||||||
runRecvState ctx iniState = recvPacketHandshake ctx >>= loop iniState >>= runRecvState ctx
|
runRecvState ctx iniState = recvPacketHandshake ctx >>= onRecvStateHandshake ctx iniState >>= runRecvState ctx
|
||||||
where
|
|
||||||
loop :: RecvState IO -> [Handshake] -> IO (RecvState IO)
|
|
||||||
loop recvState [] = return recvState
|
|
||||||
loop (RecvStateHandshake f) (x:xs) = do
|
|
||||||
nstate <- f x
|
|
||||||
processHandshake ctx x
|
|
||||||
loop nstate xs
|
|
||||||
loop _ _ = unexpected "spurious handshake" Nothing
|
|
||||||
|
|
||||||
getSessionData :: Context -> IO (Maybe SessionData)
|
getSessionData :: Context -> IO (Maybe SessionData)
|
||||||
getSessionData ctx = do
|
getSessionData ctx = do
|
||||||
|
|
|
@ -288,6 +288,8 @@ recvClientData sparams ctx = runRecvState ctx (RecvStateHandshake processClientC
|
||||||
|
|
||||||
processClientCertificate p = processClientKeyExchange p
|
processClientCertificate p = processClientKeyExchange p
|
||||||
|
|
||||||
|
-- cannot use RecvStateHandshake, as the next message could be a ChangeCipher,
|
||||||
|
-- so we must process any packet, and in case of handshake call processHandshake manually.
|
||||||
processClientKeyExchange (ClientKeyXchg _) = return $ RecvStateNext processCertificateVerify
|
processClientKeyExchange (ClientKeyXchg _) = return $ RecvStateNext processCertificateVerify
|
||||||
processClientKeyExchange p = unexpected (show p) (Just "client key exchange")
|
processClientKeyExchange p = unexpected (show p) (Just "client key exchange")
|
||||||
|
|
||||||
|
|
Loading…
Reference in a new issue