tls 2.4.1 → 2.4.2

raw patch · 16 files changed

+271/−25 lines, 16 filesdep ~unix-time

Dependency ranges changed: unix-time

Files

• CHANGELOG.md +4/−4
• Network/TLS.hs +1/−1
• Network/TLS/Compression.hs +1/−1
• Network/TLS/Context/Internal.hs +1/−1
• Network/TLS/Core.hs +1/−1
• Network/TLS/Extension.hs +1/−1
• Network/TLS/Extra/CipherCBC.hs +201/−0
• Network/TLS/Handshake/Server.hs +3/−3
• Network/TLS/Handshake/Server/ClientHello12.hs +1/−1
• Network/TLS/Handshake/Server/ServerHello12.hs +1/−1
• Network/TLS/Handshake/Server/TLS13.hs +1/−1
• Network/TLS/Parameters.hs +4/−4
• Network/TLS/QUIC.hs +3/−3
• test/HandshakeSpec.hs +45/−1
• tls.cabal +2/−1
• util/Common.hs +1/−1

@@ -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`

@@ -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 <params>

@@ -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

@@ -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]     }

@@ -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

@@ -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) 

@@ -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+        }

@@ -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) $

@@ -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

@@ -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

@@ -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

@@ -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.     --

@@ -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)

@@ -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

@@ -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 <vincent@snarc.org>@@ -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 

@@ -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