diff --git a/core/Network/TLS.hs b/core/Network/TLS.hs index 44d235f75..88ef8f68f 100644 --- a/core/Network/TLS.hs +++ b/core/Network/TLS.hs @@ -15,6 +15,7 @@ module Network.TLS , ServerParams(..) , DebugParams(..) , DHParams + , DHPublic , ClientHooks(..) , ServerHooks(..) , Supported(..) @@ -23,6 +24,7 @@ module Network.TLS , Handshake , Logging(..) , Measurement(..) + , GroupUsage(..) , CertificateUsage(..) , CertificateRejectReason(..) , defaultParamsClient @@ -137,7 +139,7 @@ import Network.TLS.Struct ( TLSError(..), TLSException(..) , AlertDescription(..) , ClientRandom(..), ServerRandom(..) , Handshake) -import Network.TLS.Crypto (KxError(..), DHParams, Group(..)) +import Network.TLS.Crypto (KxError(..), DHParams, DHPublic, Group(..)) import Network.TLS.Cipher import Network.TLS.Hooks import Network.TLS.Measurement diff --git a/core/Network/TLS/Crypto.hs b/core/Network/TLS/Crypto.hs index 29da88b57..d2dd599e3 100644 --- a/core/Network/TLS/Crypto.hs +++ b/core/Network/TLS/Crypto.hs @@ -26,6 +26,7 @@ module Network.TLS.Crypto , PrivateKey , SignatureParams(..) , findDigitalSignatureAlg + , findFiniteFieldGroup , kxEncrypt , kxDecrypt , kxSign @@ -38,6 +39,7 @@ import qualified Crypto.Hash as H import qualified Data.ByteString as B import qualified Data.ByteArray as B (convert) import Crypto.Random +import qualified Crypto.PubKey.DH as DH import qualified Crypto.PubKey.DSA as DSA import qualified Crypto.PubKey.ECC.ECDSA as ECDSA import qualified Crypto.PubKey.ECC.Prim as ECC @@ -75,6 +77,15 @@ findDigitalSignatureAlg keyPair = --(PubKeyECDSA _, PrivKeyECDSA _) -> Just ECDSA _ -> Nothing +findFiniteFieldGroup :: DH.Params -> Maybe Group +findFiniteFieldGroup params = lookup (pg params) table + where + pg (DH.Params p g _) = (p, g) + + table = [ (pg prms, grp) | grp <- availableFFGroups + , let Just prms = dhParamsForGroup grp + ] + -- functions to use the hidden class. hashInit :: Hash -> HashContext hashInit MD5 = HashContext $ ContextSimple (H.hashInit :: H.Context H.MD5) diff --git a/core/Network/TLS/Crypto/DH.hs b/core/Network/TLS/Crypto/DH.hs index a9469d4d3..55a5f8e05 100644 --- a/core/Network/TLS/Crypto/DH.hs +++ b/core/Network/TLS/Crypto/DH.hs @@ -4,6 +4,7 @@ module Network.TLS.Crypto.DH DHParams , DHPublic , DHPrivate + , DHKey -- * DH methods , dhPublic @@ -13,6 +14,7 @@ module Network.TLS.Crypto.DH , dhParamsGetG , dhGenerateKeyPair , dhGetShared + , dhValid , dhUnwrap , dhUnwrapPublic ) where @@ -39,7 +41,7 @@ dhParams p g = DH.Params p g (numBits p) dhGenerateKeyPair :: MonadRandom r => DHParams -> r (DHPrivate, DHPublic) dhGenerateKeyPair params = do priv <- DH.generatePrivate params - let pub = DH.generatePublic params priv + let pub = DH.calculatePublic params priv return (priv, pub) dhGetShared :: DHParams -> DHPrivate -> DHPublic -> DHKey @@ -50,6 +52,12 @@ dhGetShared params priv pub = -- for DH(E) premaster secret in SSL/TLS before version 1.3. stripLeadingZeros (DH.SharedKey sb) = DH.SharedKey (snd $ B.span (== 0) sb) +-- Check that group element in not in the 2-element subgroup { 1, p - 1 }. +-- See RFC 7919 section 3 and NIST SP 56A rev 2 section 5.6.2.3.1. +-- This verification is enough when using a safe prime. +dhValid :: DHParams -> Integer -> Bool +dhValid (DH.Params p _ _) y = 1 < y && y < p - 1 + dhUnwrap :: DHParams -> DHPublic -> [Integer] dhUnwrap (DH.Params p g _) (DH.PublicNumber y) = [p,g,y] diff --git a/core/Network/TLS/Crypto/IES.hs b/core/Network/TLS/Crypto/IES.hs index d17daa99d..96451c625 100644 --- a/core/Network/TLS/Crypto/IES.hs +++ b/core/Network/TLS/Crypto/IES.hs @@ -16,13 +16,19 @@ module Network.TLS.Crypto.IES , groupGetShared , encodeGroupPublic , decodeGroupPublic + -- * Compatibility with 'Network.TLS.Crypto.DH' + , dhParamsForGroup + , dhGroupGenerateKeyPair + , dhGroupGetPubShared ) where import Control.Arrow import Crypto.ECC import Crypto.Error -import Crypto.PubKey.DH +import Crypto.Number.Generate +import Crypto.PubKey.DH hiding (generateParams) import Crypto.PubKey.ECIES +import qualified Data.ByteArray as B import Data.Proxy import Network.TLS.Crypto.Types import Network.TLS.Extra.FFDHE @@ -71,6 +77,14 @@ x25519 = Proxy x448 :: Proxy Curve_X448 x448 = Proxy +dhParamsForGroup :: Group -> Maybe Params +dhParamsForGroup FFDHE2048 = Just ffdhe2048 +dhParamsForGroup FFDHE3072 = Just ffdhe3072 +dhParamsForGroup FFDHE4096 = Just ffdhe4096 +dhParamsForGroup FFDHE6144 = Just ffdhe6144 +dhParamsForGroup FFDHE8192 = Just ffdhe8192 +dhParamsForGroup _ = Nothing + groupGenerateKeyPair :: MonadRandom r => Group -> r (GroupPrivate, GroupPublic) groupGenerateKeyPair P256 = (GroupPri_P256,GroupPub_P256) `fs` curveGenerateKeyPair p256 @@ -82,11 +96,22 @@ groupGenerateKeyPair X25519 = (GroupPri_X255,GroupPub_X255) `fs` curveGenerateKeyPair x25519 groupGenerateKeyPair X448 = (GroupPri_X448,GroupPub_X448) `fs` curveGenerateKeyPair x448 -groupGenerateKeyPair FFDHE2048 = gen ffdhe2048 GroupPri_FFDHE2048 GroupPub_FFDHE2048 -groupGenerateKeyPair FFDHE3072 = gen ffdhe3072 GroupPri_FFDHE3072 GroupPub_FFDHE3072 -groupGenerateKeyPair FFDHE4096 = gen ffdhe4096 GroupPri_FFDHE4096 GroupPub_FFDHE4096 -groupGenerateKeyPair FFDHE6144 = gen ffdhe6144 GroupPri_FFDHE6144 GroupPub_FFDHE6144 -groupGenerateKeyPair FFDHE8192 = gen ffdhe8192 GroupPri_FFDHE8192 GroupPub_FFDHE8192 +groupGenerateKeyPair FFDHE2048 = gen ffdhe2048 exp2048 GroupPri_FFDHE2048 GroupPub_FFDHE2048 +groupGenerateKeyPair FFDHE3072 = gen ffdhe3072 exp3072 GroupPri_FFDHE3072 GroupPub_FFDHE3072 +groupGenerateKeyPair FFDHE4096 = gen ffdhe4096 exp4096 GroupPri_FFDHE4096 GroupPub_FFDHE4096 +groupGenerateKeyPair FFDHE6144 = gen ffdhe6144 exp6144 GroupPri_FFDHE6144 GroupPub_FFDHE6144 +groupGenerateKeyPair FFDHE8192 = gen ffdhe8192 exp8192 GroupPri_FFDHE8192 GroupPub_FFDHE8192 + +dhGroupGenerateKeyPair :: MonadRandom r => Group -> r (Params, PrivateNumber, PublicNumber) +dhGroupGenerateKeyPair FFDHE2048 = addParams ffdhe2048 (gen' ffdhe2048 exp2048) +dhGroupGenerateKeyPair FFDHE3072 = addParams ffdhe3072 (gen' ffdhe3072 exp3072) +dhGroupGenerateKeyPair FFDHE4096 = addParams ffdhe4096 (gen' ffdhe4096 exp4096) +dhGroupGenerateKeyPair FFDHE6144 = addParams ffdhe6144 (gen' ffdhe6144 exp6144) +dhGroupGenerateKeyPair FFDHE8192 = addParams ffdhe8192 (gen' ffdhe8192 exp8192) +dhGroupGenerateKeyPair grp = error ("invalid FFDHE group: " ++ show grp) + +addParams :: Functor f => Params -> f (a, b) -> f (Params, a, b) +addParams params = fmap $ \(a, b) -> (params, a, b) fs :: MonadRandom r => (Scalar a -> GroupPrivate, Point a -> GroupPublic) @@ -100,13 +125,17 @@ fs :: MonadRandom r gen :: MonadRandom r => Params + -> Int -> (PrivateNumber -> GroupPrivate) -> (PublicNumber -> GroupPublic) -> r (GroupPrivate, GroupPublic) -gen params priTag pubTag = do - pri <- generatePrivate params - let pub = calculatePublic params pri - return (priTag pri, pubTag pub) +gen params expBits priTag pubTag = (priTag *** pubTag) <$> gen' params expBits + +gen' :: MonadRandom r + => Params + -> Int + -> r (PrivateNumber, PublicNumber) +gen' params expBits = (id &&& calculatePublic params) <$> generatePriv expBits groupGetPubShared :: MonadRandom r => GroupPublic -> r (Maybe (GroupPublic, GroupKey)) groupGetPubShared (GroupPub_P256 pub) = @@ -119,38 +148,62 @@ groupGetPubShared (GroupPub_X255 pub) = fmap (first GroupPub_X255) . maybeCryptoError <$> deriveEncrypt x25519 pub groupGetPubShared (GroupPub_X448 pub) = fmap (first GroupPub_X448) . maybeCryptoError <$> deriveEncrypt x448 pub -groupGetPubShared (GroupPub_FFDHE2048 pub) = getPubShared ffdhe2048 pub GroupPub_FFDHE2048 -groupGetPubShared (GroupPub_FFDHE3072 pub) = getPubShared ffdhe3072 pub GroupPub_FFDHE3072 -groupGetPubShared (GroupPub_FFDHE4096 pub) = getPubShared ffdhe4096 pub GroupPub_FFDHE4096 -groupGetPubShared (GroupPub_FFDHE6144 pub) = getPubShared ffdhe6144 pub GroupPub_FFDHE6144 -groupGetPubShared (GroupPub_FFDHE8192 pub) = getPubShared ffdhe8192 pub GroupPub_FFDHE8192 +groupGetPubShared (GroupPub_FFDHE2048 pub) = getPubShared ffdhe2048 exp2048 pub GroupPub_FFDHE2048 +groupGetPubShared (GroupPub_FFDHE3072 pub) = getPubShared ffdhe3072 exp3072 pub GroupPub_FFDHE3072 +groupGetPubShared (GroupPub_FFDHE4096 pub) = getPubShared ffdhe4096 exp4096 pub GroupPub_FFDHE4096 +groupGetPubShared (GroupPub_FFDHE6144 pub) = getPubShared ffdhe6144 exp6144 pub GroupPub_FFDHE6144 +groupGetPubShared (GroupPub_FFDHE8192 pub) = getPubShared ffdhe8192 exp8192 pub GroupPub_FFDHE8192 + +dhGroupGetPubShared :: MonadRandom r => Group -> PublicNumber -> r (Maybe (PublicNumber, SharedKey)) +dhGroupGetPubShared FFDHE2048 pub = getPubShared' ffdhe2048 exp2048 pub +dhGroupGetPubShared FFDHE3072 pub = getPubShared' ffdhe3072 exp3072 pub +dhGroupGetPubShared FFDHE4096 pub = getPubShared' ffdhe4096 exp4096 pub +dhGroupGetPubShared FFDHE6144 pub = getPubShared' ffdhe6144 exp6144 pub +dhGroupGetPubShared FFDHE8192 pub = getPubShared' ffdhe8192 exp8192 pub +dhGroupGetPubShared _ _ = return Nothing getPubShared :: MonadRandom r => Params + -> Int -> PublicNumber -> (PublicNumber -> GroupPublic) -> r (Maybe (GroupPublic, GroupKey)) -getPubShared params pub pubTag = do - mypri <- generatePrivate params +getPubShared params expBits pub pubTag | not (valid params pub) = return Nothing + | otherwise = do + mypri <- generatePriv expBits let mypub = calculatePublic params mypri let SharedKey share = getShared params mypri pub return $ Just (pubTag mypub, SharedSecret share) +getPubShared' :: MonadRandom r + => Params + -> Int + -> PublicNumber + -> r (Maybe (PublicNumber, SharedKey)) +getPubShared' params expBits pub + | not (valid params pub) = return Nothing + | otherwise = do + mypri <- generatePriv expBits + let share = stripLeadingZeros (getShared params mypri pub) + return $ Just (calculatePublic params mypri, SharedKey share) + groupGetShared :: GroupPublic -> GroupPrivate -> Maybe GroupKey groupGetShared (GroupPub_P256 pub) (GroupPri_P256 pri) = maybeCryptoError $ deriveDecrypt p256 pub pri groupGetShared (GroupPub_P384 pub) (GroupPri_P384 pri) = maybeCryptoError $ deriveDecrypt p384 pub pri groupGetShared (GroupPub_P521 pub) (GroupPri_P521 pri) = maybeCryptoError $ deriveDecrypt p521 pub pri groupGetShared (GroupPub_X255 pub) (GroupPri_X255 pri) = maybeCryptoError $ deriveDecrypt x25519 pub pri groupGetShared (GroupPub_X448 pub) (GroupPri_X448 pri) = maybeCryptoError $ deriveDecrypt x448 pub pri -groupGetShared (GroupPub_FFDHE2048 pub) (GroupPri_FFDHE2048 pri) = Just $ calcShared ffdhe2048 pub pri -groupGetShared (GroupPub_FFDHE3072 pub) (GroupPri_FFDHE3072 pri) = Just $ calcShared ffdhe3072 pub pri -groupGetShared (GroupPub_FFDHE4096 pub) (GroupPri_FFDHE4096 pri) = Just $ calcShared ffdhe4096 pub pri -groupGetShared (GroupPub_FFDHE6144 pub) (GroupPri_FFDHE6144 pri) = Just $ calcShared ffdhe6144 pub pri -groupGetShared (GroupPub_FFDHE8192 pub) (GroupPri_FFDHE8192 pri) = Just $ calcShared ffdhe8192 pub pri +groupGetShared (GroupPub_FFDHE2048 pub) (GroupPri_FFDHE2048 pri) = calcShared ffdhe2048 pub pri +groupGetShared (GroupPub_FFDHE3072 pub) (GroupPri_FFDHE3072 pri) = calcShared ffdhe3072 pub pri +groupGetShared (GroupPub_FFDHE4096 pub) (GroupPri_FFDHE4096 pri) = calcShared ffdhe4096 pub pri +groupGetShared (GroupPub_FFDHE6144 pub) (GroupPri_FFDHE6144 pri) = calcShared ffdhe6144 pub pri +groupGetShared (GroupPub_FFDHE8192 pub) (GroupPri_FFDHE8192 pri) = calcShared ffdhe8192 pub pri groupGetShared _ _ = Nothing -calcShared :: Params -> PublicNumber -> PrivateNumber -> SharedSecret -calcShared params pub pri = SharedSecret share +calcShared :: Params -> PublicNumber -> PrivateNumber -> Maybe SharedSecret +calcShared params pub pri + | valid params pub = Just $ SharedSecret share + | otherwise = Nothing where SharedKey share = getShared params pri pub @@ -180,3 +233,31 @@ decodeGroupPublic FFDHE3072 bs = Right . GroupPub_FFDHE3072 . PublicNumber $ os2 decodeGroupPublic FFDHE4096 bs = Right . GroupPub_FFDHE4096 . PublicNumber $ os2ip bs decodeGroupPublic FFDHE6144 bs = Right . GroupPub_FFDHE6144 . PublicNumber $ os2ip bs decodeGroupPublic FFDHE8192 bs = Right . GroupPub_FFDHE8192 . PublicNumber $ os2ip bs + +-- Check that group element in not in the 2-element subgroup { 1, p - 1 }. +-- See RFC 7919 section 3 and NIST SP 56A rev 2 section 5.6.2.3.1. +valid :: Params -> PublicNumber -> Bool +valid (Params p _ _) (PublicNumber y) = 1 < y && y < p - 1 + +-- strips leading zeros from the result of getShared, as required +-- for DH(E) premaster secret in SSL/TLS before version 1.3. +stripLeadingZeros :: SharedKey -> B.ScrubbedBytes +stripLeadingZeros (SharedKey sb) = snd $ B.span (== 0) sb + +-- Use short exponents as optimization, see RFC 7919 section 5.2. +generatePriv :: MonadRandom r => Int -> r PrivateNumber +generatePriv e = PrivateNumber <$> generateParams e (Just SetHighest) False + +-- Short exponent bit sizes from RFC 7919 appendix A, rounded to next +-- multiple of 16 bits, i.e. going through a function like: +-- let shortExp n = head [ e | i <- [1..], let e = n + i, e `mod` 16 == 0 ] +exp2048 :: Int +exp3072 :: Int +exp4096 :: Int +exp6144 :: Int +exp8192 :: Int +exp2048 = 240 -- shortExp 225 +exp3072 = 288 -- shortExp 275 +exp4096 = 336 -- shortExp 325 +exp6144 = 384 -- shortExp 375 +exp8192 = 416 -- shortExp 400 diff --git a/core/Network/TLS/Crypto/Types.hs b/core/Network/TLS/Crypto/Types.hs index 1bcedee5c..9d3e19791 100644 --- a/core/Network/TLS/Crypto/Types.hs +++ b/core/Network/TLS/Crypto/Types.hs @@ -11,8 +11,14 @@ data Group = P256 | P384 | P521 | X25519 | X448 | FFDHE2048 | FFDHE3072 | FFDHE4096 | FFDHE6144 | FFDHE8192 deriving (Eq, Show) +availableFFGroups :: [Group] +availableFFGroups = [FFDHE2048,FFDHE3072,FFDHE4096,FFDHE6144,FFDHE8192] + +availableECGroups :: [Group] +availableECGroups = [P256,P384,P521,X25519,X448] + availableGroups :: [Group] -availableGroups = [P256,P384,P521,X25519,X448] +availableGroups = availableECGroups ++ availableFFGroups -- Digital signature algorithm, in close relation to public/private key types -- and cipher key exchange. diff --git a/core/Network/TLS/Handshake/Client.hs b/core/Network/TLS/Handshake/Client.hs index 07607cb04..775a5464c 100644 --- a/core/Network/TLS/Handshake/Client.hs +++ b/core/Network/TLS/Handshake/Client.hs @@ -63,7 +63,7 @@ handshakeClient cparams ctx = do getExtensions = sequence [sniExtension ,secureReneg ,alpnExtension - ,curveExtension + ,groupExtension ,ecPointExtension --,sessionTicketExtension ,signatureAlgExtension @@ -90,7 +90,7 @@ handshakeClient cparams ctx = do return $ Just $ toExtensionRaw $ ServerName [ServerNameHostName sni] else return Nothing - curveExtension = return $ Just $ toExtensionRaw $ NegotiatedGroups ((supportedGroups $ ctxSupported ctx) `intersect` availableGroups) + groupExtension = return $ Just $ toExtensionRaw $ NegotiatedGroups (supportedGroups $ ctxSupported ctx) ecPointExtension = return $ Just $ toExtensionRaw $ EcPointFormatsSupported [EcPointFormat_Uncompressed] --[EcPointFormat_Uncompressed,EcPointFormat_AnsiX962_compressed_prime,EcPointFormat_AnsiX962_compressed_char2] --heartbeatExtension = return $ Just $ toExtensionRaw $ HeartBeat $ HeartBeat_PeerAllowedToSend @@ -190,11 +190,30 @@ sendClientData cparams ctx = sendCertificate >> sendClientKeyXchg >> sendCertifi where getCKX_DHE = do xver <- usingState_ ctx getVersion serverParams <- usingHState ctx getServerDHParams - (clientDHPriv, clientDHPub) <- generateDHE ctx (serverDHParamsToParams serverParams) - let premaster = dhGetShared (serverDHParamsToParams serverParams) - clientDHPriv - (serverDHParamsToPublic serverParams) + let params = serverDHParamsToParams serverParams + ffGroup = findFiniteFieldGroup params + srvpub = serverDHParamsToPublic serverParams + + (clientDHPub, premaster) <- + case ffGroup of + Nothing -> do + groupUsage <- (onCustomFFDHEGroup $ clientHooks cparams) params srvpub `catchException` + throwMiscErrorOnException "custom group callback failed" + case groupUsage of + GroupUsageInsecure -> throwCore $ Error_Protocol ("FFDHE group is not secure enough", True, InsufficientSecurity) + GroupUsageUnsupported reason -> throwCore $ Error_Protocol ("unsupported FFDHE group: " ++ reason, True, HandshakeFailure) + GroupUsageInvalidPublic -> throwCore $ Error_Protocol ("invalid server public key", True, HandshakeFailure) + GroupUsageValid -> do + (clientDHPriv, clientDHPub) <- generateDHE ctx params + let premaster = dhGetShared params clientDHPriv srvpub + return (clientDHPub, premaster) + Just grp -> do + dhePair <- generateFFDHEShared ctx grp srvpub + case dhePair of + Nothing -> throwCore $ Error_Protocol ("invalid server public key", True, HandshakeFailure) + Just pair -> return pair + usingHState ctx $ setMasterSecretFromPre xver ClientRole premaster return $ CKX_DH clientDHPub @@ -373,13 +392,13 @@ processServerKeyExchange ctx (ServerKeyXchg origSkx) = do -- 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 + -- FIXME verify if FF group is one of supported groups verified <- digitallySignDHParamsVerify ctx dhparams signatureType signature when (not verified) $ throwCore $ Error_Protocol ("bad " ++ show signatureType ++ " signature for dhparams " ++ show dhparams, True, HandshakeFailure) usingHState ctx $ setServerDHParams dhparams doECDHESignature ecdhparams signature signatureType = do - -- TODO verify DHParams + -- FIXME verify if EC group is one of supported groups verified <- digitallySignECDHParamsVerify ctx ecdhparams signatureType signature when (not verified) $ throwCore $ Error_Protocol ("bad " ++ show signatureType ++ " signature for ecdhparams", True, HandshakeFailure) usingHState ctx $ setServerECDHParams ecdhparams diff --git a/core/Network/TLS/Handshake/Key.hs b/core/Network/TLS/Handshake/Key.hs index d4d646f54..7248bf3f0 100644 --- a/core/Network/TLS/Handshake/Key.hs +++ b/core/Network/TLS/Handshake/Key.hs @@ -15,6 +15,8 @@ module Network.TLS.Handshake.Key , generateDHE , generateECDHE , generateECDHEShared + , generateFFDHE + , generateFFDHEShared ) where import qualified Data.ByteString as B @@ -68,3 +70,9 @@ generateECDHE ctx grp = usingState_ ctx $ withRNG $ groupGenerateKeyPair grp generateECDHEShared :: Context -> GroupPublic -> IO (Maybe (GroupPublic, GroupKey)) generateECDHEShared ctx pub = usingState_ ctx $ withRNG $ groupGetPubShared pub + +generateFFDHE :: Context -> Group -> IO (DHParams, DHPrivate, DHPublic) +generateFFDHE ctx grp = usingState_ ctx $ withRNG $ dhGroupGenerateKeyPair grp + +generateFFDHEShared :: Context -> Group -> DHPublic -> IO (Maybe (DHPublic, DHKey)) +generateFFDHEShared ctx grp pub = usingState_ ctx $ withRNG $ dhGroupGetPubShared grp pub diff --git a/core/Network/TLS/Handshake/Process.hs b/core/Network/TLS/Handshake/Process.hs index 6165b4cf9..d456eb613 100644 --- a/core/Network/TLS/Handshake/Process.hs +++ b/core/Network/TLS/Handshake/Process.hs @@ -93,8 +93,12 @@ processClientKeyXchg ctx (CKX_DH clientDHValue) = do role <- usingState_ ctx isClientContext serverParams <- usingHState ctx getServerDHParams + let params = serverDHParamsToParams serverParams + unless (dhValid params $ dhUnwrapPublic clientDHValue) $ + throwCore $ Error_Protocol ("invalid client public key", True, HandshakeFailure) + dhpriv <- usingHState ctx getDHPrivate - let premaster = dhGetShared (serverDHParamsToParams serverParams) dhpriv clientDHValue + let premaster = dhGetShared params dhpriv clientDHValue usingHState ctx $ setMasterSecretFromPre rver role premaster processClientKeyXchg ctx (CKX_ECDH bytes) = do diff --git a/core/Network/TLS/Handshake/Server.hs b/core/Network/TLS/Handshake/Server.hs index fb79b368b..dd88339b8 100644 --- a/core/Network/TLS/Handshake/Server.hs +++ b/core/Network/TLS/Handshake/Server.hs @@ -134,16 +134,24 @@ handshakeServerWith sparams ctx clientHello@(ClientHello clientVersion _ clientS -- negotiated signature parameters. Then ciphers are evalutated from -- the resulting credentials. - let possibleGroups = negotiatedGroupsInCommon ctx exts - hasCommonGroupForECDHE = not (null possibleGroups) + let possibleGroups = negotiatedGroupsInCommon ctx exts + possibleECGroups = possibleGroups `intersect` availableECGroups + possibleFFGroups = possibleGroups `intersect` availableFFGroups + hasCommonGroupForECDHE = not (null possibleECGroups) + hasCommonGroupForFFDHE = not (null possibleFFGroups) + hasCustomGroupForFFDHE = isJust (serverDHEParams sparams) + canFFDHE = hasCustomGroupForFFDHE || hasCommonGroupForFFDHE hasCommonGroup cipher = case cipherKeyExchange cipher of + CipherKeyExchange_DH_Anon -> canFFDHE + CipherKeyExchange_DHE_RSA -> canFFDHE + CipherKeyExchange_DHE_DSS -> canFFDHE CipherKeyExchange_ECDHE_RSA -> hasCommonGroupForECDHE CipherKeyExchange_ECDHE_ECDSA -> hasCommonGroupForECDHE _ -> True -- group not used - -- Ciphers are selected according to TLS version, availability of ECDHE - -- group and credential depending on key exchange. + -- Ciphers are selected according to TLS version, availability of + -- (EC)DHE group and credential depending on key exchange. cipherAllowed cipher = cipherAllowedForVersion chosenVersion cipher && hasCommonGroup cipher selectCipher credentials signatureCredentials = filter cipherAllowed (commonCiphers credentials signatureCredentials) @@ -361,8 +369,17 @@ doHandshake sparams mcred ctx chosenVersion usedCipher usedCompression clientSes extractCAname cert = certSubjectDN $ getCertificate cert setup_DHE = do - let dhparams = fromJust "server DHE Params" $ serverDHEParams sparams - (priv, pub) <- generateDHE ctx dhparams + let possibleFFGroups = negotiatedGroupsInCommon ctx exts `intersect` availableFFGroups + (dhparams, priv, pub) <- + case possibleFFGroups of + [] -> + let dhparams = fromJust "server DHE Params" $ serverDHEParams sparams + in case findFiniteFieldGroup dhparams of + Just g -> generateFFDHE ctx g + Nothing -> do + (priv, pub) <- generateDHE ctx dhparams + return (dhparams, priv, pub) + g:_ -> generateFFDHE ctx g let serverParams = serverDHParamsFrom dhparams pub @@ -405,8 +422,8 @@ doHandshake sparams mcred ctx chosenVersion usedCipher usedCompression clientSes return serverParams generateSKX_ECDHE sigAlg = do - let possibleGroups = negotiatedGroupsInCommon ctx exts - grp <- case possibleGroups of + let possibleECGroups = negotiatedGroupsInCommon ctx exts `intersect` availableECGroups + grp <- case possibleECGroups of [] -> throwCore $ Error_Protocol ("no common group", True, HandshakeFailure) g:_ -> return g serverParams <- setup_ECDHE grp @@ -551,7 +568,7 @@ hashAndSignaturesInCommon ctx exts = negotiatedGroupsInCommon :: Context -> [ExtensionRaw] -> [Group] negotiatedGroupsInCommon ctx exts = case extensionLookup extensionID_NegotiatedGroups exts >>= extensionDecode False of Just (NegotiatedGroups clientGroups) -> - let serverGroups = supportedGroups (ctxSupported ctx) `intersect` availableGroups + let serverGroups = supportedGroups (ctxSupported ctx) in serverGroups `intersect` clientGroups _ -> [] @@ -591,9 +608,9 @@ findHighestVersionFrom clientVersion allowedVersions = [] -> Nothing v:_ -> Just v --- We filter our allowed ciphers here according to server DHE parameters and --- dynamic credential lists. Credentials 'creds' come from server parameters --- but also SNI callback. When the key exchange requires a signature, we use a +-- We filter our allowed ciphers here according to dynamic credential lists. +-- Credentials 'creds' come from server parameters but also SNI callback. +-- When the key exchange requires a signature, we use a -- subset of this list named 'sigCreds'. This list has been filtered in order -- to remove certificates that are not compatible with hash/signature -- restrictions (TLS 1.2). @@ -602,9 +619,9 @@ getCiphers sparams creds sigCreds = filter authorizedCKE (supportedCiphers $ ser where authorizedCKE cipher = case cipherKeyExchange cipher of CipherKeyExchange_RSA -> canEncryptRSA - CipherKeyExchange_DH_Anon -> canDHE - CipherKeyExchange_DHE_RSA -> canSignRSA && canDHE - CipherKeyExchange_DHE_DSS -> canSignDSS && canDHE + CipherKeyExchange_DH_Anon -> True + CipherKeyExchange_DHE_RSA -> canSignRSA + CipherKeyExchange_DHE_DSS -> canSignDSS CipherKeyExchange_ECDHE_RSA -> canSignRSA -- unimplemented: EC CipherKeyExchange_ECDHE_ECDSA -> False @@ -617,7 +634,6 @@ getCiphers sparams creds sigCreds = filter authorizedCKE (supportedCiphers $ ser CipherKeyExchange_ECDH_ECDSA -> False CipherKeyExchange_ECDH_RSA -> False - canDHE = isJust $ serverDHEParams sparams canSignDSS = DSS `elem` signingAlgs canSignRSA = RSA `elem` signingAlgs canEncryptRSA = isJust $ credentialsFindForDecrypting creds diff --git a/core/Network/TLS/Parameters.hs b/core/Network/TLS/Parameters.hs index 7b905629e..83047fa51 100644 --- a/core/Network/TLS/Parameters.hs +++ b/core/Network/TLS/Parameters.hs @@ -19,6 +19,7 @@ module Network.TLS.Parameters , defaultParamsClient -- * Parameters , MaxFragmentEnum(..) + , GroupUsage(..) , CertificateUsage(..) , CertificateRejectReason(..) ) where @@ -111,8 +112,13 @@ data ServerParams = ServerParams -- messages. For TLS1.0, it should not be empty. , serverCACertificates :: [SignedCertificate] - -- | Server Optional Diffie Hellman parameters. If this value is not - -- properly set, no Diffie Hellman key exchange will take place. + -- | Server Optional Diffie Hellman parameters. Setting parameters is + -- necessary for FFDHE key exchange when clients are not compatible + -- with RFC 7919. + -- + -- Value can be one of the standardized groups from module + -- "Network.TLS.Extra.FFDHE" or custom parameters generated with + -- 'Crypto.PubKey.DH.generateParams'. , serverDHEParams :: Maybe DHParams , serverShared :: Shared @@ -181,7 +187,8 @@ data Supported = Supported -- 'False', empty packets will never be added, which is less secure, but might help in rare -- cases. , supportedEmptyPacket :: Bool - -- | A list of supported elliptic curves in the preferred order. + -- | A list of supported elliptic curves and finite-field groups in the + -- preferred order. -- The default value is ['P256','P384','P521']. -- 'P256' provides 128-bit security which is strong enough -- until 2030 and is fast because its backend is written in C. @@ -230,6 +237,21 @@ instance Default Shared where , sharedValidationCache = def } +-- | Group usage callback possible return values. +data GroupUsage = + GroupUsageValid -- ^ usage of group accepted + | GroupUsageInsecure -- ^ usage of group provides insufficient security + | GroupUsageUnsupported String -- ^ usage of group rejected for other reason (specified as string) + | GroupUsageInvalidPublic -- ^ usage of group with an invalid public value + deriving (Show,Eq) + +defaultGroupUsage :: DHParams -> DHPublic -> IO GroupUsage +defaultGroupUsage params public + | not $ odd (dhParamsGetP params) = return $ GroupUsageUnsupported "invalid odd prime" + | not $ dhValid params (dhParamsGetG params) = return $ GroupUsageUnsupported "invalid generator" + | not $ dhValid params (dhUnwrapPublic public) = return $ GroupUsageInvalidPublic + | otherwise = return $ GroupUsageValid + -- | A set of callbacks run by the clients for various corners of TLS establishment data ClientHooks = ClientHooks { -- | This action is called when the server sends a @@ -262,6 +284,11 @@ data ClientHooks = ClientHooks -- | This action is called when the client sends ClientHello -- to determine ALPN values such as '["h2", "http/1.1"]'. , onSuggestALPN :: IO (Maybe [B.ByteString]) + -- | This action is called to validate DHE parameters when + -- the server selected a finite-field group not part of + -- the "Supported Groups Registry". + -- See RFC 7919 section 3.1 for recommandations. + , onCustomFFDHEGroup :: DHParams -> DHPublic -> IO GroupUsage } defaultClientHooks :: ClientHooks @@ -269,6 +296,7 @@ defaultClientHooks = ClientHooks { onCertificateRequest = \ _ -> return Nothing , onServerCertificate = validateDefault , onSuggestALPN = return Nothing + , onCustomFFDHEGroup = defaultGroupUsage } instance Show ClientHooks where diff --git a/core/Tests/Connection.hs b/core/Tests/Connection.hs index 269776213..0c5e508ca 100644 --- a/core/Tests/Connection.hs +++ b/core/Tests/Connection.hs @@ -9,6 +9,7 @@ module Connection , arbitraryPairParams , arbitraryPairParamsWithVersionsAndCiphers , arbitraryClientCredential + , isCustomDHParams , leafPublicKey , oneSessionManager , setPairParamsSessionManager @@ -77,8 +78,10 @@ knownHashSignatures = filter nonECDSA availableHashSignatures arbitraryHashSignatures :: Gen [HashAndSignatureAlgorithm] arbitraryHashSignatures = sublistOf knownHashSignatures -knownGroups :: [Group] -knownGroups = [P256,P384,P521,X25519,X448] +knownGroups, knownECGroups, knownFFGroups :: [Group] +knownECGroups = [P256,P384,P521,X25519,X448] +knownFFGroups = [FFDHE2048,FFDHE3072,FFDHE4096,FFDHE6144,FFDHE8192] +knownGroups = knownECGroups ++ knownFFGroups arbitraryGroups :: Gen [Group] arbitraryGroups = listOf1 $ elements knownGroups @@ -94,6 +97,9 @@ arbitraryCredentialsOfEachType = do , (PubKeyDSA dsaPub, PrivKeyDSA dsaPriv) ] +isCustomDHParams :: DHParams -> Bool +isCustomDHParams params = params == dhParams + leafPublicKey :: CertificateChain -> Maybe PubKey leafPublicKey (CertificateChain []) = Nothing leafPublicKey (CertificateChain (leaf:_)) = Just (certPubKey $ signedObject $ getSigned leaf) @@ -102,7 +108,7 @@ arbitraryCipherPair :: Version -> Gen ([Cipher], [Cipher]) arbitraryCipherPair connectVersion = do serverCiphers <- arbitraryCiphers `suchThat` (\cs -> or [maybe True (<= connectVersion) (cipherMinVer x) | x <- cs]) - clientCiphers <- oneof [arbitraryCiphers] `suchThat` + clientCiphers <- arbitraryCiphers `suchThat` (\cs -> or [x `elem` serverCiphers && maybe True (<= connectVersion) (cipherMinVer x) | x <- cs]) return (clientCiphers, serverCiphers) @@ -118,11 +124,11 @@ arbitraryPairParams = do serAllowedVersions <- (:[]) `fmap` elements allowedVersions arbitraryPairParamsWithVersionsAndCiphers (allowedVersions, serAllowedVersions) (clientCiphers, serverCiphers) -arbitraryGroupPair :: Gen ([Group], [Group]) -arbitraryGroupPair = do - serverGroups <- arbitraryGroups - clientGroups <- oneof [arbitraryGroups] `suchThat` - (\gs -> or [x `elem` serverGroups | x <- gs]) +arbitraryECGroupPair :: Gen ([Group], [Group]) +arbitraryECGroupPair = do + let arbitraryECGroups = listOf1 $ elements knownECGroups + serverGroups <- arbitraryECGroups + clientGroups <- arbitraryECGroups `suchThat` any (`elem` serverGroups) return (clientGroups, serverGroups) arbitraryHashSignaturePair :: Gen ([HashAndSignatureAlgorithm], [HashAndSignatureAlgorithm]) @@ -139,7 +145,7 @@ arbitraryPairParamsWithVersionsAndCiphers (clientVersions, serverVersions) (clie dhparams <- elements [dhParams,ffdhe2048,ffdhe3072] creds <- arbitraryCredentialsOfEachType - (clientGroups, serverGroups) <- arbitraryGroupPair + (clientGroups, serverGroups) <- arbitraryECGroupPair (clientHashSignatures, serverHashSignatures) <- arbitraryHashSignaturePair let serverState = def { serverSupported = def { supportedCiphers = serverCiphers diff --git a/core/Tests/Tests.hs b/core/Tests/Tests.hs index 19ea7edcc..107ad1b60 100644 --- a/core/Tests/Tests.hs +++ b/core/Tests/Tests.hs @@ -170,19 +170,26 @@ prop_handshake_groups = do serverVersions = [TLS12] ciphers = [ cipher_ECDHE_RSA_AES256GCM_SHA384 , cipher_ECDHE_RSA_AES128CBC_SHA + , cipher_DHE_RSA_AES256GCM_SHA384 + , cipher_DHE_RSA_AES128_SHA1 ] (clientParam,serverParam) <- pick $ arbitraryPairParamsWithVersionsAndCiphers (clientVersions, serverVersions) (ciphers, ciphers) clientGroups <- pick arbitraryGroups serverGroups <- pick arbitraryGroups - let clientParam' = clientParam { clientSupported = (clientSupported clientParam) + denyCustom <- pick arbitrary + let groupUsage = if denyCustom then GroupUsageUnsupported "custom group denied" else GroupUsageValid + clientParam' = clientParam { clientSupported = (clientSupported clientParam) { supportedGroups = clientGroups } + , clientHooks = (clientHooks clientParam) + { onCustomFFDHEGroup = \_ _ -> return groupUsage } } serverParam' = serverParam { serverSupported = (serverSupported serverParam) { supportedGroups = serverGroups } } - shouldFail = null (clientGroups `intersect` serverGroups) + isCustom = maybe True isCustomDHParams (serverDHEParams serverParam') + shouldFail = null (clientGroups `intersect` serverGroups) && isCustom && denyCustom if shouldFail then runTLSInitFailure (clientParam',serverParam') else runTLSPipeSimple (clientParam',serverParam')