diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -8,7 +8,7 @@ ## Version 2.4.0 -* Idential to v2.3.1 but major version up as v2.3.1 breaks "quic". +* Identical to v2.3.1 but major version up as v2.3.1 breaks "quic". ## Version 2.3.1 (deprecated) @@ -91,14 +91,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. @@ -362,7 +362,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 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/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/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 @@ -669,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] @@ -734,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") @@ -750,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.4.1 +version: 2.4.2 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 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