555 lines
22 KiB
Haskell
555 lines
22 KiB
Haskell
{-# LANGUAGE OverloadedStrings #-}
|
|
-- |
|
|
-- Module : Network.TLS.Packet
|
|
-- License : BSD-style
|
|
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
|
|
-- Stability : experimental
|
|
-- Portability : unknown
|
|
--
|
|
-- the Packet module contains everything necessary to serialize and deserialize things
|
|
-- with only explicit parameters, no TLS state is involved here.
|
|
--
|
|
module Network.TLS.Packet
|
|
(
|
|
-- * params for encoding and decoding
|
|
CurrentParams(..)
|
|
-- * marshall functions for header messages
|
|
, decodeHeader
|
|
, decodeDeprecatedHeaderLength
|
|
, decodeDeprecatedHeader
|
|
, encodeHeader
|
|
, encodeHeaderNoVer -- use for SSL3
|
|
|
|
-- * marshall functions for alert messages
|
|
, decodeAlert
|
|
, decodeAlerts
|
|
, encodeAlerts
|
|
|
|
-- * marshall functions for handshake messages
|
|
, decodeHandshakes
|
|
, decodeHandshake
|
|
, decodeDeprecatedHandshake
|
|
, encodeHandshake
|
|
, encodeHandshakes
|
|
, encodeHandshakeHeader
|
|
, encodeHandshakeContent
|
|
|
|
-- * marshall functions for change cipher spec message
|
|
, decodeChangeCipherSpec
|
|
, encodeChangeCipherSpec
|
|
|
|
, decodePreMasterSecret
|
|
, encodePreMasterSecret
|
|
|
|
-- * generate things for packet content
|
|
, generateMasterSecret
|
|
, generateKeyBlock
|
|
, generateClientFinished
|
|
, generateServerFinished
|
|
|
|
, generateCertificateVerify_SSL
|
|
) where
|
|
|
|
import Network.TLS.Struct
|
|
import Network.TLS.Wire
|
|
import Network.TLS.Cap
|
|
import Data.Maybe (fromJust)
|
|
import Data.Word
|
|
import Data.Bits ((.|.))
|
|
import Control.Applicative ((<$>))
|
|
import Control.Monad
|
|
import Data.ASN1.Types (fromASN1, toASN1)
|
|
import Data.ASN1.Encoding (decodeASN1', encodeASN1')
|
|
import Data.ASN1.BinaryEncoding (DER(..))
|
|
import Data.X509 (CertificateChainRaw(..), encodeCertificateChain, decodeCertificateChain)
|
|
import Network.TLS.Crypto
|
|
import Network.TLS.MAC
|
|
import Network.TLS.Cipher (CipherKeyExchangeType(..))
|
|
import Data.ByteString (ByteString)
|
|
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 :: CipherKeyExchangeType -- ^ current key exchange type
|
|
, cParamsSupportNPN :: Bool -- ^ support Next Protocol Negotiation extension
|
|
} deriving (Show,Eq)
|
|
|
|
{- marshall helpers -}
|
|
getVersion :: Get Version
|
|
getVersion = do
|
|
major <- getWord8
|
|
minor <- getWord8
|
|
case verOfNum (major, minor) of
|
|
Nothing -> fail ("invalid version : " ++ show major ++ "," ++ show minor)
|
|
Just v -> return v
|
|
|
|
putVersion :: Version -> Put
|
|
putVersion ver = putWord8 major >> putWord8 minor
|
|
where (major, minor) = numericalVer ver
|
|
|
|
getHeaderType :: Get ProtocolType
|
|
getHeaderType = do
|
|
ty <- getWord8
|
|
case valToType ty of
|
|
Nothing -> fail ("invalid header type: " ++ show ty)
|
|
Just t -> return t
|
|
|
|
putHeaderType :: ProtocolType -> Put
|
|
putHeaderType = putWord8 . valOfType
|
|
|
|
getHandshakeType :: Get HandshakeType
|
|
getHandshakeType = do
|
|
ty <- getWord8
|
|
case valToType ty of
|
|
Nothing -> fail ("invalid handshake type: " ++ show ty)
|
|
Just t -> return t
|
|
|
|
{-
|
|
- decode and encode headers
|
|
-}
|
|
decodeHeader :: ByteString -> Either TLSError Header
|
|
decodeHeader = runGetErr "header" $ liftM3 Header getHeaderType getVersion getWord16
|
|
|
|
decodeDeprecatedHeaderLength :: ByteString -> Either TLSError Word16
|
|
decodeDeprecatedHeaderLength = runGetErr "deprecatedheaderlength" $ subtract 0x8000 <$> getWord16
|
|
|
|
decodeDeprecatedHeader :: Word16 -> ByteString -> Either TLSError Header
|
|
decodeDeprecatedHeader size =
|
|
runGetErr "deprecatedheader" $ do
|
|
1 <- getWord8
|
|
version <- getVersion
|
|
return $ Header ProtocolType_DeprecatedHandshake version size
|
|
|
|
encodeHeader :: Header -> ByteString
|
|
encodeHeader (Header pt ver len) = runPut (putHeaderType pt >> putVersion ver >> putWord16 len)
|
|
{- FIXME check len <= 2^14 -}
|
|
|
|
encodeHeaderNoVer :: Header -> ByteString
|
|
encodeHeaderNoVer (Header pt _ len) = runPut (putHeaderType pt >> putWord16 len)
|
|
{- FIXME check len <= 2^14 -}
|
|
|
|
{-
|
|
- decode and encode ALERT
|
|
-}
|
|
decodeAlert :: Get (AlertLevel, AlertDescription)
|
|
decodeAlert = do
|
|
al <- getWord8
|
|
ad <- getWord8
|
|
case (valToType al, valToType ad) of
|
|
(Just a, Just d) -> return (a, d)
|
|
(Nothing, _) -> fail "cannot decode alert level"
|
|
(_, Nothing) -> fail "cannot decode alert description"
|
|
|
|
decodeAlerts :: ByteString -> Either TLSError [(AlertLevel, AlertDescription)]
|
|
decodeAlerts = runGetErr "alerts" $ loop
|
|
where loop = do
|
|
r <- remaining
|
|
if r == 0
|
|
then return []
|
|
else liftM2 (:) decodeAlert loop
|
|
|
|
encodeAlerts :: [(AlertLevel, AlertDescription)] -> ByteString
|
|
encodeAlerts l = runPut $ mapM_ encodeAlert l
|
|
where encodeAlert (al, ad) = putWord8 (valOfType al) >> putWord8 (valOfType ad)
|
|
|
|
{- decode and encode HANDSHAKE -}
|
|
decodeHandshakeHeader :: Get (HandshakeType, Bytes)
|
|
decodeHandshakeHeader = do
|
|
ty <- getHandshakeType
|
|
content <- getOpaque24
|
|
return (ty, content)
|
|
|
|
decodeHandshakes :: ByteString -> Either TLSError [(HandshakeType, Bytes)]
|
|
decodeHandshakes b = runGetErr "handshakes" getAll b where
|
|
getAll = do
|
|
x <- decodeHandshakeHeader
|
|
empty <- isEmpty
|
|
if empty
|
|
then return [x]
|
|
else liftM ((:) x) getAll
|
|
|
|
decodeHandshake :: CurrentParams -> HandshakeType -> ByteString -> Either TLSError Handshake
|
|
decodeHandshake cp ty = runGetErr "handshake" $ case ty of
|
|
HandshakeType_HelloRequest -> decodeHelloRequest
|
|
HandshakeType_ClientHello -> decodeClientHello
|
|
HandshakeType_ServerHello -> decodeServerHello
|
|
HandshakeType_Certificate -> decodeCertificates
|
|
HandshakeType_ServerKeyXchg -> decodeServerKeyXchg cp
|
|
HandshakeType_CertRequest -> decodeCertRequest cp
|
|
HandshakeType_ServerHelloDone -> decodeServerHelloDone
|
|
HandshakeType_CertVerify -> decodeCertVerify cp
|
|
HandshakeType_ClientKeyXchg -> decodeClientKeyXchg
|
|
HandshakeType_Finished -> decodeFinished
|
|
HandshakeType_NPN -> do
|
|
unless (cParamsSupportNPN cp) $ fail "unsupported handshake type"
|
|
decodeNextProtocolNegotiation
|
|
|
|
decodeDeprecatedHandshake :: ByteString -> Either TLSError Handshake
|
|
decodeDeprecatedHandshake b = runGetErr "deprecatedhandshake" getDeprecated b where
|
|
getDeprecated = do
|
|
1 <- getWord8
|
|
ver <- getVersion
|
|
cipherSpecLen <- fromEnum <$> getWord16
|
|
sessionIdLen <- fromEnum <$> getWord16
|
|
challengeLen <- fromEnum <$> getWord16
|
|
ciphers <- getCipherSpec cipherSpecLen
|
|
session <- getSessionId sessionIdLen
|
|
random <- getChallenge challengeLen
|
|
let compressions = [0]
|
|
return $ ClientHello ver random session ciphers compressions [] (Just b)
|
|
getCipherSpec len | len < 3 = return []
|
|
getCipherSpec len = do
|
|
[c0,c1,c2] <- map fromEnum <$> replicateM 3 getWord8
|
|
([ toEnum $ c1 * 0x100 + c2 | c0 == 0 ] ++) <$> getCipherSpec (len - 3)
|
|
getSessionId 0 = return $ Session Nothing
|
|
getSessionId len = Session . Just <$> getBytes len
|
|
getChallenge len | 32 < len = getBytes (len - 32) >> getChallenge 32
|
|
getChallenge len = ClientRandom . B.append (B.replicate (32 - len) 0) <$> getBytes len
|
|
|
|
decodeHelloRequest :: Get Handshake
|
|
decodeHelloRequest = return HelloRequest
|
|
|
|
decodeClientHello :: Get Handshake
|
|
decodeClientHello = do
|
|
ver <- getVersion
|
|
random <- getClientRandom32
|
|
session <- getSession
|
|
ciphers <- getWords16
|
|
compressions <- getWords8
|
|
r <- remaining
|
|
exts <- if hasHelloExtensions ver && r > 0
|
|
then fmap fromIntegral getWord16 >>= getExtensions
|
|
else return []
|
|
return $ ClientHello ver random session ciphers compressions exts Nothing
|
|
|
|
decodeServerHello :: Get Handshake
|
|
decodeServerHello = do
|
|
ver <- getVersion
|
|
random <- getServerRandom32
|
|
session <- getSession
|
|
cipherid <- getWord16
|
|
compressionid <- getWord8
|
|
r <- remaining
|
|
exts <- if hasHelloExtensions ver && r > 0
|
|
then fmap fromIntegral getWord16 >>= getExtensions
|
|
else return []
|
|
return $ ServerHello ver random session cipherid compressionid exts
|
|
|
|
decodeServerHelloDone :: Get Handshake
|
|
decodeServerHelloDone = return ServerHelloDone
|
|
|
|
decodeCertificates :: Get Handshake
|
|
decodeCertificates = do
|
|
certsRaw <- CertificateChainRaw <$> (getWord24 >>= \len -> getList (fromIntegral len) getCertRaw)
|
|
case decodeCertificateChain certsRaw of
|
|
Left (i, s) -> fail ("error certificate parsing " ++ show i ++ ":" ++ s)
|
|
Right cc -> return $ Certificates cc
|
|
where getCertRaw = getOpaque24 >>= \cert -> return (3 + B.length cert, cert)
|
|
|
|
decodeFinished :: Get Handshake
|
|
decodeFinished = Finished <$> (remaining >>= getBytes)
|
|
|
|
decodeNextProtocolNegotiation :: Get Handshake
|
|
decodeNextProtocolNegotiation = do
|
|
opaque <- getOpaque8
|
|
_ <- getOpaque8 -- ignore padding
|
|
return $ HsNextProtocolNegotiation opaque
|
|
|
|
getSignatureHashAlgorithm :: Get HashAndSignatureAlgorithm
|
|
getSignatureHashAlgorithm = do
|
|
h <- fromJust . valToType <$> getWord8
|
|
s <- fromJust . valToType <$> getWord8
|
|
return (h,s)
|
|
|
|
decodeCertRequest :: CurrentParams -> Get Handshake
|
|
decodeCertRequest cp = do
|
|
certTypes <- map (fromJust . valToType . fromIntegral) <$> getWords8
|
|
|
|
sigHashAlgs <- if cParamsVersion cp >= TLS12
|
|
then Just <$> (getWord16 >>= getSignatureHashAlgorithms)
|
|
else return Nothing
|
|
dNameLen <- getWord16
|
|
-- FIXME: Decide whether to remove this check completely or to make it an option.
|
|
-- when (cParamsVersion cp < TLS12 && dNameLen < 3) $ fail "certrequest distinguishname not of the correct size"
|
|
dNames <- getList (fromIntegral dNameLen) getDName
|
|
return $ CertRequest certTypes sigHashAlgs dNames
|
|
where
|
|
getSignatureHashAlgorithms len = getList (fromIntegral len) (getSignatureHashAlgorithm >>= \sh -> return (2, sh))
|
|
getDName = do
|
|
dName <- getOpaque16
|
|
when (B.length dName == 0) $ fail "certrequest: invalid DN length"
|
|
dn <- case decodeASN1' DER dName of
|
|
Left e -> fail ("cert request decoding DistinguishedName ASN1 failed: " ++ show e)
|
|
Right asn1s -> case fromASN1 asn1s of
|
|
Left e -> fail ("cert request parsing DistinguishedName ASN1 failed: " ++ show e)
|
|
Right (d,_) -> return d
|
|
return (2 + B.length dName, dn)
|
|
|
|
decodeCertVerify :: CurrentParams -> Get Handshake
|
|
decodeCertVerify cp = do
|
|
mbHashSig <- if cParamsVersion cp >= TLS12
|
|
then Just <$> getSignatureHashAlgorithm
|
|
else return Nothing
|
|
bs <- getOpaque16
|
|
return $ CertVerify mbHashSig (CertVerifyData bs)
|
|
|
|
decodeClientKeyXchg :: Get Handshake
|
|
decodeClientKeyXchg = ClientKeyXchg <$> (remaining >>= getBytes)
|
|
|
|
os2ip :: ByteString -> Integer
|
|
os2ip = B.foldl' (\a b -> (256 * a) .|. (fromIntegral b)) 0
|
|
|
|
decodeServerKeyXchg_DH :: Get ServerDHParams
|
|
decodeServerKeyXchg_DH = do
|
|
p <- getOpaque16
|
|
g <- getOpaque16
|
|
y <- getOpaque16
|
|
return $ ServerDHParams { dh_p = os2ip p, dh_g = os2ip g, dh_Ys = os2ip y }
|
|
|
|
decodeServerKeyXchg_RSA :: Get ServerRSAParams
|
|
decodeServerKeyXchg_RSA = do
|
|
modulus <- getOpaque16
|
|
expo <- getOpaque16
|
|
return $ ServerRSAParams { rsa_modulus = os2ip modulus, rsa_exponent = os2ip expo }
|
|
|
|
decodeServerKeyXchg :: CurrentParams -> Get Handshake
|
|
decodeServerKeyXchg cp = ServerKeyXchg <$> case cParamsKeyXchgType cp of
|
|
CipherKeyExchange_RSA -> SKX_RSA . Just <$> decodeServerKeyXchg_RSA
|
|
CipherKeyExchange_DH_Anon -> SKX_DH_Anon <$> decodeServerKeyXchg_DH
|
|
CipherKeyExchange_DHE_RSA -> do
|
|
dhparams <- decodeServerKeyXchg_DH
|
|
signature <- getOpaque16
|
|
return $ SKX_DHE_RSA dhparams (B.unpack signature)
|
|
CipherKeyExchange_DHE_DSS -> do
|
|
dhparams <- decodeServerKeyXchg_DH
|
|
signature <- getOpaque16
|
|
return $ SKX_DHE_DSS dhparams (B.unpack signature)
|
|
_ -> do
|
|
bs <- remaining >>= getBytes
|
|
return $ SKX_Unknown bs
|
|
|
|
encodeHandshake :: Handshake -> ByteString
|
|
encodeHandshake o =
|
|
let content = runPut $ encodeHandshakeContent o in
|
|
let len = fromIntegral $ B.length content in
|
|
let header = case o of
|
|
ClientHello _ _ _ _ _ _ (Just _) -> "" -- SSLv2 ClientHello message
|
|
_ -> runPut $ encodeHandshakeHeader (typeOfHandshake o) len in
|
|
B.concat [ header, content ]
|
|
|
|
encodeHandshakes :: [Handshake] -> ByteString
|
|
encodeHandshakes hss = B.concat $ map encodeHandshake hss
|
|
|
|
encodeHandshakeHeader :: HandshakeType -> Int -> Put
|
|
encodeHandshakeHeader ty len = putWord8 (valOfType ty) >> putWord24 len
|
|
|
|
encodeHandshakeContent :: Handshake -> Put
|
|
|
|
encodeHandshakeContent (ClientHello _ _ _ _ _ _ (Just deprecated)) = do
|
|
putBytes deprecated
|
|
encodeHandshakeContent (ClientHello version random session cipherIDs compressionIDs exts Nothing) = do
|
|
putVersion version
|
|
putClientRandom32 random
|
|
putSession session
|
|
putWords16 cipherIDs
|
|
putWords8 compressionIDs
|
|
putExtensions exts
|
|
return ()
|
|
|
|
encodeHandshakeContent (ServerHello version random session cipherID compressionID exts) =
|
|
putVersion version >> putServerRandom32 random >> putSession session
|
|
>> putWord16 cipherID >> putWord8 compressionID
|
|
>> putExtensions exts >> return ()
|
|
|
|
encodeHandshakeContent (Certificates cc) = putOpaque24 (runPut $ mapM_ putOpaque24 certs)
|
|
where (CertificateChainRaw certs) = encodeCertificateChain cc
|
|
|
|
encodeHandshakeContent (ClientKeyXchg content) = do
|
|
putBytes content
|
|
|
|
encodeHandshakeContent (ServerKeyXchg _) = do
|
|
-- FIXME
|
|
return ()
|
|
|
|
encodeHandshakeContent (HelloRequest) = return ()
|
|
encodeHandshakeContent (ServerHelloDone) = return ()
|
|
|
|
encodeHandshakeContent (CertRequest certTypes sigAlgs certAuthorities) = do
|
|
putWords8 (map valOfType certTypes)
|
|
case sigAlgs of
|
|
Nothing -> return ()
|
|
Just l -> putWords16 $ map (\(x,y) -> (fromIntegral $ valOfType x) * 256 + (fromIntegral $ valOfType y)) l
|
|
encodeCertAuthorities certAuthorities
|
|
where
|
|
-- Convert a distinguished name to its DER encoding.
|
|
encodeCA dn = return $ encodeASN1' DER (toASN1 dn []) --B.concat $ L.toChunks $ encodeDN dn
|
|
|
|
-- Encode a list of distinguished names.
|
|
encodeCertAuthorities certAuths = do
|
|
enc <- mapM encodeCA certAuths
|
|
let totLength = sum $ map (((+) 2) . B.length) enc
|
|
putWord16 (fromIntegral totLength)
|
|
mapM_ (\ b -> putWord16 (fromIntegral (B.length b)) >> putBytes b) enc
|
|
|
|
encodeHandshakeContent (CertVerify mbHashSig (CertVerifyData c)) = do
|
|
-- TLS 1.2 prepends the hash and signature algorithms to the
|
|
-- signature.
|
|
case mbHashSig of
|
|
Nothing -> return ()
|
|
Just (h, s) -> putWord16 $ (fromIntegral $ valOfType h) * 256 + (fromIntegral $ valOfType s)
|
|
putWord16 (fromIntegral $ B.length c)
|
|
putBytes c
|
|
|
|
|
|
encodeHandshakeContent (Finished opaque) = putBytes opaque
|
|
|
|
encodeHandshakeContent (HsNextProtocolNegotiation protocol) = do
|
|
putOpaque8 protocol
|
|
putOpaque8 $ B.replicate paddingLen 0
|
|
where paddingLen = 32 - ((B.length protocol + 2) `mod` 32)
|
|
|
|
{- FIXME make sure it return error if not 32 available -}
|
|
getRandom32 :: Get Bytes
|
|
getRandom32 = getBytes 32
|
|
|
|
getServerRandom32 :: Get ServerRandom
|
|
getServerRandom32 = ServerRandom <$> getRandom32
|
|
|
|
getClientRandom32 :: Get ClientRandom
|
|
getClientRandom32 = ClientRandom <$> getRandom32
|
|
|
|
putRandom32 :: Bytes -> Put
|
|
putRandom32 = putBytes
|
|
|
|
putClientRandom32 :: ClientRandom -> Put
|
|
putClientRandom32 (ClientRandom r) = putRandom32 r
|
|
|
|
putServerRandom32 :: ServerRandom -> Put
|
|
putServerRandom32 (ServerRandom r) = putRandom32 r
|
|
|
|
getSession :: Get Session
|
|
getSession = do
|
|
len8 <- getWord8
|
|
case fromIntegral len8 of
|
|
0 -> return $ Session Nothing
|
|
len -> Session . Just <$> getBytes len
|
|
|
|
putSession :: Session -> Put
|
|
putSession (Session Nothing) = putWord8 0
|
|
putSession (Session (Just s)) = putOpaque8 s
|
|
|
|
getExtensions :: Int -> Get [ExtensionRaw]
|
|
getExtensions 0 = return []
|
|
getExtensions len = do
|
|
extty <- getWord16
|
|
extdatalen <- getWord16
|
|
extdata <- getBytes $ fromIntegral extdatalen
|
|
extxs <- getExtensions (len - fromIntegral extdatalen - 4)
|
|
return $ (extty, extdata) : extxs
|
|
|
|
putExtension :: ExtensionRaw -> Put
|
|
putExtension (ty, l) = putWord16 ty >> putOpaque16 l
|
|
|
|
putExtensions :: [ExtensionRaw] -> Put
|
|
putExtensions [] = return ()
|
|
putExtensions es = putOpaque16 (runPut $ mapM_ putExtension es)
|
|
|
|
{-
|
|
- decode and encode ALERT
|
|
-}
|
|
|
|
decodeChangeCipherSpec :: ByteString -> Either TLSError ()
|
|
decodeChangeCipherSpec = runGetErr "changecipherspec" $ do
|
|
x <- getWord8
|
|
when (x /= 1) (fail "unknown change cipher spec content")
|
|
|
|
encodeChangeCipherSpec :: ByteString
|
|
encodeChangeCipherSpec = runPut (putWord8 1)
|
|
|
|
-- rsa pre master secret
|
|
decodePreMasterSecret :: Bytes -> Either TLSError (Version, Bytes)
|
|
decodePreMasterSecret = runGetErr "pre-master-secret" $ do
|
|
liftM2 (,) getVersion (getBytes 46)
|
|
|
|
encodePreMasterSecret :: Version -> Bytes -> Bytes
|
|
encodePreMasterSecret version bytes = runPut (putVersion version >> putBytes bytes)
|
|
|
|
{-
|
|
- generate things for packet content
|
|
-}
|
|
type PRF = Bytes -> Bytes -> Int -> Bytes
|
|
|
|
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 ]
|
|
|
|
generateMasterSecret_TLS :: PRF -> Bytes -> ClientRandom -> ServerRandom -> Bytes
|
|
generateMasterSecret_TLS prf premasterSecret (ClientRandom c) (ServerRandom s) =
|
|
prf premasterSecret seed 48
|
|
where
|
|
seed = B.concat [ "master secret", c, s ]
|
|
|
|
generateMasterSecret :: Version -> Bytes -> ClientRandom -> ServerRandom -> Bytes
|
|
generateMasterSecret SSL2 = generateMasterSecret_SSL
|
|
generateMasterSecret SSL3 = generateMasterSecret_SSL
|
|
generateMasterSecret TLS10 = generateMasterSecret_TLS prf_MD5SHA1
|
|
generateMasterSecret TLS11 = generateMasterSecret_TLS prf_MD5SHA1
|
|
generateMasterSecret TLS12 = generateMasterSecret_TLS prf_SHA256
|
|
|
|
generateKeyBlock_TLS :: PRF -> ClientRandom -> ServerRandom -> Bytes -> Int -> Bytes
|
|
generateKeyBlock_TLS prf (ClientRandom c) (ServerRandom s) mastersecret kbsize =
|
|
prf mastersecret seed kbsize where seed = B.concat [ "key expansion", s, c ]
|
|
|
|
generateKeyBlock_SSL :: ClientRandom -> ServerRandom -> Bytes -> Int -> Bytes
|
|
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 ]
|
|
|
|
generateKeyBlock :: Version -> ClientRandom -> ServerRandom -> Bytes -> Int -> Bytes
|
|
generateKeyBlock SSL2 = generateKeyBlock_SSL
|
|
generateKeyBlock SSL3 = generateKeyBlock_SSL
|
|
generateKeyBlock TLS10 = generateKeyBlock_TLS prf_MD5SHA1
|
|
generateKeyBlock TLS11 = generateKeyBlock_TLS prf_MD5SHA1
|
|
generateKeyBlock TLS12 = generateKeyBlock_TLS prf_SHA256
|
|
|
|
generateFinished_TLS :: PRF -> Bytes -> Bytes -> HashCtx -> Bytes
|
|
generateFinished_TLS prf label mastersecret hashctx = prf mastersecret seed 12
|
|
where
|
|
seed = B.concat [ label, hashFinal hashctx ]
|
|
|
|
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 ]
|
|
|
|
lefthash = hashFinal $ flip hashUpdateSSL (pad1, B.take 40 pad1)
|
|
$ foldl hashUpdate hashctx [sender,mastersecret]
|
|
(md5left,sha1left) = B.splitAt 16 lefthash
|
|
pad2 = B.replicate 48 0x5c
|
|
pad1 = B.replicate 48 0x36
|
|
|
|
generateClientFinished :: Version -> Bytes -> HashCtx -> Bytes
|
|
generateClientFinished ver
|
|
| ver < TLS10 = generateFinished_SSL "CLNT"
|
|
| ver < TLS12 = generateFinished_TLS prf_MD5SHA1 "client finished"
|
|
| otherwise = generateFinished_TLS prf_SHA256 "client finished"
|
|
|
|
generateServerFinished :: Version -> Bytes -> HashCtx -> Bytes
|
|
generateServerFinished ver
|
|
| ver < TLS10 = generateFinished_SSL "SRVR"
|
|
| ver < TLS12 = generateFinished_TLS prf_MD5SHA1 "server finished"
|
|
| otherwise = generateFinished_TLS prf_SHA256 "server finished"
|
|
|
|
generateCertificateVerify_SSL :: Bytes -> HashCtx -> Bytes
|
|
generateCertificateVerify_SSL = generateFinished_SSL ""
|