tls 2.4.11 → 2.4.12
raw patch · 12 files changed
+369/−46 lines, 12 files
Files
- CHANGELOG.md +15/−0
- Network/TLS/Core.hs +10/−4
- Network/TLS/Handshake/Client/TLS12.hs +9/−2
- Network/TLS/Handshake/Client/TLS13.hs +45/−9
- Network/TLS/Handshake/Server/ServerHello13.hs +1/−1
- Network/TLS/Handshake/Server/TLS12.hs +6/−1
- Network/TLS/Handshake/Signature.hs +28/−16
- Network/TLS/Handshake/State13.hs +4/−0
- Network/TLS/IO/Decode.hs +7/−11
- Network/TLS/Record/Decrypt.hs +7/−1
- test/HandshakeSpec.hs +236/−0
- tls.cabal +1/−1
CHANGELOG.md view
@@ -1,5 +1,20 @@ # Change log for "tls" +## Version 2.4.12++* Authenticate a server that rejects the PSK of 0-RTT.+ [#590](https://github.com/haskell-tls/hs-tls/pull/590)+* Require the client Certificate a TLS 1.2 server asked for.+ [#591](https://github.com/haskell-tls/hs-tls/pull/591)+* Refuse a TLS 1.3 alert in clear after the handshake.+ [#592](https://github.com/haskell-tls/hs-tls/pull/592)+* Require Certificate and ServerKeyExchange from a TLS 1.2 server.+ [#593](https://github.com/haskell-tls/hs-tls/pull/593)+* Refuse a TLS 1.2 ChangeCipherSpec before its keys exist.+ [#594](https://github.com/haskell-tls/hs-tls/pull/594)+* Answer an unfit ServerKeyExchange algorithm with an alert.+ [#595](https://github.com/haskell-tls/hs-tls/pull/595)+ ## Version 2.4.11 * Keep preferring AES-GCM on AArch64 with crypton 2.2, which names the
Network/TLS/Core.hs view
@@ -422,10 +422,16 @@ else do let reason = "received key update before established" terminate13 ctx (Error_Misc reason) AlertLevel_Fatal UnexpectedMessage reason- -- Client only- loopHandshake13 (hb@(CertRequest13{}, _) : hbs) =- postHandshakeAuthWith ctx hb >> loopHandshake13 hbs- loopHandshake13 (hb@(h, _) : hbs) = do+ -- Client only. Before Established, it belongs to the handshake that+ -- 0-RTT left to the pending actions.+ loopHandshake13 (hb@(CertRequest13{}, _) : hbs) = do+ established <- ctxEstablished ctx+ if established == Established+ then postHandshakeAuthWith ctx hb >> loopHandshake13 hbs+ else loopPending hb hbs+ loopHandshake13 (hb : hbs) = loopPending hb hbs++ loopPending hb@(h, _) hbs = do rtt0 <- tls13st0RTT <$> getTLS13State ctx when rtt0 $ case h of ServerHello13 SH{..} ->
Network/TLS/Handshake/Client/TLS12.hs view
@@ -49,13 +49,20 @@ doCertificate cparams ctx certs processCertificate ctx ClientRole certs return $ RecvStateHandshake (expectServerKeyExchange ctx)-expectCertificate _ ctx p = expectServerKeyExchange ctx p+-- Every key exchange the client implements authenticates the server with a+-- certificate; see sendClientKeyXchg.+expectCertificate _ _ p = unexpected (show p) (Just "server certificate") expectServerKeyExchange :: Context -> Handshake -> IO (RecvState IO) expectServerKeyExchange ctx (ServerKeyXchg origSkx) = do doServerKeyExchange ctx origSkx return $ RecvStateHandshake (expectCertificateRequest ctx)-expectServerKeyExchange ctx p = expectCertificateRequest ctx p+expectServerKeyExchange ctx p = do+ -- (EC)DHE takes its parameters from ServerKeyExchange.+ kx <- cipherKeyExchange <$> usingHState ctx getPendingCipher+ unless (kx == CipherKeyExchange_RSA) $+ unexpected (show p) (Just "server key exchange")+ expectCertificateRequest ctx p expectCertificateRequest :: Context -> Handshake -> IO (RecvState IO) expectCertificateRequest ctx (CertRequest cTypesSent sigAlgs dNames) = do
Network/TLS/Handshake/Client/TLS13.hs view
@@ -147,12 +147,16 @@ when (st13 == RTT0Sent) $ case extensionLookup EID_EarlyData eexts of Just _ -> do+ -- RFC 8446 Section 4.2.10: early data is accepted only+ -- with the first PSK.+ mode <- usingHState ctx getTLS13HandshakeMode+ unless (mode == PreSharedKey) $+ throwCore $+ Error_Protocol "early data accepted without PSK" IllegalParameter usingHState ctx $ setTLS13HandshakeMode RTT0 usingHState ctx $ setTLS13RTT0Status RTT0Accepted liftIO $ modifyTLS13State ctx $ \st -> st{tls13st0RTTAccepted = True}- Nothing -> do- usingHState ctx $ setTLS13HandshakeMode PreSharedKey- usingHState ctx $ setTLS13RTT0Status RTT0Rejected+ Nothing -> usingHState ctx $ setTLS13RTT0Status RTT0Rejected expectEncryptedExtensions _ h = unexpected (show h) (Just "encrypted extensions") ----------------------------------------------------------------@@ -228,13 +232,19 @@ :: MonadIO m => ClientParams -> Context -> CertificateChain -> RecvHandshake13M m () processCertAndVerify cparams ctx cc = do+ pubkey <- processServerCertificate cparams ctx cc+ recvHandshake13hash ctx "CertVerify" $ expectCertVerify ctx pubkey++processServerCertificate+ :: MonadIO m => ClientParams -> Context -> CertificateChain -> m PubKey+processServerCertificate cparams ctx cc = do liftIO $ usingState_ ctx $ setServerCertificateChain cc liftIO $ doCertificate cparams ctx cc let pubkey = certPubKey $ getCertificate $ getCertificateChainLeaf cc ver <- liftIO $ usingState_ ctx getVersion checkDigitalSignatureKey ver pubkey usingHState ctx $ setPublicKey pubkey- recvHandshake13hash ctx "CertVerify" $ expectCertVerify ctx pubkey+ return pubkey ---------------------------------------------------------------- @@ -416,16 +426,42 @@ asyncServerHello13 cparams ctx groupSent chSentTime = do setPendingRecvActions ctx- [ PendingRecvActionSelfUpdate True expectServerHello- , PendingRecvAction True (expectEncryptedExtensions ctx)- , PendingRecvActionHash True expectFinishedAndSet- ]+ [PendingRecvActionSelfUpdate True expectServerHello] where expectServerHello shb@(sh, _) = do setRTT ctx chSentTime processServerHello13 cparams ctx sh updateTranscriptHash13 ctx shb -- update by myself- void $ prepareSecondFlight13 ctx groupSent+ resuming <- prepareSecondFlight13 ctx groupSent+ -- Without the PSK, the server authenticates with its certificate,+ -- as in recvServerSecondFlight13.+ setPendingRecvActions ctx $+ if resuming+ then+ [ PendingRecvAction True (expectEncryptedExtensions ctx)+ , PendingRecvActionHash True expectFinishedAndSet+ ]+ else+ [ PendingRecvAction False (expectEncryptedExtensions ctx)+ , PendingRecvAction False expectCertRequestAsync+ , PendingRecvActionHash True expectFinishedAndSet+ ]+ -- The actions below put the next one in front of Finished.+ expectCertRequestAsync (CertRequest13 token exts) = do+ processCertRequest13 ctx token exts+ pushPendingRecvAction ctx $ PendingRecvAction False expectCertAsync+ expectCertRequestAsync h = do+ usingHState ctx $ do+ setCertReqToken Nothing+ setCertReqCBdata Nothing+ expectCertAsync h+ expectCertAsync (Certificate13 _ (CertificateChain_ cc) _) = certAsync cc+ expectCertAsync (CompressedCertificate13 _ (CertificateChain_ cc) _) = certAsync cc+ expectCertAsync h = unexpected (show h) (Just "server certificate")+ certAsync cc = do+ pubkey <- processServerCertificate cparams ctx cc+ pushPendingRecvAction ctx $+ PendingRecvActionHash False (expectCertVerify ctx pubkey) expectFinishedAndSet h sf = do expectFinished cparams ctx h sf liftIO $
Network/TLS/Handshake/Server/ServerHello13.hs view
@@ -94,7 +94,7 @@ usingHState ctx $ setTLS13HandshakeMode RTT0 usingHState ctx $ setTLS13RTT0Status RTT0Accepted else do- usingHState ctx $ setTLS13HandshakeMode PreSharedKey+ when authenticated $ usingHState ctx $ setTLS13HandshakeMode PreSharedKey usingHState ctx $ setTLS13RTT0Status RTT0Rejected else when authenticated $ usingHState ctx $ setTLS13HandshakeMode PreSharedKey -- else : FullHandshake or HelloRetryRequest
Network/TLS/Handshake/Server/TLS12.hs view
@@ -104,7 +104,12 @@ -- which the hook may have accepted. let followedCertVerify = not $ isNullCertificateChain certs return $ RecvStateHandshake $ expectClientKeyExchange followedCertVerify- expectClientCertificate p = expectClientKeyExchange False p+ -- RFC 5246 Section 7.4.6: a client asked for a certificate sends the+ -- message, empty if it has none.+ expectClientCertificate p = do+ certReqSent <- usingHState ctx getCertReqSent+ when certReqSent $ unexpected (show p) (Just "client certificate")+ expectClientKeyExchange False 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.
Network/TLS/Handshake/Signature.hs view
@@ -106,6 +106,17 @@ keyTypeFits (PubKeyEd448 _) (_, s) = s == SignatureEd448 keyTypeFits _ _ = False +checkKeyTypeFits :: PubKey -> HashAndSignatureAlgorithm -> IO ()+checkKeyTypeFits pubKey hs =+ unless (pubKey `keyTypeFits` hs) $+ throwCore $+ Error_Protocol+ ( "signature algorithm "+ ++ showSignatureScheme hs+ ++ " is for another type of key"+ )+ IllegalParameter+ -- Same as 'signatureCompatible' but for TLS13: for ECDSA this also checks the -- relation between hash in the HashAndSignatureAlgorithm and elliptic curve signatureCompatible13 :: PubKey -> HashAndSignatureAlgorithm -> Bool@@ -178,11 +189,7 @@ ("signature algorithm " ++ showSignatureScheme hashSigAlg ++ " is not for " ++ show usedVersion) IllegalParameter checkSupportedHashSignature ctx hashSigAlg- unless (pubKey `keyTypeFits` hashSigAlg) $- throwCore $- Error_Protocol- ("signature algorithm " ++ showSignatureScheme hashSigAlg ++ " is for another type of key")- IllegalParameter+ checkKeyTypeFits pubKey hashSigAlg if pubKey `signatureCompatible` hashSigAlg then doVerify else return False@@ -278,19 +285,24 @@ DigitallySigned malg <$> signPrivate ctx role sigParam toSign signatureVerify :: Context -> DigitallySigned -> PubKey -> ByteString -> IO Bool+-- Checked as checkCertificateVerify does: the peer chose the algorithm, so+-- one that does not fit the key is its error, not ours. signatureVerify ctx digSig@(DigitallySigned hashSigAlg _) pubKey toVerifyData = do usedVersion <- usingState_ ctx getVersion- let (sigParam, toVerify) =- case (usedVersion, hashSigAlg) of- (TLS12, hs)- | pubKey `signatureCompatible` hs ->- (signatureParams pubKey hashSigAlg, toVerifyData)- | otherwise ->- error "expecting different signature algorithm"- _ ->- error- "not expecting hash and signature algorithm in a < TLS12 digitially signed structure"- signatureVerifyWithCertVerifyData ctx digSig (sigParam, toVerify)+ unless (usedVersion == TLS12) $+ throwCore $+ Error_Protocol+ ("no signature algorithm in a " ++ show usedVersion ++ " digitally-signed")+ InternalError+ checkSupportedHashSignature ctx hashSigAlg+ checkKeyTypeFits pubKey hashSigAlg+ if pubKey `signatureCompatible` hashSigAlg+ then+ signatureVerifyWithCertVerifyData+ ctx+ digSig+ (signatureParams pubKey hashSigAlg, toVerifyData)+ else return False signatureVerifyWithCertVerifyData :: Context
Network/TLS/Handshake/State13.hs view
@@ -17,6 +17,7 @@ clearRxRecordState, PendingRecvAction (..), setPendingRecvActions,+ pushPendingRecvAction, popPendingRecvAction, ) where @@ -140,6 +141,9 @@ setPendingRecvActions :: Context -> [PendingRecvAction] -> IO () setPendingRecvActions ctx = writeIORef (ctxPendingRecvActions ctx)++pushPendingRecvAction :: Context -> PendingRecvAction -> IO ()+pushPendingRecvAction ctx a = modifyIORef' (ctxPendingRecvActions ctx) (a :) popPendingRecvAction :: Context -> IO (Maybe PendingRecvAction) popPendingRecvAction ctx = do
Network/TLS/IO/Decode.hs view
@@ -35,17 +35,18 @@ -- ChangeCipherSpec comes between complete handshake messages -- (RFC 5246 Section 7.1), so not before the first ClientHello -- of a server, which has no handshake state yet, nor in the- -- middle of a fragmented handshake message (CVE-2004-0079).+ -- middle of a fragmented handshake message (CVE-2004-0079),+ -- nor before the keys it switches to are computed. mhs <- getHState ctx (mCont, _) <- usingState_ ctx $ gets stHandshakeRecordCont12- if isNothing mhs || isJust mCont- then+ case mhs >>= hstPendingRxState of+ Just rx | isNothing mCont -> do+ modifyMVar_ (ctxRxRecordState ctx) (\_ -> return rx)+ return $ Right ChangeCipherSpec+ _ -> return $ Left $ Error_Packet_unexpected "ChangeCipherSpec" " expected: handshake"- else do- switchRxEncryption ctx- return $ Right ChangeCipherSpec decodePacket12 ctx (Record ProtocolType_Handshake ver fragment) = do mhs <- getHState ctx let keyxchg = mhs >>= hstPendingCipher >>= Just . cipherKeyExchange@@ -92,11 +93,6 @@ bs' = BS.take len bs return ((h, reverse (bs' : wirebytes)) : hbs) decodePacket12 _ (Record ty _ _) = return $ Left $ unknownProtocolType ty--switchRxEncryption :: Context -> IO ()-switchRxEncryption ctx =- usingHState ctx (gets hstPendingRxState) >>= \rx ->- modifyMVar_ (ctxRxRecordState ctx) (\_ -> return $ fromJust rx) ----------------------------------------------------------------
Network/TLS/Record/Decrypt.hs view
@@ -42,7 +42,13 @@ Left message -> throwError $ Error_Protocol message UnexpectedMessage Right (ct', d) -> return $ Record ct' ver $ fragmentPlaintext d ProtocolType_ChangeCipherSpec -> noDecryption- ProtocolType_Alert -> noDecryption+ -- A peer that fails before it has keys answers in clear, but after+ -- the handshake an alert in clear can only be forged (RFC 8446+ -- Section 5).+ ProtocolType_Alert+ | stCryptLevel st == CryptApplicationSecret ->+ throwError $ Error_Protocol "alert in clear" UnexpectedMessage+ | otherwise -> noDecryption _ -> throwError $ Error_Protocol "illegal plain text" UnexpectedMessage
test/HandshakeSpec.hs view
@@ -120,11 +120,25 @@ handshake12_client_cert_verify_sigalg (HashIntrinsic, SignatureRSApsspssSHA256) rejectedAsDecryptError+ it "rejects a TLS 1.2 ServerKeyExchange algorithm for another key type" $+ handshake12_server_key_xchg_sigalg+ (HashSHA256, SignatureECDSA)+ rejectedAsIllegalParameter+ it "rejects a TLS 1.2 ServerKeyExchange that does not fit the RSA key" $+ handshake12_server_key_xchg_sigalg+ (HashIntrinsic, SignatureRSApsspssSHA256)+ rejectedAsDecryptError prop "can receive client authentication failure" handshake_client_auth_fail it "accepts an empty TLS 1.2 client certificate when the hook does" $ handshake_client_auth_empty TLS12 it "accepts an empty TLS 1.3 client certificate when the hook does" $ handshake_client_auth_empty TLS13+ it "rejects a TLS 1.2 client omitting the requested certificate" $+ handshake12_client_cert_omitted+ it "rejects a TLS 1.2 server omitting Certificate" $+ handshake12_server_message_omitted 11+ it "rejects a TLS 1.2 server omitting ServerKeyExchange for ECDHE" $+ handshake12_server_message_omitted 12 it "requests only defined certificate types in TLS 1.2" $ handshake12_cert_request_types prop "can handle extended main secret" handshake_ems@@ -173,6 +187,10 @@ it "rejects TLS 1.3 early data when ALPN changes" $ handshake13_0rtt_alpn prop "can handshake with TLS 1.3 0RTT -> PSK" handshake13_0rtt_fallback+ it "authenticates a server rejecting the PSK of 0RTT" $+ handshake13_0rtt_psk_rejected False+ it "authenticates a server rejecting the PSK of 0RTT, asking a cert" $+ handshake13_0rtt_psk_rejected True prop "can handshake with TLS 1.3 EE" handshake13_ee_groups prop "can handshake with TLS 1.3 EC groups" handshake13_ec prop "can handshake with TLS 1.3 FFDHE groups" handshake13_ffdhe@@ -210,6 +228,10 @@ short_record_bad_record_mac TLS12 cipher_ECDHE_RSA_AES128CBC_SHA256 it "rejects a too short TLS 1.3 record with bad_record_mac" $ short_record_bad_record_mac TLS13 cipher13_AES_128_GCM_SHA256+ it "rejects a TLS 1.3 alert in clear after the handshake" $+ plaintext_alert13_rejected+ it "rejects a TLS 1.2 ChangeCipherSpec before the keys" $+ early_ccs12_rejected it "rejects a ServerHello as the first client message" $ server_first_message_unexpected 2 it "rejects a Finished as the first client message" $@@ -884,6 +906,90 @@ | isNullCertificateChain chain = return CertificateUsageAccept | otherwise = return (CertificateUsageReject CertificateRejectUnknownCA) +-- RFC 5246 Section 7.4.6: a client asked for a certificate sends the+-- message even when it has none. Here it is cut out on the wire; the+-- Finished no longer matches, but the server must stop before that.+handshake12_client_cert_omitted :: IO ()+handshake12_client_cert_omitted = do+ let cipher = cipher_ECDHE_RSA_WITH_AES_128_GCM_SHA256+ (clientParam, serverParam) <-+ generate $+ arbitraryPairParamsWithVersionsAndCiphers+ ([TLS12], [TLS12])+ ([cipher], [cipher])+ let clientParam' =+ clientParam+ { clientHooks =+ (clientHooks clientParam)+ { onCertificateRequest = \_ -> return Nothing+ }+ }+ serverParam' =+ serverParam+ { serverWantClientCert = True+ , serverHooks =+ (serverHooks serverParam)+ { onClientCertificate = \_ -> return CertificateUsageAccept+ }+ }+ ccsSent <- newIORef False+ let params = (clientParam', serverParam')+ withPairContextWith (dropHandshake12 11 ccsSent, id) params $+ \(cctx, sctx) ->+ concurrently_+ (handshake sctx `shouldThrow` rejectedAsUnexpected)+ (void (E.try (handshake cctx) :: IO (Either E.SomeException ())))++-- A TLS 1.2 client needs the server's Certificate for every key exchange+-- it implements, and ServerKeyExchange for (EC)DHE. One of them is cut+-- out on the wire, and the client must say so rather than fail later.+handshake12_server_message_omitted :: Word8 -> IO ()+handshake12_server_message_omitted typ = do+ let cipher = cipher_ECDHE_RSA_WITH_AES_128_GCM_SHA256+ (clientParam, serverParam) <-+ generate $+ arbitraryPairParamsWithVersionsAndCiphers+ ([TLS12], [TLS12])+ ([cipher], [cipher])+ ccsSent <- newIORef False+ withPairContextWith (id, dropHandshake12 typ ccsSent) (clientParam, serverParam) $+ \(cctx, sctx) ->+ concurrently_+ (void (E.try (handshake sctx) :: IO (Either E.SomeException ())))+ (handshake cctx `shouldThrow` rejectedAsUnexpected)++-- | Cut the handshake messages of a type out of what a TLS 1.2 peer sends+-- in clear, that is, before its ChangeCipherSpec.+dropHandshake12 :: Word8 -> IORef Bool -> Backend -> Backend+dropHandshake12 typ ccsSent be =+ be+ { backendSend = \bs -> do+ done <- readIORef ccsSent+ when (B.take 1 bs == B.singleton 20) $ writeIORef ccsSent True+ backendSend be $ if done then bs else stripRecords bs+ }+ where+ stripRecords bs+ | B.length bs < 5 = bs+ | otherwise =+ let len = fromIntegral (B.index bs 3) * 256 + fromIntegral (B.index bs 4)+ (body, rest) = B.splitAt len $ B.drop 5 bs+ body'+ | B.head bs == 22 = stripMessages body+ | otherwise = body+ len' = B.length body'+ hdr = B.take 3 bs <> B.pack [fromIntegral (len' `div` 256), fromIntegral len']+ in (if B.null body' then "" else hdr <> body') <> stripRecords rest+ stripMessages m+ | B.length m < 4 = m+ | otherwise =+ let len =+ fromIntegral (B.index m 1) * 65536+ + fromIntegral (B.index m 2) * 256+ + fromIntegral (B.index m 3)+ (msg, rest) = B.splitAt (4 + len) m+ in (if B.head m == typ then "" else msg) <> stripMessages rest+ -- In TLS 1.2 a client certificate with an Ed25519 or Ed448 key is asked -- for with ecdsa_sign (RFC 8422 Section 3.1). The Ed25519 and Ed448 -- certificate types of this library are synthetic and have no code point,@@ -980,6 +1086,37 @@ (void (E.try (handshake cctx) :: IO (Either TLSException ()))) r `shouldSatisfy` isJust +-- The same for the signature of ServerKeyExchange, which the client used to+-- answer with an ErrorCall and internal_error.+handshake12_server_key_xchg_sigalg+ :: HashAndSignatureAlgorithm -> Selector TLSException -> IO ()+handshake12_server_key_xchg_sigalg alg rejected = do+ let cipher = cipher_ECDHE_RSA_WITH_AES_128_GCM_SHA256+ (clientParam, serverParam) <-+ generate $+ arbitraryPairParamsWithVersionsAndCiphers+ ([TLS12], [TLS12])+ ([cipher], [cipher])+ let (HashAlgorithm h, SignatureAlgorithm sa) = alg+ unfit (ServerKeyXchg (SKX_ECDHE_RSA params (DigitallySigned _ sig))) =+ pure $ ServerKeyXchg (SKX_ECDHE_RSA params (DigitallySigned alg sig))+ -- Arriving with ServerHello, it is decoded before the cipher is+ -- known: curve type and group, the point, then the algorithm.+ unfit (ServerKeyXchg (SKX_Unparsed bs)) =+ let off = 4 + fromIntegral (B.index bs 3)+ in pure $+ ServerKeyXchg $+ SKX_Unparsed $+ B.take off bs <> B.pack [h, sa] <> B.drop (off + 2) bs+ unfit hs = pure hs+ r <- timeout 10000000 $+ withPairContextWith (id, id) (clientParam, serverParam) $ \(cctx, sctx) -> do+ contextHookSetHandshakeRecv cctx unfit+ concurrently_+ (void (E.try (handshake sctx) :: IO (Either TLSException ())))+ (handshake cctx `shouldThrow` rejected)+ r `shouldSatisfy` isJust+ -- A DER ECDSA signature that does not decode is a signature that does not -- verify, a decrypt_error. The client's TLS 1.3 CertificateVerify -- signature is replaced on its way to the server with one that the ASN.1@@ -2156,6 +2293,40 @@ _ <- recvData ctx bye ctx +-- The server has forgotten the session, so it answers 0-RTT with a full+-- handshake, and the client must check its certificate.+handshake13_0rtt_psk_rejected :: Bool -> IO ()+handshake13_0rtt_psk_rejected wantCert = do+ (cli, srv) <- generate arbitraryPairParams13+ let supported =+ defaultSupported+ { supportedCiphers = [cipher13_AES_128_GCM_SHA256]+ , supportedGroups = [X25519]+ , supportedGroupsTLS13 = [[X25519]]+ }+ params0 =+ ( cli{clientSupported = supported}+ , srv{serverSupported = supported, serverEarlyDataSize = 2048}+ )+ sessionRefs <- twoSessionRefs+ let params = setPairParamsSessionManagers (twoSessionManagers sessionRefs) params0+ runTLSSimple13 params FullHandshake++ sessionParams <- readClientSessionRef sessionRefs+ expectJust "session param should be Just" sessionParams+ writeIORef (snd sessionRefs) Nothing+ earlyData <- B.pack <$> generate (someWords8 256)+ let (pc, ps) = setPairParamsSessionResuming (fromJust sessionParams) params+ ps' =+ ps+ { serverWantClientCert = wantCert+ , serverHooks =+ (serverHooks ps)+ { onClientCertificate = \_ -> return CertificateUsageAccept+ }+ }+ runTLS0RTT (pc{clientUseEarlyData = True}, ps') FullHandshake earlyData+ handshake13_ee_groups :: CSP13 -> IO () handshake13_ee_groups (CSP13 (cli, srv)) = do let -- The client prefers P256@@ -2381,6 +2552,71 @@ sendData cctx "hello" void (E.try (recvData cctx) :: IO (Either E.SomeException B.ByteString)) )++-- RFC 8446 Section 5: once keys are in use, only ChangeCipherSpec may come+-- in clear. An injected close_notify must not read as an orderly close.+plaintext_alert13_rejected :: IO ()+plaintext_alert13_rejected = do+ (clientParam, serverParam) <-+ generate $+ arbitraryPairParamsWithVersionsAndCiphers+ ([TLS13], [TLS13])+ ([cipher13_AES_128_GCM_SHA256], [cipher13_AES_128_GCM_SHA256])+ armed <- newIORef False+ let injectAlert be =+ be+ { backendSend = \bs -> do+ inject <- readIORef armed+ if inject && B.take 1 bs == B.singleton 23+ then do+ writeIORef armed False+ backendSend be $ B.pack [21, 3, 3, 0, 2, 1, 0]+ else backendSend be bs+ }+ withPairContextWith (injectAlert, id) (clientParam, serverParam) $+ \(cctx, sctx) ->+ concurrently_+ ( do+ handshake sctx+ recvData sctx `shouldThrow` rejectedPlaintextAlert+ )+ ( do+ handshake cctx+ writeIORef armed True+ sendData cctx "hello"+ void (E.try (recvData cctx) :: IO (Either E.SomeException B.ByteString))+ )++rejectedPlaintextAlert :: TLSException -> Bool+rejectedPlaintextAlert (Terminated _ _ (Error_Protocol _ UnexpectedMessage)) = True+rejectedPlaintextAlert _ = False++-- A ChangeCipherSpec ahead of the client's second flight, before the server+-- has the keys to switch to. The handshake would refuse it anyway; this+-- keeps the record layer from switching to keys that do not exist.+early_ccs12_rejected :: IO ()+early_ccs12_rejected = do+ let cipher = cipher_ECDHE_RSA_WITH_AES_128_GCM_SHA256+ (clientParam, serverParam) <-+ generate $+ arbitraryPairParamsWithVersionsAndCiphers+ ([TLS12], [TLS12])+ ([cipher], [cipher])+ sent <- newIORef (0 :: Int)+ let injectCCS be =+ be+ { backendSend = \bs -> do+ n <- readIORef sent+ writeIORef sent (n + 1)+ -- The first send is ClientHello.+ when (n == 1) $ backendSend be $ B.pack [20, 3, 3, 0, 1, 1]+ backendSend be bs+ }+ withPairContextWith (injectCCS, id) (clientParam, serverParam) $+ \(cctx, sctx) ->+ concurrently_+ (handshake sctx `shouldThrow` rejectedAsUnexpected)+ (void (E.try (handshake cctx) :: IO (Either E.SomeException ()))) serverRejectedShortRecord :: TLSException -> Bool serverRejectedShortRecord (Terminated _ _ (Error_Protocol _ BadRecordMac)) = True
tls.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.0 name: tls-version: 2.4.11+version: 2.4.12 license: BSD3 license-file: LICENSE copyright: Vincent Hanquez <vincent@snarc.org>