tls 1.2.4 → 1.2.5

raw patch · 4 files changed

+48/−19 lines, 4 files

Files

• Network/TLS/Handshake/Client.hs +16/−8
• Network/TLS/Packet.hs +30/−10
• Network/TLS/Struct.hs +1/−0
• tls.cabal +1/−1

@@ -314,16 +314,24 @@ 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-    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-        (c,_)           -> throwCore $ Error_Protocol ("unknown server key exchange received, expecting: " ++ show c, True, HandshakeFailure)+    processWithCipher cipher origSkx     return $ RecvStateHandshake (processCertificateRequest ctx)-  where doDHESignature dhparams signature signatureType = do+  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)+        doDHESignature dhparams signature signatureType = do             -- TODO verify DHParams             expectedData <- generateSignedDHParams ctx dhparams             verified <- signatureVerify ctx signatureType expectedData signature

@@ -42,6 +42,8 @@     , encodePreMasterSecret     , encodeSignedDHParams +    , decodeReallyServerKeyXchgAlgorithmData+     -- * generate things for packet content     , generateMasterSecret     , generateKeyBlock@@ -295,26 +297,31 @@ 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)+                dhparams  <- getServerDHParams+                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 @@         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 ()@@ -487,6 +495,18 @@  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 @@     | 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) 

@@ -1,5 +1,5 @@ Name:                tls-Version:             1.2.4+Version:             1.2.5 Description:    Native Haskell TLS and SSL protocol implementation for server and client.    .