diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,7 +1,27 @@ # Change log for "tls" -## Version 2.3.1 +## Version 2.4.3 +* A server checks clientAuth of ExtendedKeyUsage in a client + certificate on client authentication. + +## Version 2.4.2 + +* The `Network.TLS.Extra.CipherCBC` module is added. + [#526](https://github.com/haskell-tls/hs-tls/pull/526) + +## Version 2.4.1 + +* Ensure same `supported_groups` before/after HRR. +* New `clientWantTicket` parameter makes it possible to opt-out of soliciting + session tickets from servers. + +## Version 2.4.0 + +* Identical to v2.3.1 but major version up as v2.3.1 breaks "quic". + +## Version 2.3.1 (deprecated) + * Using ScrubbedBytes for secrets. * Key echange with ML-KEM. [#517](https://github.com/haskell-tls/hs-tls/pull/517) @@ -81,14 +101,14 @@ This feature is automatically used if the peer supports it. * More tests with `tlsfuzzer` especially for client authentication and 0-RTT. -* Implementing a utility funcation, `validateClientCertificate`, for +* Implementing a utility function, `validateClientCertificate`, for client authentication. * Bug fix for echo back logic of Cookie extension. * More pretty show for the internal `Handshake` structure for debugging. ## Version 2.1.6 -* Testing with "tlsfuzzer" again. Now don't send an alert agaist to +* Testing with "tlsfuzzer" again. Now don't send an alert against to peer's alert. Double locking (aka self dead-lock) is fixed. Sending an alert for known-but-cannot-parse extensions. Other corner cases are also fixed. @@ -352,7 +372,7 @@ API CHANGES: - `SessionManager` implementations need to provide a `sessionResumeOnlyOnce` - function to accomodate resumption scenarios with 0-RTT data. The function is + function to accommodate resumption scenarios with 0-RTT data. The function is called only on the server side. - Data type `SessionData` is extended with four new fields for TLS version 1.3. `SessionManager` implementations that serializes/deserializes `SessionData` diff --git a/Network/TLS.hs b/Network/TLS.hs --- a/Network/TLS.hs +++ b/Network/TLS.hs @@ -11,7 +11,7 @@ -- protocol, and support RSA and Ephemeral (Elliptic curve and -- regular) Diffie Hellman key exchanges, and many extensions. -- --- The tipical usage is: +-- The typical usage is: -- -- > socket <- ... -- > ctx <- contextNew socket @@ -46,6 +46,7 @@ clientUseServerNameIndication, clientWantSessionResume, clientWantSessionResumeList, + clientWantTicket, clientShared, clientHooks, clientSupported, diff --git a/Network/TLS/Compression.hs b/Network/TLS/Compression.hs --- a/Network/TLS/Compression.hs +++ b/Network/TLS/Compression.hs @@ -51,7 +51,7 @@ (==) c1 c2 = compressionID c1 == compressionID c2 -- | intersect a list of ids commonly given by the other side with a list of compression --- the function keeps the list of compression in order, to be able to find quickly the prefered +-- the function keeps the list of compression in order, to be able to find quickly the preferred -- compression. compressionIntersectID :: [Compression] -> [Word8] -> [Compression] compressionIntersectID l ids = filter (\c -> compressionID c `elem` ids) l diff --git a/Network/TLS/Context/Internal.hs b/Network/TLS/Context/Internal.hs --- a/Network/TLS/Context/Internal.hs +++ b/Network/TLS/Context/Internal.hs @@ -211,7 +211,7 @@ , tls13stClientExtensions :: [ExtensionRaw] -- client , tls13stChoice :: ~CipherChoice -- client , tls13stHsKey :: Maybe (SecretTriple HandshakeSecret) -- client - -- Actuall session id for TLS 1.2, random value for TLS 1.3 + -- Actual session id for TLS 1.2, random value for TLS 1.3 , tls13stSession :: Session , tls13stSentExtensions :: [ExtensionID] } diff --git a/Network/TLS/Core.hs b/Network/TLS/Core.hs --- a/Network/TLS/Core.hs +++ b/Network/TLS/Core.hs @@ -188,7 +188,7 @@ -- All chunks are protected with the same write lock because we don't -- want to interleave writes from other threads in the middle of our -- possibly large write. - mlen <- getPeerRecordLimit ctx -- plaintext, dont' adjust for TLS 1.3 + mlen <- getPeerRecordLimit ctx -- plaintext, don't adjust for TLS 1.3 mapM_ (mapChunks_ mlen sendP) (L.toChunks dataToSend) -- | Get data out of Data packet, and automatically renegotiate if a Handshake diff --git a/Network/TLS/Extension.hs b/Network/TLS/Extension.hs --- a/Network/TLS/Extension.hs +++ b/Network/TLS/Extension.hs @@ -443,7 +443,7 @@ ------------------------------------------------------------ -- | Server Name extension including the name type and the associated name. --- the associated name decoding is dependant of its name type. +-- the associated name decoding is dependent of its name type. -- name type = 0 : hostname newtype ServerName = ServerName [ServerNameType] deriving (Show, Eq) diff --git a/Network/TLS/Extra/CipherCBC.hs b/Network/TLS/Extra/CipherCBC.hs new file mode 100644 --- /dev/null +++ b/Network/TLS/Extra/CipherCBC.hs @@ -0,0 +1,201 @@ +module Network.TLS.Extra.CipherCBC ( + -- * TLS 1.2 CBC ciphers with PFS and SHA2 + ciphersuite_pfs_sha2_cbc, + ciphersuite_ecdhe_sha2_cbc, + ciphersuite_dhe_rsa_sha2_cbc, + + -- ** Individual CBC ciphers + cipher_DHE_RSA_AES128_SHA256, + cipher_DHE_RSA_AES256_SHA256, + cipher_ECDHE_RSA_AES128CBC_SHA256, + cipher_ECDHE_RSA_AES256CBC_SHA384, + cipher_ECDHE_ECDSA_AES128CBC_SHA256, +) where + +import Crypto.Cipher.AES +import Crypto.Cipher.Types hiding (Cipher, cipherName) +import Crypto.Error +-- import Crypto.System.CPU +import qualified Data.ByteString as B + +import Network.TLS.Cipher +import Network.TLS.Imports +import Network.TLS.Types hiding (IV) + +---------------------------------------------------------------- + +-- | TLS 1.2 AES CBC ciphers with DHE or ECDHE key exchange, ECDSA or RSA +-- authentication and a SHA256 or SHA2384 MAC. +-- For legacy applications only, deprecated in HTTPS. +ciphersuite_pfs_sha2_cbc :: [Cipher] +ciphersuite_pfs_sha2_cbc = + [ cipher_ECDHE_ECDSA_AES128CBC_SHA256 + , cipher_ECDHE_ECDSA_AES256CBC_SHA384 + , cipher_ECDHE_RSA_AES128CBC_SHA256 + , cipher_ECDHE_RSA_AES256CBC_SHA384 + , cipher_DHE_RSA_AES128_SHA256 + , cipher_DHE_RSA_AES256_SHA256 + ] + +-- | TLS 1.2 AES CBC ciphers with ECDHE key exchange, ECDSA or RSA +-- authentication and a SHA256 or SHA2384 MAC. +-- For legacy applications only, deprecated in HTTPS. +ciphersuite_ecdhe_sha2_cbc :: [Cipher] +ciphersuite_ecdhe_sha2_cbc = + [ cipher_ECDHE_ECDSA_AES128CBC_SHA256 + , cipher_ECDHE_ECDSA_AES256CBC_SHA384 + , cipher_ECDHE_RSA_AES128CBC_SHA256 + , cipher_ECDHE_RSA_AES256CBC_SHA384 + ] + +-- | TLS 1.2 AES CBC ciphers with DHE key exchange, RSA authentication and a +-- SHA256 MAC. +-- For legacy applications only, deprecated in HTTPS. +ciphersuite_dhe_rsa_sha2_cbc :: [Cipher] +ciphersuite_dhe_rsa_sha2_cbc = + [ cipher_DHE_RSA_AES256_SHA256 + , cipher_DHE_RSA_AES128_SHA256 + ] + +---------------------------------------------------------------- + +-- | TLS 1.2 AES128 CBC, with DHE key exchange, RSA authentication and a SHA256 MAC. +-- For legacy applications only, deprecated in HTTPS. +cipher_DHE_RSA_AES128_SHA256 :: Cipher +cipher_DHE_RSA_AES128_SHA256 = + Cipher + { cipherID = 0x0067 + , cipherName = "DHE-RSA-AES128-SHA256" + , cipherBulk = bulk_aes128 + , cipherHash = SHA256 + , cipherPRFHash = Just SHA256 + , cipherKeyExchange = CipherKeyExchange_DHE_RSA + , cipherMinVer = Just TLS12 -- RFC 5288 Sec 4 + } + +-- | TLS 1.2 AES256 CBC, with DHE key exchange, RSA authentication and a SHA256 MAC. +-- For legacy applications only, deprecated in HTTPS. +cipher_DHE_RSA_AES256_SHA256 :: Cipher +cipher_DHE_RSA_AES256_SHA256 = + cipher_DHE_RSA_AES128_SHA256 + { cipherID = 0x006B + , cipherName = "DHE-RSA-AES256-SHA256" + , cipherBulk = bulk_aes256 + } + +-- | TLS 1.2 AES128 CBC, with ECDHE key exchange, RSA authentication and a SHA256 MAC. +-- For legacy applications only, deprecated in HTTPS. +cipher_ECDHE_RSA_AES128CBC_SHA256 :: Cipher +cipher_ECDHE_RSA_AES128CBC_SHA256 = + Cipher + { cipherID = 0xC027 + , cipherName = "ECDHE-RSA-AES128CBC-SHA256" + , cipherBulk = bulk_aes128 + , cipherHash = SHA256 + , cipherPRFHash = Just SHA256 + , cipherKeyExchange = CipherKeyExchange_ECDHE_RSA + , cipherMinVer = Just TLS12 -- RFC 5288 Sec 4 + } + +-- | TLS 1.2 AES256 CBC, with ECDHE key exchange, RSA authentication and a SHA384 MAC. +-- For legacy applications only, deprecated in HTTPS. +cipher_ECDHE_RSA_AES256CBC_SHA384 :: Cipher +cipher_ECDHE_RSA_AES256CBC_SHA384 = + Cipher + { cipherID = 0xC028 + , cipherName = "ECDHE-RSA-AES256CBC-SHA384" + , cipherBulk = bulk_aes256 + , cipherHash = SHA384 + , cipherPRFHash = Just SHA384 + , cipherKeyExchange = CipherKeyExchange_ECDHE_RSA + , cipherMinVer = Just TLS12 -- RFC 5288 Sec 4 + } + +-- | TLS 1.2 AES128 CBC, with ECDHE key exchange, ECDSA authentication and a SHA256 MAC. +-- For legacy applications only, deprecated in HTTPS. +cipher_ECDHE_ECDSA_AES128CBC_SHA256 :: Cipher +cipher_ECDHE_ECDSA_AES128CBC_SHA256 = + Cipher + { cipherID = 0xc023 + , cipherName = "ECDHE-ECDSA-AES128CBC-SHA256" + , cipherBulk = bulk_aes128 + , cipherHash = SHA256 + , cipherPRFHash = Just SHA256 + , cipherKeyExchange = CipherKeyExchange_ECDHE_ECDSA + , cipherMinVer = Just TLS12 -- RFC 5289 + } + +-- | TLS 1.2 AES256 CBC, with ECDHE key exchange, ECDSA authentication and a SHA384 MAC. +-- For legacy applications only, deprecated in HTTPS. +cipher_ECDHE_ECDSA_AES256CBC_SHA384 :: Cipher +cipher_ECDHE_ECDSA_AES256CBC_SHA384 = + Cipher + { cipherID = 0xC024 + , cipherName = "ECDHE-ECDSA-AES256CBC-SHA384" + , cipherBulk = bulk_aes256 + , cipherHash = SHA384 + , cipherPRFHash = Just SHA384 + , cipherKeyExchange = CipherKeyExchange_ECDHE_ECDSA + , cipherMinVer = Just TLS12 -- RFC 5289 + } + +---------------------------------------------------------------- + +aes128cbc :: BulkDirection -> BulkKey -> BulkBlock +aes128cbc BulkEncrypt key = + let ctx = noFail (cipherInit key) :: AES128 + in ( \iv input -> + let output = cbcEncrypt ctx (makeIV_ iv) input in (output, takelast 16 output) + ) +aes128cbc BulkDecrypt key = + let ctx = noFail (cipherInit key) :: AES128 + in ( \iv input -> + let output = cbcDecrypt ctx (makeIV_ iv) input in (output, takelast 16 input) + ) + +aes256cbc :: BulkDirection -> BulkKey -> BulkBlock +aes256cbc BulkEncrypt key = + let ctx = noFail (cipherInit key) :: AES256 + in ( \iv input -> + let output = cbcEncrypt ctx (makeIV_ iv) input in (output, takelast 16 output) + ) +aes256cbc BulkDecrypt key = + let ctx = noFail (cipherInit key) :: AES256 + in ( \iv input -> + let output = cbcDecrypt ctx (makeIV_ iv) input in (output, takelast 16 input) + ) + +makeIV_ :: BlockCipher a => B.ByteString -> IV a +makeIV_ = fromMaybe (error "makeIV_") . makeIV + +takelast :: Int -> B.ByteString -> B.ByteString +takelast i b = B.drop (B.length b - i) b + +noFail :: CryptoFailable a -> a +noFail = throwCryptoError + +---------------------------------------------------------------- + +bulk_aes128 :: Bulk +bulk_aes128 = + Bulk + { bulkName = "AES128" + , bulkKeySize = 16 + , bulkIVSize = 16 + , bulkExplicitIV = 0 + , bulkAuthTagLen = 0 + , bulkBlockSize = 16 + , bulkF = BulkBlockF aes128cbc + } + +bulk_aes256 :: Bulk +bulk_aes256 = + Bulk + { bulkName = "AES256" + , bulkKeySize = 32 + , bulkIVSize = 16 + , bulkExplicitIV = 0 + , bulkAuthTagLen = 0 + , bulkBlockSize = 16 + , bulkF = BulkBlockF aes256cbc + } diff --git a/Network/TLS/Handshake/Certificate.hs b/Network/TLS/Handshake/Certificate.hs --- a/Network/TLS/Handshake/Certificate.hs +++ b/Network/TLS/Handshake/Certificate.hs @@ -3,13 +3,20 @@ badCertificate, rejectOnException, verifyLeafKeyUsage, + verifyLeafKeyUsagePurpose, extractCAname, ) where import Control.Exception (SomeException) import Control.Monad (unless) import Control.Monad.State.Strict -import Data.X509 (ExtKeyUsage (..), ExtKeyUsageFlag, extensionGet) +import Data.X509 ( + ExtExtendedKeyUsage (..), + ExtKeyUsage (..), + ExtKeyUsageFlag, + ExtKeyUsagePurpose (..), + extensionGet, + ) import Network.TLS.Context.Internal import Network.TLS.Struct @@ -46,6 +53,19 @@ case extensionGet (certExtensions cert) of Nothing -> True -- unrestricted cert Just (ExtKeyUsage flags) -> any (`elem` validFlags) flags + +verifyLeafKeyUsagePurpose + :: MonadIO m => ExtKeyUsagePurpose -> CertificateChain -> m () +verifyLeafKeyUsagePurpose _ (CertificateChain []) = return () +verifyLeafKeyUsagePurpose validPurpose (CertificateChain (signed : _)) = + unless verified $ + badCertificate $ + "certificate is not allowed for " ++ show validPurpose + where + cert = getCertificate signed + verified = case extensionGet (certExtensions cert) of + Nothing -> True + Just (ExtExtendedKeyUsage purposes) -> validPurpose `elem` purposes extractCAname :: SignedCertificate -> DistinguishedName extractCAname cert = certSubjectDN $ getCertificate cert diff --git a/Network/TLS/Handshake/Client.hs b/Network/TLS/Handshake/Client.hs --- a/Network/TLS/Handshake/Client.hs +++ b/Network/TLS/Handshake/Client.hs @@ -102,7 +102,7 @@ case ver of TLS13 | hrr -> - helloRetry cparams ctx mparams ver crand (grpsSupported \\ grpsSelected) + helloRetry cparams ctx mparams ver crand grpsSupported grpsSelected | otherwise -> do recvServerSecondFlight13 cparams ctx grpsSelected sendClientSecondFlight13 cparams ctx @@ -126,8 +126,9 @@ -> Version -> ClientRandom -> [Group] + -> [Group] -> IO () -helloRetry cparams ctx mparams ver crand groupsSupported = do +helloRetry cparams ctx mparams ver crand groupsSupported groupsSelected = do when (null groupsSupported) $ throwCore $ Error_Protocol "no supported groups on the client side" IllegalParameter @@ -137,18 +138,22 @@ mks <- usingState_ ctx getTLS13KeyShare case mks of Just (KeyShareHRR selectedGroup) - | selectedGroup `elem` groupsSupported -> do + -- RFC 8446 Sec 4.1.4: the selected_group MUST be in supported_groups + -- and MUST NOT already have been offered in the initial key_share. + | selectedGroup `elem` groupsSupported + && selectedGroup `notElem` groupsSelected -> do usingHState ctx $ setTLS13HandshakeMode HelloRetryRequest clearTxRecordState ctx let cparams' = cparams{clientUseEarlyData = False} runPacketFlight ctx $ sendChangeCipherSpec13 ctx clientSession <- tls13stSession <$> getTLS13State ctx - let groupsSupported' = selectedGroup : filter (/= selectedGroup) groupsSupported - groupsSelected' = [selectedGroup] - grps = + -- RFC 8446 Sec 4.1.2: the second ClientHello MUST be identical + -- to the first except for the specific listed changes. + -- supported_groups is NOT on that list, so it must be unchanged. + let grps = Groups - { grpsSupported = groupsSupported' - , grpsSelected = groupsSelected' + { grpsSupported = groupsSupported + , grpsSelected = [selectedGroup] } handshake @@ -156,6 +161,11 @@ ctx grps (Just (crand, clientSession, ver)) + | selectedGroup `elem` groupsSelected -> + throwCore $ + Error_Protocol + "server selected a group already offered in key_share" + IllegalParameter | otherwise -> throwCore $ Error_Protocol "server-selected group is not supported" IllegalParameter diff --git a/Network/TLS/Handshake/Client/ClientHello.hs b/Network/TLS/Handshake/Client/ClientHello.hs --- a/Network/TLS/Handshake/Client/ClientHello.hs +++ b/Network/TLS/Handshake/Client/ClientHello.hs @@ -262,11 +262,12 @@ Nothing -> return Nothing Just siz -> return $ Just $ toExtensionRaw $ RecordSizeLimit $ fromIntegral siz - sessionTicketExt = do + sessionTicketExt = case clientSessions cparams of (sidOrTkt, _) : _ | isTicket sidOrTkt -> return $ Just $ toExtensionRaw $ SessionTicket sidOrTkt - _ -> return $ Just $ toExtensionRaw $ SessionTicket "" + _ | clientWantTicket cparams -> return $ Just $ toExtensionRaw $ SessionTicket "" + | otherwise -> return $ Nothing earlyDataExt | rtt0 = return $ Just $ toExtensionRaw (EarlyDataIndication Nothing) diff --git a/Network/TLS/Handshake/Server.hs b/Network/TLS/Handshake/Server.hs --- a/Network/TLS/Handshake/Server.hs +++ b/Network/TLS/Handshake/Server.hs @@ -45,9 +45,9 @@ -- | Put the server context in handshake mode. -- -- Expect a client hello message as parameter. --- This is useful when the client hello has been already poped from the recv layer to inspect the packet. +-- This is useful when the client hello has been already popped from the recv layer to inspect the packet. -- --- When the function returns, a new handshake has been succesfully negociated. +-- When the function returns, a new handshake has been successfully negotiated. -- On any error, a HandshakeFailed exception is raised. handshake :: ServerParams -> Context -> HandshakeR -> IO () handshake sparams ctx chb@(ClientHello ch, bs) = do @@ -66,7 +66,7 @@ SelectKeyShareHRR g -> do sendHRR ctx g r0 chI $ isJust mcrnd -- Don't reset ctxEstablished since 0-RTT data - -- would be comming, which should be ignored. + -- would be coming, which should be ignored. handshakeServer sparams ctx SelectKeyShareFound cliKeyShare -> do unless (checkClientKeyShareKeyLength cliKeyShare) $ diff --git a/Network/TLS/Handshake/Server/ClientHello12.hs b/Network/TLS/Handshake/Server/ClientHello12.hs --- a/Network/TLS/Handshake/Server/ClientHello12.hs +++ b/Network/TLS/Handshake/Server/ClientHello12.hs @@ -101,7 +101,7 @@ -- Cipher selection is performed in two steps: first server credentials -- are flagged as not suitable for signature if not compatible with - -- negotiated signature parameters. Then ciphers are evalutated from + -- negotiated signature parameters. Then ciphers are evaluated from -- the resulting credentials. supported = serverSupported sparams diff --git a/Network/TLS/Handshake/Server/Common.hs b/Network/TLS/Handshake/Server/Common.hs --- a/Network/TLS/Handshake/Server/Common.hs +++ b/Network/TLS/Handshake/Server/Common.hs @@ -15,7 +15,7 @@ ) where import Control.Monad.State.Strict -import Data.X509 (ExtKeyUsageFlag (..)) +import Data.X509 (ExtKeyUsageFlag (..), ExtKeyUsagePurpose (..)) import Network.TLS.Context.Internal import Network.TLS.Credentials @@ -151,7 +151,9 @@ (onClientCertificate (serverHooks sparams) certs) rejectOnException case usage of - CertificateUsageAccept -> verifyLeafKeyUsage [KeyUsage_digitalSignature] certs + CertificateUsageAccept -> do + verifyLeafKeyUsage [KeyUsage_digitalSignature] certs + verifyLeafKeyUsagePurpose KeyUsagePurpose_ClientAuth certs CertificateUsageReject reason -> certificateRejected reason -- Remember cert chain for later use. diff --git a/Network/TLS/Handshake/Server/ServerHello12.hs b/Network/TLS/Handshake/Server/ServerHello12.hs --- a/Network/TLS/Handshake/Server/ServerHello12.hs +++ b/Network/TLS/Handshake/Server/ServerHello12.hs @@ -93,7 +93,7 @@ | TLS12 < sessionVersion sd = return Nothing -- fixme | CipherId (sessionCipher sd) `notElem` ciphers = throwCore $ - Error_Protocol "new cipher is diffrent from the old one" IllegalParameter + Error_Protocol "new cipher is different from the old one" IllegalParameter | isJust sni && sessionClientSNI sd /= sni = do usingState_ ctx clearClientSNI return Nothing diff --git a/Network/TLS/Handshake/Server/TLS13.hs b/Network/TLS/Handshake/Server/TLS13.hs --- a/Network/TLS/Handshake/Server/TLS13.hs +++ b/Network/TLS/Handshake/Server/TLS13.hs @@ -369,7 +369,7 @@ TwoWay deriving (Eq, Show) --- | Updating appication traffic secrets for TLS 1.3. +-- | Updating application traffic secrets for TLS 1.3. -- If this API is called for TLS 1.3, 'True' is returned. -- Otherwise, 'False' is returned. updateKey :: MonadIO m => Context -> KeyUpdateRequest -> m Bool diff --git a/Network/TLS/Parameters.hs b/Network/TLS/Parameters.hs --- a/Network/TLS/Parameters.hs +++ b/Network/TLS/Parameters.hs @@ -65,7 +65,7 @@ -- -- Default: 'Nothing' , debugPrintSeed :: Seed -> IO () - -- ^ Add a way to print the seed that was randomly generated. re-using the same seed + -- ^ Add a way to print the seed that was randomly generated. reusing the same seed -- will reproduce the same randomness with 'debugSeed' -- -- Default: no printing @@ -153,6 +153,16 @@ -- specified for TLS 1.2 but only the first entry is used. -- -- Default: '[]' + , clientWantTicket :: Bool + -- ^ Whether to solicit TLS 1.2 session tickets (or TLS 1.3 + -- resumption PSKs) from servers. With a 'False' setting, + -- stateless clients that never do resumption can avoid + -- wasting server and client resources used to generate, + -- transmit and process tickets that will never be used. + -- + -- Default: 'True' + -- + -- @since 2.4.1 , clientShared :: Shared -- ^ See the default value of 'Shared'. , clientHooks :: ClientHooks @@ -192,6 +202,7 @@ , clientUseServerNameIndication = True , clientWantSessionResume = Nothing , clientWantSessionResumeList = [] + , clientWantTicket = True , clientShared = def , clientHooks = def , clientSupported = def @@ -401,8 +412,9 @@ -- -- Default: @[X25519,P256,P384,X448,P521,FFDHE3072,FFDHE4096,FFDHE6144,FFDHE8192,X25519MLKEM768,P256MLKEM768,P384MLKEM1024,MLKEM768,MLKEM1024]@ , supportedGroupsTLS13 :: [[Group]] - -- ^ @[Group]@ contains @Group@s of the same level in preferred order. - -- @[Group]@ is also listed in preferred order. + -- ^ The inside @[Group]@ is the list of @Group@ at the same level + -- in preferred order. The inside @[Group]@s are also listed in + -- preferred order. -- -- TLS 1.3 server: this is used as the 1st argument to -- 'onSelectKeyShare'. @@ -657,7 +669,7 @@ -- (3) rejecting unless 1 < dh_p && pub < dh_p - 1 -- (4) rejecting if dh_size < 1024 (to prevent Logjam attack) -- - -- See RFC 7919 section 3.1 for recommandations. + -- See RFC 7919 section 3.1 for recommendations. , onServerFinished :: Information -> IO () -- ^ When a handshake is done, this hook can check `Information`. , onSelectKeyShareGroups :: [Group] -> [Group] @@ -722,7 +734,7 @@ -- of the certificate. This verification is performed by the -- library internally. -- - -- Default: returns the followings: + -- Default: returns the following: -- -- @ -- CertificateUsageReject (CertificateRejectOther "no client certificates expected") @@ -738,7 +750,7 @@ -- client version and the client list of ciphers. -- -- This could be useful with old clients and as a workaround to - -- the BEAST (where RC4 is sometimes prefered with TLS < 1.1) + -- the BEAST (where RC4 is sometimes preferred with TLS < 1.1) -- -- The client cipher list cannot be empty. -- diff --git a/Network/TLS/QUIC.hs b/Network/TLS/QUIC.hs --- a/Network/TLS/QUIC.hs +++ b/Network/TLS/QUIC.hs @@ -116,7 +116,7 @@ { quicSend :: [(CryptLevel, ByteString)] -> IO () -- ^ Called by TLS so that QUIC sends one or more handshake fragments. The -- content transiting on this API is the plaintext of the fragments and - -- QUIC responsability is to encrypt this payload with the key material + -- QUIC responsibility is to encrypt this payload with the key material -- given for the specified level and an appropriate encryption scheme. -- -- The size of the fragments may exceed QUIC datagram limits so QUIC may @@ -194,7 +194,7 @@ let qexts = filterQTP exts when (null qexts) $ do throwCore $ - Error_Protocol "QUIC transport parameters are mssing" MissingExtension + Error_Protocol "QUIC transport parameters are missing" MissingExtension quicNotifyExtensions callbacks ctx qexts quicInstallKeys callbacks ctx (InstallApplicationKeys appSecInfo) @@ -222,7 +222,7 @@ let qexts = filterQTP exts when (null qexts) $ do throwCore $ - Error_Protocol "QUIC transport parameters are mssing" MissingExtension + Error_Protocol "QUIC transport parameters are missing" MissingExtension quicNotifyExtensions callbacks ctx qexts quicInstallKeys callbacks ctx (InstallEarlyKeys mEarlySecInfo) quicInstallKeys callbacks ctx (InstallHandshakeKeys handSecInfo) diff --git a/test/HandshakeSpec.hs b/test/HandshakeSpec.hs --- a/test/HandshakeSpec.hs +++ b/test/HandshakeSpec.hs @@ -11,6 +11,7 @@ import Data.X509 (ExtKeyUsageFlag (..)) import Network.TLS import Network.TLS.Extra.Cipher +import Network.TLS.Extra.CipherCBC import Network.TLS.Internal import Test.Hspec import Test.Hspec.QuickCheck @@ -47,6 +48,7 @@ prop "can resume with extended main secret" handshake_resumption_ems prop "can handle ALPN" handshake_alpn prop "can handle SNI" handshake_sni + prop "can handshake with TLS 1.2 CBC" handshake_cbc prop "can re-negotiate with TLS 1.2" handshake12_renegotiation prop "can resume session with TLS 1.2" handshake12_session_resumption prop "can resume session ticket with TLS 1.2" handshake12_session_ticket @@ -102,6 +104,48 @@ -------------------------------------------------------------- +handshake_cbc :: IO () +handshake_cbc = do + clientCiphers <- generate $ cipherGen >>= shuffle + serverCiphers <- generate $ cipherGen >>= shuffle + clientGroups <- generate $ groupGen >>= shuffle + serverGroups <- generate $ groupGen >>= shuffle + (clientParam, serverParam) <- generate $ + arbitraryPairParamsWithVersionsAndCiphers + ([TLS12], [TLS12]) + (clientCiphers, serverCiphers) + let clientParam' = clientParam { + clientSupported = (clientSupported clientParam) + { supportedGroups = clientGroups } } + serverParam' = serverParam { + serverSupported = (serverSupported serverParam) + { supportedGroups = serverGroups } } + let ciphers = clientCiphers `intersect` serverCiphers + groups = clientGroups `intersect` serverGroups + in if compat ciphers groups + then runTLSSimple (clientParam', serverParam') + else runTLSFailure (clientParam', serverParam') handshake handshake + where + groupGen :: Gen [Group] + groupGen = sublistOf grps `suchThat` (not . null) + where + grps = [X25519, P256, P384, FFDHE2048, FFDHE3072, FFDHE4096] + + cipherGen :: Gen [Cipher] + cipherGen = sublistOf ciphersuite_pfs_sha2_cbc `suchThat` (not . null) + + compat :: [Cipher] -> [Group] -> Bool + compat [] _ = False + compat _ [] = False + compat ciphers groups = + let mustdh = all (== CipherKeyExchange_DHE_RSA) $ map cipherKeyExchange ciphers + mustec = all (/= CipherKeyExchange_DHE_RSA) $ map cipherKeyExchange ciphers + havedh = any (`elem` [FFDHE2048, FFDHE3072, FFDHE4096]) groups + haveec = any (`elem` [X25519, P256, P384]) groups + in ((not mustdh || havedh) && (not mustec || haveec)) + +-------------------------------------------------------------- + handshake13_downgrade :: (ClientParams, ServerParams) -> IO () handshake13_downgrade (cparam, sparam) = do versionForced <- @@ -958,7 +1002,7 @@ , srv{serverSupported = svrSupported} ) (_, serverMessages) <- runTLSCapture13 params - -- The server should tell X25519 in supported_groups in EE to clinet + -- The server should tell X25519 in supported_groups in EE to client let isSupportedGroups (ExtensionRaw eid _) = eid == EID_SupportedGroups eeMessagesHaveExt = [ any isSupportedGroups exts diff --git a/tls.cabal b/tls.cabal --- a/tls.cabal +++ b/tls.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: tls -version: 2.3.1 +version: 2.4.3 license: BSD3 license-file: LICENSE copyright: Vincent Hanquez @@ -34,6 +34,7 @@ Network.TLS.Internal Network.TLS.Extra Network.TLS.Extra.Cipher + Network.TLS.Extra.CipherCBC Network.TLS.Extra.FFDHE Network.TLS.QUIC @@ -137,7 +138,7 @@ random >=1.2 && <1.4, serialise >=0.2 && <0.3, transformers >=0.5 && <0.7, - unix-time >=0.4.11 && <0.5, + unix-time >=0.4.11 && <0.6, zlib >=0.7 && <0.8 executable tls-server diff --git a/util/Common.hs b/util/Common.hs --- a/util/Common.hs +++ b/util/Common.hs @@ -111,7 +111,7 @@ minfo <- contextGetInformation ctx case minfo of Nothing -> do - putStrLn "Erro: information cannot be obtained" + putStrLn "Error: information cannot be obtained" exitFailure Just info -> return info