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.

core/Network/TLS/Handshake/Client.hs

@@ -103,7 +103,19 @@ handshakeClient cparams ctx = do
                 -- client didn't offer. do nothing.
                 (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).
 --

core/Network/TLS/Handshake/Common.hs

@@ -12,6 +12,7 @@ module Network.TLS.Handshake.Common
     , RecvState(..)
     , runRecvState
     , recvPacketHandshake
+    , onRecvStateHandshake
     ) where
 
 import Control.Concurrent.MVar
@@ -98,18 +99,19 @@ recvPacketHandshake ctx = do
         Right x             -> fail ("unexpected type received. expecting handshake and got: " ++ show x)
         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 _   (RecvStateDone)   = return ()
 runRecvState ctx (RecvStateNext f) = recvPacket ctx >>= either throwCore f >>= runRecvState ctx
-runRecvState ctx iniState          = recvPacketHandshake ctx >>= loop 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
+runRecvState ctx iniState          = recvPacketHandshake ctx >>= onRecvStateHandshake ctx iniState >>= runRecvState ctx
 
 getSessionData :: Context -> IO (Maybe SessionData)
 getSessionData ctx = do

core/Network/TLS/Handshake/Server.hs

@@ -288,6 +288,8 @@ recvClientData sparams ctx = runRecvState ctx (RecvStateHandshake processClientC
 
         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 p                 = unexpected (show p) (Just "client key exchange")