tls 1.2.17 → 1.2.18
raw patch · 21 files changed
+441/−354 lines, 21 files
Files
- CHANGELOG.md +10/−0
- Network/TLS/Cipher.hs +52/−32
- Network/TLS/Crypto.hs +66/−68
- Network/TLS/Crypto/DH.hs +8/−0
- Network/TLS/ErrT.hs +1/−0
- Network/TLS/Extra/Cipher.hs +60/−81
- Network/TLS/Handshake/Client.hs +10/−12
- Network/TLS/Handshake/Process.hs +3/−3
- Network/TLS/Handshake/Server.hs +8/−29
- Network/TLS/Handshake/Signature.hs +79/−21
- Network/TLS/Handshake/State.hs +8/−5
- Network/TLS/MAC.hs +23/−27
- Network/TLS/Packet.hs +12/−19
- Network/TLS/Record/Disengage.hs +15/−13
- Network/TLS/Record/Engage.hs +18/−21
- Network/TLS/Record/State.hs +5/−5
- Network/TLS/Struct.hs +35/−1
- Network/TLS/Wire.hs +8/−0
- Tests/Ciphers.hs +14/−9
- Tests/Connection.hs +5/−7
- tls.cabal +1/−1
CHANGELOG.md view
@@ -1,3 +1,13 @@+## Version 1.2.18++- add more tests (network, local)+- cleanup cipher / bulk code, certificate verify / creation, and digitall signed handling+- fix handling of DHE ciphers with MS SSL stack that serialize leading zero.++## Version 1.2.17++- Fix an issue of type of key / hash that prevented connection with SChannel.+ ## Version 1.2.16 - Fix an issue with stream cipher not correctly calculating the internal state,
Network/TLS/Cipher.hs view
@@ -8,17 +8,23 @@ -- Portability : unknown -- module Network.TLS.Cipher- ( BulkFunctions(..)- , CipherKeyExchangeType(..)+ ( CipherKeyExchangeType(..) , Bulk(..)+ , BulkFunctions(..)+ , BulkDirection(..)+ , BulkState(..)+ , BulkStream(..)+ , BulkBlock+ , BulkAEAD+ , bulkInit , Hash(..) , Cipher(..) , CipherID- , Key- , IV- , Nonce- , AdditionalData , cipherKeyBlockSize+ , BulkKey+ , BulkIV+ , BulkNonce+ , BulkAdditionalData , cipherAllowedForVersion , cipherExchangeNeedMoreData , hasMAC@@ -28,29 +34,54 @@ import Crypto.Cipher.Types (AuthTag) import Network.TLS.Types (CipherID) import Network.TLS.Struct (Version(..))+import Network.TLS.Crypto (Hash(..), hashDigestSize) import qualified Data.ByteString as B -- FIXME convert to newtype-type Key = B.ByteString-type IV = B.ByteString-type Nonce = B.ByteString-type AdditionalData = B.ByteString+type BulkKey = B.ByteString+type BulkIV = B.ByteString+type BulkNonce = B.ByteString+type BulkAdditionalData = B.ByteString +data BulkState =+ BulkStateStream BulkStream+ | BulkStateBlock BulkBlock+ | BulkStateAEAD BulkAEAD+ | BulkStateUninitialized++instance Show BulkState where+ show (BulkStateStream _) = "BulkStateStream"+ show (BulkStateBlock _) = "BulkStateBlock"+ show (BulkStateAEAD _) = "BulkStateAEAD"+ show (BulkStateUninitialized) = "BulkStateUninitialized"++newtype BulkStream = BulkStream (B.ByteString -> (B.ByteString, BulkStream))++type BulkBlock = BulkIV -> B.ByteString -> (B.ByteString, BulkIV)++type BulkAEAD = BulkNonce -> B.ByteString -> BulkAdditionalData -> (B.ByteString, AuthTag)++data BulkDirection = BulkEncrypt | BulkDecrypt+ deriving (Show,Eq)++bulkInit :: Bulk -> BulkDirection -> BulkKey -> BulkState+bulkInit bulk direction key =+ case bulkF bulk of+ BulkBlockF ini -> BulkStateBlock (ini direction key)+ BulkStreamF ini -> BulkStateStream (ini direction key)+ BulkAeadF ini -> BulkStateAEAD (ini direction key)+ data BulkFunctions =- BulkBlockF (Key -> IV -> B.ByteString -> B.ByteString)- (Key -> IV -> B.ByteString -> B.ByteString)- | BulkStreamF (Key -> IV)- (IV -> B.ByteString -> (B.ByteString, IV))- (IV -> B.ByteString -> (B.ByteString, IV))- | BulkAeadF (Key -> Nonce -> B.ByteString -> AdditionalData -> (B.ByteString, AuthTag))- (Key -> Nonce -> B.ByteString -> AdditionalData -> (B.ByteString, AuthTag))+ BulkBlockF (BulkDirection -> BulkKey -> BulkBlock)+ | BulkStreamF (BulkDirection -> BulkKey -> BulkStream)+ | BulkAeadF (BulkDirection -> BulkKey -> BulkAEAD) hasMAC,hasRecordIV :: BulkFunctions -> Bool -hasMAC (BulkBlockF _ _) = True-hasMAC (BulkStreamF _ _ _) = True-hasMAC (BulkAeadF _ _ ) = False+hasMAC (BulkBlockF _ ) = True+hasMAC (BulkStreamF _) = True+hasMAC (BulkAeadF _ ) = False hasRecordIV = hasMAC @@ -84,17 +115,6 @@ , bulkBlockSize b1 == bulkBlockSize b2 ] -data Hash = Hash- { hashName :: String- , hashSize :: Int- , hashF :: B.ByteString -> B.ByteString- }--instance Show Hash where- show hash = hashName hash-instance Eq Hash where- h1 == h2 = hashName h1 == hashName h2 && hashSize h1 == hashSize h2- -- | Cipher algorithm data Cipher = Cipher { cipherID :: CipherID@@ -106,7 +126,7 @@ } cipherKeyBlockSize :: Cipher -> Int-cipherKeyBlockSize cipher = 2 * (hashSize (cipherHash cipher) + bulkIVSize bulk + bulkKeySize bulk)+cipherKeyBlockSize cipher = 2 * (hashDigestSize (cipherHash cipher) + bulkIVSize bulk + bulkKeySize bulk) where bulk = cipherBulk cipher -- | Check if a specific 'Cipher' is allowed to be used
Network/TLS/Crypto.hs view
@@ -1,7 +1,8 @@ {-# OPTIONS_HADDOCK hide #-} {-# LANGUAGE ExistentialQuantification #-} module Network.TLS.Crypto- ( HashCtx(..)+ ( HashContext+ , HashCtx , hashInit , hashUpdate , hashUpdateSSL@@ -10,11 +11,12 @@ , module Network.TLS.Crypto.DH , module Network.TLS.Crypto.ECDH - -- * constructor- , hashMD5SHA1- , hashSHA1- , hashSHA256- , hashSHA512+ -- * Hash+ , hash+ , Hash(..)+ , hashName+ , hashDigestSize+ , hashBlockSize -- * key exchange generic interface , PubKey(..)@@ -29,11 +31,9 @@ , KxError(..) ) where -import qualified Crypto.Hash.SHA512 as SHA512-import qualified Crypto.Hash.SHA256 as SHA256-import qualified Crypto.Hash.SHA1 as SHA1-import qualified Crypto.Hash.MD5 as MD5+import qualified Crypto.Hash as H import qualified Data.ByteString as B+import qualified Data.Byteable as B import Data.ByteString (ByteString) import Crypto.PubKey.HashDescr import qualified Crypto.PubKey.DSA as DSA@@ -58,76 +58,74 @@ | KxUnsupported deriving (Show) -class HashCtxC a where- hashCName :: a -> String- hashCInit :: a -> a- hashCUpdate :: a -> B.ByteString -> a- hashCUpdateSSL :: a -> (B.ByteString,B.ByteString) -> a- hashCFinal :: a -> B.ByteString--data HashCtx = forall h . HashCtxC h => HashCtx h--instance Show HashCtx where- show (HashCtx c) = hashCName c--{- MD5 & SHA1 joined -}-data HashMD5SHA1 = HashMD5SHA1 SHA1.Ctx MD5.Ctx+-- functions to use the hidden class.+hashInit :: Hash -> HashContext+hashInit MD5 = HashContext $ ContextSimple (H.hashInit :: H.Context H.MD5)+hashInit SHA1 = HashContext $ ContextSimple (H.hashInit :: H.Context H.SHA1)+hashInit SHA256 = HashContext $ ContextSimple (H.hashInit :: H.Context H.SHA256)+hashInit SHA512 = HashContext $ ContextSimple (H.hashInit :: H.Context H.SHA512)+hashInit SHA1_MD5 = HashContextSSL H.hashInit H.hashInit -instance HashCtxC HashMD5SHA1 where- hashCName _ = "MD5-SHA1"- hashCInit _ = HashMD5SHA1 SHA1.init MD5.init- hashCUpdate (HashMD5SHA1 sha1ctx md5ctx) b = HashMD5SHA1 (SHA1.update sha1ctx b) (MD5.update md5ctx b)- hashCUpdateSSL (HashMD5SHA1 sha1ctx md5ctx) (b1,b2) = HashMD5SHA1 (SHA1.update sha1ctx b2) (MD5.update md5ctx b1)- hashCFinal (HashMD5SHA1 sha1ctx md5ctx) = B.concat [MD5.finalize md5ctx, SHA1.finalize sha1ctx]+hashUpdate :: HashContext -> B.ByteString -> HashCtx+hashUpdate (HashContext (ContextSimple h)) b = HashContext $ ContextSimple (H.hashUpdate h b)+hashUpdate (HashContextSSL sha1Ctx md5Ctx) b =+ HashContextSSL (H.hashUpdate sha1Ctx b) (H.hashUpdate md5Ctx b) -newtype HashSHA1 = HashSHA1 SHA1.Ctx+hashUpdateSSL :: HashCtx+ -> (B.ByteString,B.ByteString) -- ^ (for the md5 context, for the sha1 context)+ -> HashCtx+hashUpdateSSL (HashContext _) _ = error "internal error: update SSL without a SSL Context"+hashUpdateSSL (HashContextSSL sha1Ctx md5Ctx) (b1,b2) =+ HashContextSSL (H.hashUpdate sha1Ctx b2) (H.hashUpdate md5Ctx b1) -instance HashCtxC HashSHA1 where- hashCName _ = "SHA1"- hashCInit _ = HashSHA1 SHA1.init- hashCUpdate (HashSHA1 ctx) b = HashSHA1 (SHA1.update ctx b)- hashCUpdateSSL (HashSHA1 ctx) (_,b2) = HashSHA1 (SHA1.update ctx b2)- hashCFinal (HashSHA1 ctx) = SHA1.finalize ctx+hashFinal :: HashCtx -> B.ByteString+hashFinal (HashContext (ContextSimple h)) = B.toBytes $ H.hashFinalize h+hashFinal (HashContextSSL sha1Ctx md5Ctx) =+ B.concat [B.toBytes (H.hashFinalize md5Ctx), B.toBytes (H.hashFinalize sha1Ctx)] -newtype HashSHA256 = HashSHA256 SHA256.Ctx+data Hash = MD5 | SHA1 | SHA256 | SHA512 | SHA1_MD5+ deriving (Show,Eq) -instance HashCtxC HashSHA256 where- hashCName _ = "SHA256"- hashCInit _ = HashSHA256 SHA256.init- hashCUpdate (HashSHA256 ctx) b = HashSHA256 (SHA256.update ctx b)- hashCUpdateSSL _ _ = error "CUpdateSSL with HashSHA256"- hashCFinal (HashSHA256 ctx) = SHA256.finalize ctx+data HashContext =+ HashContext ContextSimple+ | HashContextSSL (H.Context H.SHA1) (H.Context H.MD5) -newtype HashSHA512 = HashSHA512 SHA512.Ctx+instance Show HashContext where+ show _ = "hash-context" -instance HashCtxC HashSHA512 where- hashCName _ = "SHA512"- hashCInit _ = HashSHA512 SHA512.init- hashCUpdate (HashSHA512 ctx) b = HashSHA512 (SHA512.update ctx b)- hashCUpdateSSL _ _ = error "CUpdateSSL with HashSHA512"- hashCFinal (HashSHA512 ctx) = SHA512.finalize ctx+data ContextSimple = forall alg . H.HashAlgorithm alg => ContextSimple (H.Context alg) --- functions to use the hidden class.-hashInit :: HashCtx -> HashCtx-hashInit (HashCtx h) = HashCtx $ hashCInit h+type HashCtx = HashContext -hashUpdate :: HashCtx -> B.ByteString -> HashCtx-hashUpdate (HashCtx h) b = HashCtx $ hashCUpdate h b+hash :: Hash -> B.ByteString -> B.ByteString+hash MD5 b = B.toBytes . (H.hash :: B.ByteString -> H.Digest H.MD5) $ b+hash SHA1 b = B.toBytes . (H.hash :: B.ByteString -> H.Digest H.SHA1) $ b+hash SHA256 b = B.toBytes . (H.hash :: B.ByteString -> H.Digest H.SHA256) $ b+hash SHA512 b = B.toBytes . (H.hash :: B.ByteString -> H.Digest H.SHA512) $ b+hash SHA1_MD5 b =+ B.concat [B.toBytes (md5Hash b), B.toBytes (sha1Hash b)]+ where+ sha1Hash :: B.ByteString -> H.Digest H.SHA1+ sha1Hash = H.hash+ md5Hash :: B.ByteString -> H.Digest H.MD5+ md5Hash = H.hash -hashUpdateSSL :: HashCtx- -> (B.ByteString,B.ByteString) -- ^ (for the md5 context, for the sha1 context)- -> HashCtx-hashUpdateSSL (HashCtx h) bs = HashCtx $ hashCUpdateSSL h bs+hashName :: Hash -> String+hashName = show -hashFinal :: HashCtx -> B.ByteString-hashFinal (HashCtx h) = hashCFinal h+hashDigestSize :: Hash -> Int+hashDigestSize MD5 = 16+hashDigestSize SHA1 = 20+hashDigestSize SHA256 = 32+hashDigestSize SHA512 = 64+hashDigestSize SHA1_MD5 = 36 --- real hash constructors-hashMD5SHA1, hashSHA1, hashSHA256, hashSHA512 :: HashCtx-hashMD5SHA1 = HashCtx (HashMD5SHA1 SHA1.init MD5.init)-hashSHA1 = HashCtx (HashSHA1 SHA1.init)-hashSHA256 = HashCtx (HashSHA256 SHA256.init)-hashSHA512 = HashCtx (HashSHA512 SHA512.init)+hashBlockSize :: Hash -> Int+hashBlockSize MD5 = 64+hashBlockSize SHA1 = 64+hashBlockSize SHA256 = 64+hashBlockSize SHA512 = 128+hashBlockSize SHA1_MD5 = 64 {- key exchange methods encrypt and decrypt for each supported algorithm -}
Network/TLS/Crypto/DH.hs view
@@ -9,6 +9,8 @@ , dhPublic , dhPrivate , dhParams+ , dhParamsGetP+ , dhParamsGetG , dhGenerateKeyPair , dhGetShared , dhUnwrap@@ -48,6 +50,12 @@ dhUnwrap :: DHParams -> DHPublic -> [Integer] dhUnwrap (DH.Params p g) (DH.PublicNumber y) = [p,g,y]++dhParamsGetP :: DHParams -> Integer+dhParamsGetP (DH.Params p _) = p++dhParamsGetG :: DHParams -> Integer+dhParamsGetG (DH.Params _ g) = g dhUnwrapPublic :: DHPublic -> Integer dhUnwrapPublic (DH.PublicNumber y) = y
Network/TLS/ErrT.hs view
@@ -22,6 +22,7 @@ type ErrT = ExceptT #else import Control.Monad.Error+runErrT :: ErrorT e m a -> m (Either e a) runErrT = runErrorT type ErrT = ErrorT #endif
Network/TLS/Extra/Cipher.hs view
@@ -43,62 +43,59 @@ import Network.TLS.Cipher import qualified "cipher-rc4" Crypto.Cipher.RC4 as RC4 -import qualified Crypto.Hash.SHA256 as SHA256-import qualified Crypto.Hash.SHA1 as SHA1-import qualified Crypto.Hash.MD5 as MD5- import qualified "cipher-aes" Crypto.Cipher.AES as AES import Crypto.Cipher.TripleDES import Crypto.Cipher.Types (makeKey, makeIV, cipherInit, cbcEncrypt, cbcDecrypt) import qualified Crypto.Cipher.Types as T -aes_cbc_encrypt :: Key -> IV -> B.ByteString -> B.ByteString-aes_cbc_encrypt key iv d = AES.encryptCBC (AES.initAES key) iv d -aes_cbc_decrypt :: Key -> IV -> B.ByteString -> B.ByteString-aes_cbc_decrypt key iv d = AES.decryptCBC (AES.initAES key) iv d+takelast :: Int -> B.ByteString -> B.ByteString+takelast i b = B.drop (B.length b - i) b -aes128_cbc_encrypt- , aes128_cbc_decrypt- , aes256_cbc_encrypt- , aes256_cbc_decrypt :: Key -> IV -> B.ByteString -> B.ByteString-aes128_cbc_encrypt = aes_cbc_encrypt-aes128_cbc_decrypt = aes_cbc_decrypt-aes256_cbc_encrypt = aes_cbc_encrypt-aes256_cbc_decrypt = aes_cbc_decrypt+aes128cbc :: BulkDirection -> BulkKey -> BulkBlock+aes128cbc BulkEncrypt key =+ let ctx = AES.initAES key+ in (\iv input -> let output = AES.encryptCBC ctx iv input in (output, takelast 16 output))+aes128cbc BulkDecrypt key =+ let ctx = AES.initAES key+ in (\iv input -> let output = AES.decryptCBC ctx iv input in (output, takelast 16 input)) -aes128_gcm_encrypt, aes128_gcm_decrypt :: Key -> Nonce -> B.ByteString -> AdditionalData -> (B.ByteString, T.AuthTag)-aes128_gcm_encrypt key nonce d ad = AES.encryptGCM (AES.initAES key) nonce ad d-aes128_gcm_decrypt key nonce d ad = AES.decryptGCM (AES.initAES key) nonce ad d+aes256cbc :: BulkDirection -> BulkKey -> BulkBlock+aes256cbc BulkEncrypt key =+ let ctx = AES.initAES key+ in (\iv input -> let output = AES.encryptCBC ctx iv input in (output, takelast 16 output))+aes256cbc BulkDecrypt key =+ let ctx = AES.initAES key+ in (\iv input -> let output = AES.decryptCBC ctx iv input in (output, takelast 16 input)) -tripledes_ede_cbc_encrypt :: Key -> IV -> B.ByteString -> B.ByteString-tripledes_ede_cbc_encrypt key iv bs =- cbcEncrypt (cipherInit $ tripledes_key key) (tripledes_iv iv) bs+aes128gcm :: BulkDirection -> BulkKey -> BulkAEAD+aes128gcm BulkEncrypt key =+ let ctx = AES.initAES key+ in (\nonce d ad -> AES.encryptGCM ctx nonce ad d)+aes128gcm BulkDecrypt key =+ let ctx = AES.initAES key+ in (\nonce d ad -> AES.decryptGCM ctx nonce ad d) -tripledes_ede_cbc_decrypt :: Key -> IV -> B.ByteString -> B.ByteString-tripledes_ede_cbc_decrypt key iv bs =- cbcDecrypt (cipherInit $ tripledes_key key) (tripledes_iv iv) bs+tripledes_ede :: BulkDirection -> BulkKey -> BulkBlock+tripledes_ede BulkEncrypt key =+ let ctx = cipherInit (tripledes_key key)+ in (\iv input -> let output = cbcEncrypt ctx (tripledes_iv iv) input in (output, takelast 16 output))+tripledes_ede BulkDecrypt key =+ let ctx = cipherInit (tripledes_key key)+ in (\iv input -> let output = cbcDecrypt ctx (tripledes_iv iv) input in (output, takelast 16 input)) -tripledes_key :: Key -> T.Key DES_EDE3+tripledes_key :: BulkKey -> T.Key DES_EDE3 tripledes_key key = either (\ke -> error ("tripledes cipher key internal error: " ++ show ke)) id $ makeKey key -tripledes_iv :: IV -> T.IV DES_EDE3+tripledes_iv :: BulkIV -> T.IV DES_EDE3 tripledes_iv iv = maybe (error "tripledes cipher iv internal error") id $ makeIV iv -toIV :: RC4.Ctx -> IV-toIV (RC4.Ctx ctx) = ctx--toCtx :: IV -> RC4.Ctx-toCtx iv = RC4.Ctx iv--initF_rc4 :: Key -> IV-initF_rc4 key = toIV $ RC4.initCtx key--encryptF_rc4 :: IV -> B.ByteString -> (B.ByteString, IV)-encryptF_rc4 iv d = (\(ctx, e) -> (e, toIV ctx)) $ RC4.combine (toCtx iv) d--decryptF_rc4 :: IV -> B.ByteString -> (B.ByteString, IV)-decryptF_rc4 iv e = (\(ctx, d) -> (d, toIV ctx)) $ RC4.combine (toCtx iv) e+rc4 :: BulkDirection -> BulkKey -> BulkStream+rc4 _ bulkKey = BulkStream (combineRC4 $ RC4.initCtx bulkKey)+ where+ combineRC4 ctx input =+ let (ctx', output) = RC4.combine ctx input+ in (output, BulkStream (combineRC4 ctx')) -- | all encrypted ciphers supported ordered from strong to weak.@@ -142,16 +139,17 @@ , bulkKeySize = 0 , bulkIVSize = 0 , bulkBlockSize = 0- , bulkF = BulkStreamF (const B.empty) streamId streamId+ , bulkF = BulkStreamF passThrough }- where streamId = \iv b -> (b,iv)+ where+ passThrough _ _ = BulkStream go where go inp = (inp, BulkStream go) bulk_rc4 = Bulk { bulkName = "RC4-128" , bulkKeySize = 16 , bulkIVSize = 0 , bulkBlockSize = 0- , bulkF = BulkStreamF initF_rc4 encryptF_rc4 decryptF_rc4+ , bulkF = BulkStreamF rc4 } bulk_aes128 = Bulk@@ -159,7 +157,7 @@ , bulkKeySize = 16 , bulkIVSize = 16 , bulkBlockSize = 16- , bulkF = BulkBlockF aes128_cbc_encrypt aes128_cbc_decrypt+ , bulkF = BulkBlockF aes128cbc } bulk_aes128gcm = Bulk@@ -167,7 +165,7 @@ , bulkKeySize = 16 -- RFC 5116 Sec 5.1: K_LEN , bulkIVSize = 4 -- RFC 5288 GCMNonce.salt, fixed_iv_length , bulkBlockSize = 0 -- dummy, not used- , bulkF = BulkAeadF aes128_gcm_encrypt aes128_gcm_decrypt+ , bulkF = BulkAeadF aes128gcm } bulk_aes256 = Bulk@@ -175,7 +173,7 @@ , bulkKeySize = 32 , bulkIVSize = 16 , bulkBlockSize = 16- , bulkF = BulkBlockF aes256_cbc_encrypt aes256_cbc_decrypt+ , bulkF = BulkBlockF aes256cbc } bulk_tripledes_ede = Bulk@@ -183,26 +181,7 @@ , bulkKeySize = 24 , bulkIVSize = 8 , bulkBlockSize = 8- , bulkF = BulkBlockF tripledes_ede_cbc_encrypt tripledes_ede_cbc_decrypt- }--hash_md5, hash_sha1, hash_sha256 :: Hash-hash_md5 = Hash- { hashName = "MD5"- , hashSize = 16- , hashF = MD5.hash- }--hash_sha1 = Hash- { hashName = "SHA1"- , hashSize = 20- , hashF = SHA1.hash- }--hash_sha256 = Hash- { hashName = "SHA256"- , hashSize = 32- , hashF = SHA256.hash+ , bulkF = BulkBlockF tripledes_ede } -- | unencrypted cipher using RSA for key exchange and MD5 for digest@@ -211,7 +190,7 @@ { cipherID = 0x1 , cipherName = "RSA-null-MD5" , cipherBulk = bulk_null- , cipherHash = hash_md5+ , cipherHash = MD5 , cipherKeyExchange = CipherKeyExchange_RSA , cipherMinVer = Nothing }@@ -222,7 +201,7 @@ { cipherID = 0x2 , cipherName = "RSA-null-SHA1" , cipherBulk = bulk_null- , cipherHash = hash_sha1+ , cipherHash = SHA1 , cipherKeyExchange = CipherKeyExchange_RSA , cipherMinVer = Nothing }@@ -233,7 +212,7 @@ { cipherID = 0x04 , cipherName = "RSA-rc4-128-md5" , cipherBulk = bulk_rc4- , cipherHash = hash_md5+ , cipherHash = MD5 , cipherKeyExchange = CipherKeyExchange_RSA , cipherMinVer = Nothing }@@ -244,7 +223,7 @@ { cipherID = 0x05 , cipherName = "RSA-rc4-128-sha1" , cipherBulk = bulk_rc4- , cipherHash = hash_sha1+ , cipherHash = SHA1 , cipherKeyExchange = CipherKeyExchange_RSA , cipherMinVer = Nothing }@@ -255,7 +234,7 @@ { cipherID = 0x2f , cipherName = "RSA-aes128-sha1" , cipherBulk = bulk_aes128- , cipherHash = hash_sha1+ , cipherHash = SHA1 , cipherKeyExchange = CipherKeyExchange_RSA , cipherMinVer = Just SSL3 }@@ -266,7 +245,7 @@ { cipherID = 0x35 , cipherName = "RSA-aes256-sha1" , cipherBulk = bulk_aes256- , cipherHash = hash_sha1+ , cipherHash = SHA1 , cipherKeyExchange = CipherKeyExchange_RSA , cipherMinVer = Just SSL3 }@@ -277,7 +256,7 @@ { cipherID = 0x3c , cipherName = "RSA-aes128-sha256" , cipherBulk = bulk_aes128- , cipherHash = hash_sha256+ , cipherHash = SHA256 , cipherKeyExchange = CipherKeyExchange_RSA , cipherMinVer = Just TLS12 }@@ -288,7 +267,7 @@ { cipherID = 0x3d , cipherName = "RSA-aes256-sha256" , cipherBulk = bulk_aes256- , cipherHash = hash_sha256+ , cipherHash = SHA256 , cipherKeyExchange = CipherKeyExchange_RSA , cipherMinVer = Just TLS12 }@@ -299,7 +278,7 @@ { cipherID = 0x33 , cipherName = "DHE-RSA-AES128-SHA1" , cipherBulk = bulk_aes128- , cipherHash = hash_sha1+ , cipherHash = SHA1 , cipherKeyExchange = CipherKeyExchange_DHE_RSA , cipherMinVer = Nothing }@@ -318,7 +297,7 @@ { cipherID = 0x32 , cipherName = "DHE-DSA-AES128-SHA1" , cipherBulk = bulk_aes128- , cipherHash = hash_sha1+ , cipherHash = SHA1 , cipherKeyExchange = CipherKeyExchange_DHE_DSS , cipherMinVer = Nothing }@@ -342,7 +321,7 @@ cipher_DHE_RSA_AES128_SHA256 = cipher_DHE_RSA_AES128_SHA1 { cipherID = 0x67 , cipherName = "DHE-RSA-AES128-SHA256"- , cipherHash = hash_sha256+ , cipherHash = SHA256 , cipherMinVer = Just TLS12 } @@ -359,7 +338,7 @@ { cipherID = 0x0a , cipherName = "RSA-3DES-EDE-CBC-SHA1" , cipherBulk = bulk_tripledes_ede- , cipherHash = hash_sha1+ , cipherHash = SHA1 , cipherKeyExchange = CipherKeyExchange_RSA , cipherMinVer = Nothing }@@ -369,7 +348,7 @@ { cipherID = 0x9e , cipherName = "DHE-RSA-AES128GCM-SHA256" , cipherBulk = bulk_aes128gcm- , cipherHash = hash_sha256+ , cipherHash = SHA256 , cipherKeyExchange = CipherKeyExchange_DHE_RSA , cipherMinVer = Just TLS12 -- RFC 5288 Sec 4 }@@ -379,7 +358,7 @@ { cipherID = 0xc02f , cipherName = "ECDHE-RSA-AES128GCM-SHA256" , cipherBulk = bulk_aes128gcm- , cipherHash = hash_sha256+ , cipherHash = SHA256 , cipherKeyExchange = CipherKeyExchange_ECDHE_RSA , cipherMinVer = Just TLS12 -- RFC 5288 Sec 4 }
Network/TLS/Handshake/Client.hs view
@@ -209,10 +209,12 @@ sendPacket ctx $ Handshake [ClientKeyXchg ckx] where getCKX_DHE = do xver <- usingState_ ctx getVersion- (ServerDHParams dhparams serverDHPub) <- fromJust <$> usingHState ctx (gets hstServerDHParams)- (clientDHPriv, clientDHPub) <- generateDHE ctx dhparams+ serverParams <- fromJust <$> usingHState ctx (gets hstServerDHParams)+ (clientDHPriv, clientDHPub) <- generateDHE ctx (serverDHParamsToParams serverParams) - let premaster = dhGetShared dhparams clientDHPriv serverDHPub+ let premaster = dhGetShared (serverDHParamsToParams serverParams)+ clientDHPriv+ (serverDHParamsToPublic serverParams) usingHState ctx $ setMasterSecretFromPre xver ClientRole premaster return $ CKX_DH clientDHPub@@ -258,10 +260,8 @@ _ -> return Nothing -- Fetch all handshake messages up to now.- msgs <- usingHState ctx $ B.concat <$> getHandshakeMessages- (hashMethod, toSign) <- prepareCertificateVerifySignatureData ctx usedVersion malg msgs-- sigDig <- signatureCreate ctx malg hashMethod toSign+ msgs <- usingHState ctx $ B.concat <$> getHandshakeMessages+ sigDig <- certificateVerifyCreate ctx usedVersion malg msgs sendPacket ctx $ Handshake [CertVerify sigDig] _ -> return ()@@ -389,15 +389,13 @@ (c,_) -> throwCore $ Error_Protocol ("unknown server key exchange received, expecting: " ++ show c, True, HandshakeFailure) doDHESignature dhparams signature signatureType = do -- TODO verify DHParams- expectedData <- generateSignedDHParams ctx dhparams- verified <- signatureVerify ctx signatureType expectedData signature- when (not verified) $ throwCore $ Error_Protocol ("bad " ++ show signatureType ++ " for dhparams", True, HandshakeFailure)+ verified <- digitallySignDHParamsVerify ctx dhparams signatureType signature+ when (not verified) $ throwCore $ Error_Protocol ("bad " ++ show signatureType ++ " for dhparams " ++ show dhparams, True, HandshakeFailure) usingHState ctx $ setServerDHParams dhparams doECDHESignature ecdhparams signature signatureType = do -- TODO verify DHParams- expectedData <- generateSignedECDHParams ctx ecdhparams- verified <- signatureVerify ctx signatureType expectedData signature+ verified <- digitallySignECDHParamsVerify ctx ecdhparams signatureType signature when (not verified) $ throwCore $ Error_Protocol ("bad " ++ show signatureType ++ " for dhparams", True, HandshakeFailure) usingHState ctx $ setServerECDHParams ecdhparams
Network/TLS/Handshake/Process.hs view
@@ -88,9 +88,9 @@ rver <- usingState_ ctx getVersion role <- usingState_ ctx isClientContext - (ServerDHParams dhparams _) <- fromJust "server dh params" <$> usingHState ctx (gets hstServerDHParams)- dhpriv <- fromJust "dh private" <$> usingHState ctx (gets hstDHPrivate)- let premaster = dhGetShared dhparams dhpriv clientDHValue+ serverParams <- fromJust "server dh params" <$> usingHState ctx (gets hstServerDHParams)+ dhpriv <- fromJust "dh private" <$> usingHState ctx (gets hstDHPrivate)+ let premaster = dhGetShared (serverDHParamsToParams serverParams) dhpriv clientDHValue usingHState ctx $ setMasterSecretFromPre rver role premaster processClientKeyXchg ctx (CKX_ECDH clientECDHValue) = do
Network/TLS/Handshake/Server.hs view
@@ -268,7 +268,7 @@ let dhparams = fromJust "server DHE Params" $ serverDHEParams sparams (priv, pub) <- generateDHE ctx dhparams - let serverParams = ServerDHParams dhparams pub+ let serverParams = serverDHParamsFrom dhparams pub usingHState ctx $ setServerDHParams serverParams usingHState ctx $ modify $ \hst -> hst { hstDHPrivate = Just priv }@@ -276,17 +276,7 @@ generateSKX_DHE sigAlg = do serverParams <- setup_DHE- signatureData <- generateSignedDHParams ctx serverParams-- usedVersion <- usingState_ ctx getVersion- let mhash = case usedVersion of- TLS12 -> case filter ((==) sigAlg . snd) $ supportedHashSignatures $ ctxSupported ctx of- [] -> error ("no hash signature for " ++ show sigAlg)- x:_ -> Just (fst x)- _ -> Nothing- let hashDescr = signatureHashData sigAlg mhash- signed <- signatureCreate ctx (fmap (\h -> (h, sigAlg)) mhash) hashDescr signatureData-+ signed <- digitallySignDHParams ctx serverParams sigAlg case sigAlg of SignatureRSA -> return $ SKX_DHE_RSA serverParams signed SignatureDSS -> return $ SKX_DHE_DSS serverParams signed@@ -311,22 +301,14 @@ -- There may be a better way to choose EC. nc = if null common then error "No common EllipticCurves" else maximum $ map fromEnumSafe16 common- serverParams <- setup_ECDHE nc- signatureData <- generateSignedECDHParams ctx serverParams-- usedVersion <- usingState_ ctx getVersion- let mhash = case usedVersion of- TLS12 -> case filter ((==) sigAlg . snd) $ supportedHashSignatures $ ctxSupported ctx of- [] -> error ("no hash signature for " ++ show sigAlg)- x:_ -> Just (fst x)- _ -> Nothing- let hashDescr = signatureHashData sigAlg mhash- signed <- signatureCreate ctx (fmap (\h -> (h, sigAlg)) mhash) hashDescr signatureData-+ serverParams <- setup_ECDHE nc+ signed <- digitallySignECDHParams ctx serverParams sigAlg case sigAlg of SignatureRSA -> return $ SKX_ECDHE_RSA serverParams signed _ -> error ("generate skx_dhe unsupported signature type: " ++ show sigAlg) + -- create a DigitallySigned objects for DHParams or ECDHParams.+ -- | receive Client data in handshake until the Finished handshake. -- -- <- [certificate]@@ -376,11 +358,8 @@ usedVersion <- usingState_ ctx getVersion -- Fetch all handshake messages up to now.- msgs <- usingHState ctx $ B.concat <$> getHandshakeMessages- (hashMethod, toVerify) <- prepareCertificateVerifySignatureData ctx usedVersion mbHashSig msgs-- -- Verify the signature.- verif <- signatureVerifyWithHashDescr ctx SignatureRSA hashMethod toVerify dsig+ msgs <- usingHState ctx $ B.concat <$> getHandshakeMessages+ verif <- certificateVerifyCheck ctx usedVersion mbHashSig msgs dsig case verif of True -> do
Network/TLS/Handshake/Signature.hs view
@@ -7,14 +7,13 @@ -- Portability : unknown -- module Network.TLS.Handshake.Signature- ( getHashAndASN1- , prepareCertificateVerifySignatureData- , signatureHashData- , signatureCreate- , signatureVerify- , signatureVerifyWithHashDescr- , generateSignedDHParams- , generateSignedECDHParams+ (+ certificateVerifyCreate+ , certificateVerifyCheck+ , digitallySignDHParams+ , digitallySignECDHParams+ , digitallySignDHParamsVerify+ , digitallySignECDHParamsVerify ) where import Crypto.PubKey.HashDescr@@ -22,6 +21,7 @@ import Network.TLS.Context.Internal import Network.TLS.Struct import Network.TLS.Packet (generateCertificateVerify_SSL, encodeSignedDHParams, encodeSignedECDHParams)+import Network.TLS.Parameters (supportedHashSignatures) import Network.TLS.State import Network.TLS.Handshake.State import Network.TLS.Handshake.Key@@ -30,6 +30,25 @@ import Control.Applicative import Control.Monad.State +certificateVerifyCheck :: Context+ -> Version+ -> Maybe HashAndSignatureAlgorithm+ -> Bytes+ -> DigitallySigned+ -> IO Bool+certificateVerifyCheck ctx usedVersion malg msgs dsig = do+ (hashMethod, toVerify) <- prepareCertificateVerifySignatureData ctx usedVersion malg msgs+ signatureVerifyWithHashDescr ctx SignatureRSA hashMethod toVerify dsig++certificateVerifyCreate :: Context+ -> Version+ -> Maybe HashAndSignatureAlgorithm+ -> Bytes+ -> IO DigitallySigned+certificateVerifyCreate ctx usedVersion malg msgs = do+ (hashMethod, toSign) <- prepareCertificateVerifySignatureData ctx usedVersion malg msgs+ signatureCreate ctx malg hashMethod toSign+ getHashAndASN1 :: MonadIO m => (HashAlgorithm, SignatureAlgorithm) -> m HashDescr getHashAndASN1 hashSig = case hashSig of (HashSHA1, SignatureRSA) -> return hashDescrSHA1@@ -47,11 +66,11 @@ prepareCertificateVerifySignatureData ctx usedVersion malg msgs | usedVersion == SSL3 = do Just masterSecret <- usingHState ctx $ gets hstMasterSecret- let digest = generateCertificateVerify_SSL masterSecret (hashUpdate (hashInit hashMD5SHA1) msgs)+ let digest = generateCertificateVerify_SSL masterSecret (hashUpdate (hashInit SHA1_MD5) msgs) hsh = HashDescr id id return (hsh, digest) | usedVersion == TLS10 || usedVersion == TLS11 = do- let hashf bs = hashFinal (hashUpdate (hashInit hashMD5SHA1) bs)+ let hashf bs = hashFinal (hashUpdate (hashInit SHA1_MD5) bs) hsh = HashDescr hashf id return (hsh, msgs) | otherwise = do@@ -65,7 +84,7 @@ Just HashSHA512 -> hashDescrSHA512 Just HashSHA256 -> hashDescrSHA256 Just HashSHA1 -> hashDescrSHA1- Nothing -> HashDescr (hashFinal . hashUpdate (hashInit hashMD5SHA1)) id+ Nothing -> HashDescr (hashFinal . hashUpdate (hashInit SHA1_MD5)) id _ -> error ("unimplemented signature hash type") signatureHashData SignatureDSS mhash = case mhash of@@ -103,14 +122,53 @@ SignatureDSS -> verifyRSA ctx cc hashDescr toVerify bs _ -> error "not implemented yet" -generateSignedDHParams :: Context -> ServerDHParams -> IO Bytes-generateSignedDHParams ctx serverParams = do- (cran, sran) <- usingHState ctx $ do- (,) <$> gets hstClientRandom <*> (fromJust "server random" <$> gets hstServerRandom)- return $ encodeSignedDHParams cran sran serverParams+digitallySignParams :: Context -> Bytes -> SignatureAlgorithm -> IO DigitallySigned+digitallySignParams ctx signatureData sigAlg = do+ usedVersion <- usingState_ ctx getVersion+ let mhash = case usedVersion of+ TLS12 -> case filter ((==) sigAlg . snd) $ supportedHashSignatures $ ctxSupported ctx of+ [] -> error ("no hash signature for " ++ show sigAlg)+ x:_ -> Just (fst x)+ _ -> Nothing+ let hashDescr = signatureHashData sigAlg mhash+ signatureCreate ctx (fmap (\h -> (h, sigAlg)) mhash) hashDescr signatureData -generateSignedECDHParams :: Context -> ServerECDHParams -> IO Bytes-generateSignedECDHParams ctx serverParams = do- (cran, sran) <- usingHState ctx $ do- (,) <$> gets hstClientRandom <*> (fromJust "server random" <$> gets hstServerRandom)- return $ encodeSignedECDHParams cran sran serverParams+digitallySignDHParams :: Context+ -> ServerDHParams+ -> SignatureAlgorithm+ -> IO DigitallySigned+digitallySignDHParams ctx serverParams sigAlg = do+ dhParamsData <- withClientAndServerRandom ctx $ encodeSignedDHParams serverParams+ digitallySignParams ctx dhParamsData sigAlg++digitallySignECDHParams :: Context+ -> ServerECDHParams+ -> SignatureAlgorithm+ -> IO DigitallySigned+digitallySignECDHParams ctx serverParams sigAlg = do+ ecdhParamsData <- withClientAndServerRandom ctx $ encodeSignedECDHParams serverParams+ digitallySignParams ctx ecdhParamsData sigAlg++digitallySignDHParamsVerify :: Context+ -> ServerDHParams+ -> SignatureAlgorithm+ -> DigitallySigned+ -> IO Bool+digitallySignDHParamsVerify ctx dhparams sigAlg signature = do+ expectedData <- withClientAndServerRandom ctx $ encodeSignedDHParams dhparams+ signatureVerify ctx sigAlg expectedData signature++digitallySignECDHParamsVerify :: Context+ -> ServerECDHParams+ -> SignatureAlgorithm+ -> DigitallySigned+ -> IO Bool+digitallySignECDHParamsVerify ctx dhparams sigAlg signature = do+ expectedData <- withClientAndServerRandom ctx $ encodeSignedECDHParams dhparams+ signatureVerify ctx sigAlg expectedData signature++withClientAndServerRandom :: Context -> (ClientRandom -> ServerRandom -> b) -> IO b+withClientAndServerRandom ctx f = do+ (cran, sran) <- usingHState ctx $ (,) <$> gets hstClientRandom+ <*> (fromJust "withClientAndServer : server random" <$> gets hstServerRandom)+ return $ f cran sran
Network/TLS/Handshake/State.hs view
@@ -221,7 +221,7 @@ keyblockSize = cipherKeyBlockSize cipher bulk = cipherBulk cipher- digestSize = if hasMAC (bulkF bulk) then hashSize (cipherHash cipher)+ digestSize = if hasMAC (bulkF bulk) then hashDigestSize (cipherHash cipher) else 0 keySize = bulkKeySize bulk ivSize = bulkIVSize bulk@@ -232,10 +232,10 @@ (cMACSecret, sMACSecret, cWriteKey, sWriteKey, cWriteIV, sWriteIV) = fromJust "p6" $ partition6 kb (digestSize, digestSize, keySize, keySize, ivSize, ivSize) - cstClient = CryptState { cstKey = cWriteKey+ cstClient = CryptState { cstKey = bulkInit bulk (BulkEncrypt `orOnServer` BulkDecrypt) cWriteKey , cstIV = cWriteIV , cstMacSecret = cMACSecret }- cstServer = CryptState { cstKey = sWriteKey+ cstServer = CryptState { cstKey = bulkInit bulk (BulkDecrypt `orOnServer` BulkEncrypt) sWriteKey , cstIV = sWriteIV , cstMacSecret = sMACSecret } msClient = MacState { msSequence = 0 }@@ -254,6 +254,9 @@ , stCompression = hstPendingCompression hst } + orOnServer f g = if cc == ClientRole then f else g++ setServerHelloParameters :: Version -- ^ chosen version -> ServerRandom -> Cipher@@ -266,6 +269,6 @@ , hstPendingCompression = compression , hstHandshakeDigest = updateDigest $ hstHandshakeDigest hst }- where initCtx = if ver < TLS12 then hashMD5SHA1 else hashSHA256- updateDigest (Left bytes) = Right $ foldl hashUpdate initCtx $ reverse bytes+ where hashAlg = if ver < TLS12 then SHA1_MD5 else SHA256+ updateDigest (Left bytes) = Right $ foldl hashUpdate (hashInit hashAlg) $ reverse bytes updateDigest (Right _) = error "cannot initialize digest with another digest"
Network/TLS/MAC.hs view
@@ -6,10 +6,7 @@ -- Portability : unknown -- module Network.TLS.MAC- ( hmacMD5- , hmacSHA1- , hmacSHA256- , macSSL+ ( macSSL , hmac , prf_MD5 , prf_SHA1@@ -17,40 +14,39 @@ , prf_MD5SHA1 ) where -import qualified Crypto.Hash.MD5 as MD5-import qualified Crypto.Hash.SHA1 as SHA1-import qualified Crypto.Hash.SHA256 as SHA256+import Network.TLS.Crypto import qualified Data.ByteString as B import Data.ByteString (ByteString) import Data.Bits (xor) type HMAC = ByteString -> ByteString -> ByteString -macSSL :: (ByteString -> ByteString) -> HMAC-macSSL f secret msg = f $! B.concat [ secret, B.replicate padlen 0x5c,- f $! B.concat [ secret, B.replicate padlen 0x36, msg ] ]- where -- get the type of algorithm out of the digest length by using the hash fct.- padlen = if (B.length $ f B.empty) == 16 then 48 else 40+macSSL :: Hash -> HMAC+macSSL alg secret msg =+ f $! B.concat+ [ secret+ , B.replicate padLen 0x5c+ , f $! B.concat [ secret, B.replicate padLen 0x36, msg ]+ ]+ where+ padLen = case alg of+ MD5 -> 48+ SHA1 -> 40+ _ -> error ("internal error: macSSL called with " ++ show alg)+ f = hash alg -hmac :: (ByteString -> ByteString) -> Int -> HMAC-hmac f bl secret msg =- f $! B.append opad (f $! B.append ipad msg)+hmac :: Hash -> HMAC+hmac alg secret msg = f $! B.append opad (f $! B.append ipad msg) where opad = B.map (xor 0x5c) k' ipad = B.map (xor 0x36) k' + f = hash alg+ bl = hashBlockSize alg+ k' = B.append kt pad where kt = if B.length secret > fromIntegral bl then f secret else secret pad = B.replicate (fromIntegral bl - B.length kt) 0 -hmacMD5 :: HMAC-hmacMD5 secret msg = hmac MD5.hash 64 secret msg--hmacSHA1 :: HMAC-hmacSHA1 secret msg = hmac SHA1.hash 64 secret msg--hmacSHA256 :: HMAC-hmacSHA256 secret msg = hmac SHA256.hash 64 secret msg- hmacIter :: HMAC -> ByteString -> ByteString -> ByteString -> Int -> [ByteString] hmacIter f secret seed aprev len = let an = f secret aprev in@@ -61,10 +57,10 @@ else out : hmacIter f secret seed an (len - digestsize) prf_SHA1 :: ByteString -> ByteString -> Int -> ByteString-prf_SHA1 secret seed len = B.concat $ hmacIter hmacSHA1 secret seed seed len+prf_SHA1 secret seed len = B.concat $ hmacIter (hmac SHA1) secret seed seed len prf_MD5 :: ByteString -> ByteString -> Int -> ByteString-prf_MD5 secret seed len = B.concat $ hmacIter hmacMD5 secret seed seed len+prf_MD5 secret seed len = B.concat $ hmacIter (hmac MD5) secret seed seed len prf_MD5SHA1 :: ByteString -> ByteString -> Int -> ByteString prf_MD5SHA1 secret seed len =@@ -74,4 +70,4 @@ s2 = B.drop (slen `div` 2) secret prf_SHA256 :: ByteString -> ByteString -> Int -> ByteString-prf_SHA256 secret seed len = B.concat $ hmacIter hmacSHA256 secret seed seed len+prf_SHA256 secret seed len = B.concat $ hmacIter (hmac SHA256) secret seed seed len
Network/TLS/Packet.hs view
@@ -77,9 +77,6 @@ import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as BC -import qualified Crypto.Hash.SHA1 as SHA1-import qualified Crypto.Hash.MD5 as MD5- data CurrentParams = CurrentParams { cParamsVersion :: Version -- ^ current protocol version , cParamsKeyXchgType :: Maybe CipherKeyExchangeType -- ^ current key exchange type@@ -486,14 +483,10 @@ putWord8 (valOfType h) >> putWord8 (valOfType s) getServerDHParams :: Get ServerDHParams-getServerDHParams = ServerDHParams <$> getDHParams <*> getDHPublic- where getDHParams = dhParams <$> getInteger16 -- p- <*> getInteger16 -- g- getDHPublic = dhPublic <$> getInteger16 -- y(server)+getServerDHParams = ServerDHParams <$> getBigNum16 <*> getBigNum16 <*> getBigNum16 putServerDHParams :: ServerDHParams -> Put-putServerDHParams (ServerDHParams dhparams dhpub) =- mapM_ putInteger16 $ dhUnwrap dhparams dhpub+putServerDHParams (ServerDHParams p g y) = mapM_ putBigNum16 [p,g,y] getServerECDHParams :: Get ServerECDHParams getServerECDHParams = do@@ -566,8 +559,8 @@ generateMasterSecret_SSL :: Bytes -> ClientRandom -> ServerRandom -> Bytes generateMasterSecret_SSL premasterSecret (ClientRandom c) (ServerRandom s) = B.concat $ map (computeMD5) ["A","BB","CCC"]- where computeMD5 label = MD5.hash $ B.concat [ premasterSecret, computeSHA1 label ]- computeSHA1 label = SHA1.hash $ B.concat [ label, premasterSecret, c, s ]+ where computeMD5 label = hash MD5 $ B.concat [ premasterSecret, computeSHA1 label ]+ computeSHA1 label = hash SHA1 $ B.concat [ label, premasterSecret, c, s ] generateMasterSecret_TLS :: PRF -> Bytes -> ClientRandom -> ServerRandom -> Bytes generateMasterSecret_TLS prf premasterSecret (ClientRandom c) (ServerRandom s) =@@ -589,8 +582,8 @@ generateKeyBlock_SSL (ClientRandom c) (ServerRandom s) mastersecret kbsize = B.concat $ map computeMD5 $ take ((kbsize `div` 16) + 1) labels where labels = [ uncurry BC.replicate x | x <- zip [1..] ['A'..'Z'] ]- computeMD5 label = MD5.hash $ B.concat [ mastersecret, computeSHA1 label ]- computeSHA1 label = SHA1.hash $ B.concat [ label, mastersecret, s, c ]+ computeMD5 label = hash MD5 $ B.concat [ mastersecret, computeSHA1 label ]+ computeSHA1 label = hash SHA1 $ B.concat [ label, mastersecret, s, c ] generateKeyBlock :: Version -> ClientRandom -> ServerRandom -> Bytes -> Int -> Bytes generateKeyBlock SSL2 = generateKeyBlock_SSL@@ -605,8 +598,8 @@ generateFinished_SSL :: Bytes -> Bytes -> HashCtx -> Bytes generateFinished_SSL sender mastersecret hashctx = B.concat [md5hash, sha1hash]- where md5hash = MD5.hash $ B.concat [ mastersecret, pad2, md5left ]- sha1hash = SHA1.hash $ B.concat [ mastersecret, B.take 40 pad2, sha1left ]+ where md5hash = hash MD5 $ B.concat [ mastersecret, pad2, md5left ]+ sha1hash = hash SHA1 $ B.concat [ mastersecret, B.take 40 pad2, sha1left ] lefthash = hashFinal $ flip hashUpdateSSL (pad1, B.take 40 pad1) $ foldl hashUpdate hashctx [sender,mastersecret]@@ -629,13 +622,13 @@ generateCertificateVerify_SSL :: Bytes -> HashCtx -> Bytes generateCertificateVerify_SSL = generateFinished_SSL "" -encodeSignedDHParams :: ClientRandom -> ServerRandom -> ServerDHParams -> Bytes-encodeSignedDHParams cran sran dhparams = runPut $+encodeSignedDHParams :: ServerDHParams -> ClientRandom -> ServerRandom -> Bytes+encodeSignedDHParams dhparams cran sran = runPut $ putClientRandom32 cran >> putServerRandom32 sran >> putServerDHParams dhparams -- Combination of RFC 5246 and 4492 is ambiguous. -- Let's assume ecdhe_rsa and ecdhe_dss are identical to -- dhe_rsa and dhe_dss.-encodeSignedECDHParams :: ClientRandom -> ServerRandom -> ServerECDHParams -> Bytes-encodeSignedECDHParams cran sran dhparams = runPut $+encodeSignedECDHParams :: ServerECDHParams -> ClientRandom -> ServerRandom -> Bytes+encodeSignedECDHParams dhparams cran sran = runPut $ putClientRandom32 cran >> putServerRandom32 sran >> putServerECDHParams dhparams
Network/TLS/Record/Disengage.hs view
@@ -23,6 +23,7 @@ import Network.TLS.Record.State import Network.TLS.Record.Types import Network.TLS.Cipher+import Network.TLS.Crypto import Network.TLS.Compression import Network.TLS.Util import Network.TLS.Wire@@ -68,12 +69,11 @@ return $ cipherDataContent cdata decryptData :: Version -> Record Ciphertext -> Bytes -> RecordState -> RecordM Bytes-decryptData ver record econtent tst = decryptOf (bulkF bulk)+decryptData ver record econtent tst = decryptOf (cstKey cst) where cipher = fromJust "cipher" $ stCipher tst bulk = cipherBulk cipher cst = stCryptState tst- macSize = hashSize $ cipherHash cipher- writekey = cstKey cst+ macSize = hashDigestSize $ cipherHash cipher blockSize = bulkBlockSize bulk econtentLen = B.length econtent @@ -81,18 +81,17 @@ sanityCheckError = throwError (Error_Packet "encrypted content too small for encryption parameters") - decryptOf :: BulkFunctions -> RecordM Bytes- decryptOf (BulkBlockF _ decryptF) = do+ decryptOf :: BulkState -> RecordM Bytes+ decryptOf (BulkStateBlock decryptF) = do let minContent = (if explicitIV then bulkIVSize bulk else 0) + max (macSize + 1) blockSize when ((econtentLen `mod` blockSize) /= 0 || econtentLen < minContent) $ sanityCheckError {- update IV -} (iv, econtent') <- if explicitIV then get2 econtent (bulkIVSize bulk, econtentLen - bulkIVSize bulk) else return (cstIV cst, econtent)- let newiv = fromJust "new iv" $ takelast (bulkBlockSize bulk) econtent'- modify $ \txs -> txs { stCryptState = cst { cstIV = newiv } }+ let (content', iv') = decryptF iv econtent'+ modify $ \txs -> txs { stCryptState = cst { cstIV = iv' } } - let content' = decryptF writekey iv econtent' let paddinglength = fromIntegral (B.last content') + 1 let contentlen = B.length content' - paddinglength - macSize (content, mac, padding) <- get3 content' (contentlen, macSize, paddinglength)@@ -102,20 +101,20 @@ , cipherDataPadding = Just padding } - decryptOf (BulkStreamF initF _ decryptF) = do+ decryptOf (BulkStateStream (BulkStream decryptF)) = do when (econtentLen < macSize) $ sanityCheckError- let (content', newiv) = decryptF (if cstIV cst /= B.empty then cstIV cst else initF writekey) econtent+ let (content', bulkStream') = decryptF econtent {- update Ctx -} let contentlen = B.length content' - macSize (content, mac) <- get2 content' (contentlen, macSize)- modify $ \txs -> txs { stCryptState = cst { cstIV = newiv } }+ modify $ \txs -> txs { stCryptState = cst { cstKey = BulkStateStream bulkStream' } } getCipherData record $ CipherData { cipherDataContent = content , cipherDataMAC = Just mac , cipherDataPadding = Nothing } - decryptOf (BulkAeadF _ decryptF) = do+ decryptOf (BulkStateAEAD decryptF) = do let authtaglen = 16 -- FIXME: fixed_iv_length + record_iv_length nonceexplen = 8 -- FIXME: record_iv_length econtentlen = B.length econtent - authtaglen - nonceexplen@@ -125,13 +124,16 @@ hdr = Header typ v $ fromIntegral econtentlen ad = B.concat [ encodedSeq, encodeHeader hdr ] nonce = cstIV (stCryptState tst) `B.append` enonce- (content, authTag2) = decryptF writekey nonce econtent' ad+ (content, authTag2) = decryptF nonce econtent' ad when (AuthTag authTag /= authTag2) $ throwError $ Error_Protocol ("bad record mac", True, BadRecordMac) modify incrRecordState return content++ decryptOf BulkStateUninitialized =+ throwError $ Error_Protocol ("decrypt state uninitialized", True, InternalError) get3 s ls = maybe (throwError $ Error_Packet "record bad format") return $ partition3 s ls get2 s (d1,d2) = get3 s (d1,d2,0) >>= \(r1,r2,_) -> return (r1,r2)
Network/TLS/Record/Engage.hs view
@@ -8,6 +8,7 @@ -- Engage a record into the Record layer. -- The record is compressed, added some integrity field, then encrypted. --+{-# LANGUAGE BangPatterns #-} module Network.TLS.Record.Engage ( engageRecord ) where@@ -21,7 +22,6 @@ import Network.TLS.Record.Types import Network.TLS.Cipher import Network.TLS.Compression-import Network.TLS.Util import Network.TLS.Wire import Network.TLS.Packet import Data.ByteString (ByteString)@@ -48,22 +48,23 @@ encryptContent :: Record Compressed -> ByteString -> RecordM ByteString encryptContent record content = do+ cst <- getCryptState bulk <- getBulk- case bulkF bulk of- BulkBlockF encryptF _ -> do+ case cstKey cst of+ BulkStateBlock encryptF -> do digest <- makeDigest (recordToHeader record) content let content' = B.concat [content, digest] encryptBlock encryptF content' bulk- BulkStreamF initF encryptF _ -> do+ BulkStateStream encryptF -> do digest <- makeDigest (recordToHeader record) content let content' = B.concat [content, digest]- encryptStream encryptF content' initF- BulkAeadF encryptF _ ->+ encryptStream encryptF content'+ BulkStateAEAD encryptF -> encryptAead encryptF content record+ BulkStateUninitialized ->+ return content -encryptBlock :: (Key -> IV -> ByteString -> ByteString)- -> ByteString -> Bulk- -> RecordM ByteString+encryptBlock :: BulkBlock -> ByteString -> Bulk -> RecordM ByteString encryptBlock encryptF content bulk = do cst <- getCryptState ver <- getRecordVersion@@ -76,26 +77,22 @@ else B.empty - let e = encryptF (cstKey cst) (cstIV cst) $ B.concat [ content, padding ]+ let (e, iv') = encryptF (cstIV cst) $ B.concat [ content, padding ] if hasExplicitBlockIV ver then return $ B.concat [cstIV cst,e] else do- let newiv = fromJust "new iv" $ takelast (bulkIVSize bulk) e- modify $ \tstate -> tstate { stCryptState = cst { cstIV = newiv } }+ modify $ \tstate -> tstate { stCryptState = cst { cstIV = iv' } } return e -encryptStream :: (IV -> ByteString -> (ByteString, IV))- -> ByteString -> (Key -> IV)- -> RecordM ByteString-encryptStream encryptF content initF = do+encryptStream :: BulkStream -> ByteString -> RecordM ByteString+encryptStream (BulkStream encryptF) content = do cst <- getCryptState- let iv = cstIV cst- (e, newiv) = encryptF (if iv /= B.empty then iv else initF (cstKey cst)) content- modify $ \tstate -> tstate { stCryptState = cst { cstIV = newiv } }+ let (!e, !newBulkStream) = encryptF content+ modify $ \tstate -> tstate { stCryptState = cst { cstKey = BulkStateStream newBulkStream } } return e -encryptAead :: (Key -> Nonce -> ByteString -> AdditionalData -> (ByteString, AuthTag))+encryptAead :: BulkAEAD -> ByteString -> Record Compressed -> RecordM ByteString encryptAead encryptF content record = do@@ -108,7 +105,7 @@ processorNum = encodeWord32 1 -- FIXME counter = B.drop 4 encodedSeq -- FIXME: probably OK nonce = B.concat [salt, processorNum, counter]- let (e, AuthTag authtag) = encryptF (cstKey cst) nonce content ad+ let (e, AuthTag authtag) = encryptF nonce content ad modify incrRecordState return $ B.concat [processorNum, counter, e, authtag]
Network/TLS/Record/State.hs view
@@ -41,7 +41,7 @@ import qualified Data.ByteString as B data CryptState = CryptState- { cstKey :: !Bytes+ { cstKey :: !BulkState , cstIV :: !Bytes , cstMacSecret :: !Bytes } deriving (Show)@@ -99,7 +99,7 @@ newRecordState = RecordState { stCipher = Nothing , stCompression = nullCompression- , stCryptState = CryptState B.empty B.empty B.empty+ , stCryptState = CryptState BulkStateUninitialized B.empty B.empty , stMacState = MacState 0 } @@ -122,12 +122,12 @@ where digest = macF (cstMacSecret cst) msg cst = stCryptState tstate cipher = fromJust "cipher" $ stCipher tstate- hashf = hashF $ cipherHash cipher+ hashA = cipherHash cipher encodedSeq = encodeWord64 $ msSequence $ stMacState tstate (macF, msg)- | ver < TLS10 = (macSSL hashf, B.concat [ encodedSeq, encodeHeaderNoVer hdr, content ])- | otherwise = (hmac hashf 64, B.concat [ encodedSeq, encodeHeader hdr, content ])+ | ver < TLS10 = (macSSL hashA, B.concat [ encodedSeq, encodeHeaderNoVer hdr, content ])+ | otherwise = (hmac hashA, B.concat [ encodedSeq, encodeHeader hdr, content ]) makeDigest :: Header -> Bytes -> RecordM Bytes makeDigest hdr content = do
Network/TLS/Struct.hs view
@@ -27,7 +27,13 @@ , TLSError(..) , TLSException(..) , DistinguishedName+ , BigNum(..)+ , bigNumToInteger+ , bigNumFromInteger , ServerDHParams(..)+ , serverDHParamsToParams+ , serverDHParamsToPublic+ , serverDHParamsFrom , ServerECDHParams(..) , ServerRSAParams(..) , ServerKeyXchgAlgorithmData(..)@@ -64,6 +70,7 @@ import Network.TLS.Types import Network.TLS.Crypto.DH import Network.TLS.Crypto.ECDH+import Network.TLS.Util.Serialization #if MIN_VERSION_mtl(2,2,1) #else import Control.Monad.Error@@ -234,8 +241,35 @@ | HandshakeType_NPN -- Next Protocol Negotiation extension deriving (Show,Eq) -data ServerDHParams = ServerDHParams DHParams {- (p,g) -} DHPublic {- y -}+newtype BigNum = BigNum Bytes deriving (Show,Eq)++bigNumToInteger :: BigNum -> Integer+bigNumToInteger (BigNum b) = os2ip b++bigNumFromInteger :: Integer -> BigNum+bigNumFromInteger i = BigNum $ i2osp i++data ServerDHParams = ServerDHParams+ { serverDHParams_p :: BigNum+ , serverDHParams_g :: BigNum+ , serverDHParams_y :: BigNum+ } deriving (Show,Eq)++serverDHParamsFrom :: DHParams -> DHPublic -> ServerDHParams+serverDHParamsFrom params dhPub =+ ServerDHParams (bigNumFromInteger $ dhParamsGetP params)+ (bigNumFromInteger $ dhParamsGetG params)+ (bigNumFromInteger $ dhUnwrapPublic dhPub)++serverDHParamsToParams :: ServerDHParams -> DHParams+serverDHParamsToParams serverParams =+ dhParams (bigNumToInteger $ serverDHParams_p serverParams)+ (bigNumToInteger $ serverDHParams_g serverParams)++serverDHParamsToPublic :: ServerDHParams -> DHPublic+serverDHParamsToPublic serverParams =+ dhPublic (bigNumToInteger $ serverDHParams_y serverParams) data ServerECDHParams = ServerECDHParams ECDHParams ECDHPublic deriving (Show,Eq)
Network/TLS/Wire.hs view
@@ -27,6 +27,7 @@ , getOpaque16 , getOpaque24 , getInteger16+ , getBigNum16 , getList , processBytes , isEmpty@@ -42,6 +43,7 @@ , putOpaque16 , putOpaque24 , putInteger16+ , putBigNum16 , encodeWord16 , encodeWord32 , encodeWord64@@ -114,6 +116,9 @@ getInteger16 :: Get Integer getInteger16 = os2ip <$> getOpaque16 +getBigNum16 :: Get BigNum+getBigNum16 = BigNum <$> getOpaque16+ getList :: Int -> (Get (Int, a)) -> Get [a] getList totalLen getElement = isolate totalLen (getElements totalLen) where getElements len@@ -161,6 +166,9 @@ putInteger16 :: Integer -> Put putInteger16 = putOpaque16 . i2osp++putBigNum16 :: BigNum -> Put+putBigNum16 (BigNum b) = putOpaque16 b encodeWord16 :: Word16 -> Bytes encodeWord16 = runPut . putWord16
Tests/Ciphers.hs view
@@ -29,15 +29,20 @@ propertyBulkFunctional :: BulkTest -> Bool propertyBulkFunctional (BulkTest bulk key iv t additional) =- case bulkF bulk of- BulkBlockF enc dec -> block enc dec- BulkStreamF ktoi enc dec -> stream ktoi enc dec- BulkAeadF enc dec -> aead enc dec+ let enc = bulkInit bulk BulkEncrypt key+ dec = bulkInit bulk BulkDecrypt key+ in case (enc, dec) of+ (BulkStateBlock encF, BulkStateBlock decF) -> block encF decF+ (BulkStateAEAD encF, BulkStateAEAD decF) -> aead encF decF+ (BulkStateStream (BulkStream encF), BulkStateStream (BulkStream decF)) -> stream encF decF+ _ -> True where- block e d = (d key iv . e key iv) t == t- stream ktoi e d = (fst . d siv . fst . e siv) t == t- where siv = ktoi key+ block e d =+ let (etxt, e_iv) = e iv t+ (dtxt, d_iv) = d iv etxt+ in dtxt == t && d_iv == e_iv+ stream e d = (fst . d . fst . e) t == t aead e d =- let (encrypted, at) = e key iv t additional- (decrypted, at2) = d key iv encrypted additional+ let (encrypted, at) = e iv t additional+ (decrypted, at2) = d iv encrypted additional in decrypted == t && at == at2
Tests/Connection.hs view
@@ -34,13 +34,9 @@ , bulkKeySize = 16 , bulkIVSize = 16 , bulkBlockSize = 16- , bulkF = BulkBlockF (\_ _ m -> m) (\_ _ m -> m)- }- , cipherHash = Hash- { hashName = "const-hash"- , hashSize = 16- , hashF = (\_ -> B.replicate 16 1)+ , bulkF = BulkBlockF $ \_ _ _ -> (\m -> (m, B.empty)) }+ , cipherHash = MD5 , cipherKeyExchange = CipherKeyExchange_RSA , cipherMinVer = Nothing }@@ -67,9 +63,11 @@ , bulkKeySize = 16 , bulkIVSize = 0 , bulkBlockSize = 0- , bulkF = BulkStreamF (\k -> k) (\i m -> (m,i)) (\i m -> (m,i))+ , bulkF = BulkStreamF passThrough } }+ where+ passThrough _ _ = BulkStream go where go inp = (inp, BulkStream go) knownCiphers :: [Cipher] knownCiphers = [blockCipher,blockCipherDHE_RSA,blockCipherDHE_DSS,streamCipher]
tls.cabal view
@@ -1,5 +1,5 @@ Name: tls-Version: 1.2.17+Version: 1.2.18 Description: Native Haskell TLS and SSL protocol implementation for server and client. .