2010-09-26 09:34:47 +00:00
|
|
|
{-# LANGUAGE OverloadedStrings #-}
|
2010-09-09 21:47:19 +00:00
|
|
|
-- |
|
|
|
|
-- 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
|
|
|
|
(
|
|
|
|
-- * marshall functions for header messages
|
|
|
|
decodeHeader
|
|
|
|
, encodeHeader
|
2010-10-06 08:07:48 +00:00
|
|
|
, encodeHeaderNoVer -- use for SSL3
|
2010-09-09 21:47:19 +00:00
|
|
|
|
|
|
|
-- * marshall functions for alert messages
|
|
|
|
, decodeAlert
|
|
|
|
, encodeAlert
|
|
|
|
|
|
|
|
-- * marshall functions for handshake messages
|
2010-10-02 09:34:45 +00:00
|
|
|
, decodeHandshakes
|
2010-09-09 21:47:19 +00:00
|
|
|
, decodeHandshake
|
|
|
|
, encodeHandshake
|
|
|
|
, encodeHandshakeHeader
|
|
|
|
, encodeHandshakeContent
|
|
|
|
|
|
|
|
-- * marshall functions for change cipher spec message
|
|
|
|
, decodeChangeCipherSpec
|
|
|
|
, encodeChangeCipherSpec
|
|
|
|
|
|
|
|
-- * generate things for packet content
|
|
|
|
, generateMasterSecret
|
|
|
|
, generateKeyBlock
|
|
|
|
, generateClientFinished
|
|
|
|
, generateServerFinished
|
|
|
|
) where
|
|
|
|
|
2010-09-26 07:46:09 +00:00
|
|
|
import Network.TLS.Struct
|
|
|
|
import Network.TLS.Cap
|
2010-09-09 21:47:19 +00:00
|
|
|
import Network.TLS.Wire
|
|
|
|
import Data.Either (partitionEithers)
|
|
|
|
import Data.Maybe (fromJust, isNothing)
|
2010-09-19 09:49:42 +00:00
|
|
|
import Control.Applicative ((<$>))
|
2010-09-09 21:47:19 +00:00
|
|
|
import Control.Monad
|
|
|
|
import Control.Monad.Error
|
|
|
|
import Data.Certificate.X509
|
|
|
|
import Network.TLS.Crypto
|
|
|
|
import Network.TLS.MAC
|
2010-09-26 09:34:47 +00:00
|
|
|
import Data.ByteString (ByteString)
|
2010-09-09 21:47:19 +00:00
|
|
|
import qualified Data.ByteString as B
|
2010-09-26 09:34:47 +00:00
|
|
|
import qualified Data.ByteString.Char8 as BC
|
|
|
|
import qualified Data.ByteString.Lazy as L
|
2010-09-09 21:47:19 +00:00
|
|
|
|
|
|
|
{-
|
|
|
|
- decode and encode headers
|
|
|
|
-}
|
|
|
|
decodeHeader :: ByteString -> Either TLSError Header
|
|
|
|
decodeHeader = runGet $ do
|
|
|
|
ty <- getWord8
|
|
|
|
major <- getWord8
|
|
|
|
minor <- getWord8
|
|
|
|
len <- getWord16
|
|
|
|
case (valToType ty, verOfNum (major, minor)) of
|
|
|
|
(Just y, Just v) -> return $ Header y v len
|
|
|
|
(Nothing, _) -> throwError (Error_Packet "invalid type")
|
|
|
|
(_, Nothing) -> throwError (Error_Packet "invalid version")
|
|
|
|
|
|
|
|
encodeHeader :: Header -> ByteString
|
|
|
|
encodeHeader (Header pt ver len) =
|
|
|
|
{- FIXME check len <= 2^14 -}
|
|
|
|
runPut (putWord8 (valOfType pt) >> putWord8 major >> putWord8 minor >> putWord16 len)
|
|
|
|
where (major, minor) = numericalVer ver
|
|
|
|
|
2010-10-06 08:07:48 +00:00
|
|
|
encodeHeaderNoVer :: Header -> ByteString
|
|
|
|
encodeHeaderNoVer (Header pt _ len) =
|
|
|
|
{- FIXME check len <= 2^14 -}
|
|
|
|
runPut (putWord8 (valOfType pt) >> putWord16 len)
|
|
|
|
|
2010-09-09 21:47:19 +00:00
|
|
|
{-
|
|
|
|
- decode and encode ALERT
|
|
|
|
-}
|
|
|
|
|
|
|
|
decodeAlert :: ByteString -> Either TLSError (AlertLevel, AlertDescription)
|
|
|
|
decodeAlert = runGet $ do
|
|
|
|
al <- getWord8
|
|
|
|
ad <- getWord8
|
|
|
|
case (valToType al, valToType ad) of
|
|
|
|
(Just a, Just d) -> return (a, d)
|
|
|
|
(Nothing, _) -> throwError (Error_Packet "missing alert level")
|
|
|
|
(_, Nothing) -> throwError (Error_Packet "missing alert description")
|
|
|
|
|
|
|
|
encodeAlert :: (AlertLevel, AlertDescription) -> ByteString
|
|
|
|
encodeAlert (al, ad) = runPut (putWord8 (valOfType al) >> putWord8 (valOfType ad))
|
|
|
|
|
|
|
|
{- decode and encode HANDSHAKE -}
|
2010-10-02 09:34:45 +00:00
|
|
|
decodeHandshakeHeader :: Get (HandshakeType, Bytes)
|
|
|
|
decodeHandshakeHeader = do
|
2010-09-09 21:47:19 +00:00
|
|
|
tyopt <- getWord8 >>= return . valToType
|
|
|
|
ty <- if isNothing tyopt
|
|
|
|
then throwError (Error_Unknown_Type "handshake type")
|
|
|
|
else return $ fromJust tyopt
|
|
|
|
len <- getWord24
|
|
|
|
content <- getBytes len
|
2010-09-26 09:34:47 +00:00
|
|
|
return (ty, content)
|
2010-09-09 21:47:19 +00:00
|
|
|
|
2010-10-02 09:34:45 +00:00
|
|
|
decodeHandshakes :: ByteString -> Either TLSError [(HandshakeType, Bytes)]
|
|
|
|
decodeHandshakes b = runGet getAll b
|
|
|
|
where
|
|
|
|
getAll = do
|
|
|
|
x <- decodeHandshakeHeader
|
|
|
|
empty <- isEmpty
|
|
|
|
if empty
|
|
|
|
then return [x]
|
|
|
|
else getAll >>= \l -> return (x : l)
|
|
|
|
|
2010-09-09 21:47:19 +00:00
|
|
|
decodeHandshake :: Version -> HandshakeType -> ByteString -> Either TLSError Handshake
|
|
|
|
decodeHandshake ver ty = runGet $ case ty of
|
|
|
|
HandshakeType_HelloRequest -> decodeHelloRequest
|
|
|
|
HandshakeType_ClientHello -> decodeClientHello
|
|
|
|
HandshakeType_ServerHello -> decodeServerHello
|
|
|
|
HandshakeType_Certificate -> decodeCertificates
|
|
|
|
HandshakeType_ServerKeyXchg -> decodeServerKeyXchg ver
|
|
|
|
HandshakeType_CertRequest -> decodeCertRequest ver
|
|
|
|
HandshakeType_ServerHelloDone -> decodeServerHelloDone
|
|
|
|
HandshakeType_CertVerify -> decodeCertVerify
|
|
|
|
HandshakeType_ClientKeyXchg -> decodeClientKeyXchg
|
|
|
|
HandshakeType_Finished -> decodeFinished ver
|
|
|
|
|
|
|
|
decodeHelloRequest :: Get Handshake
|
|
|
|
decodeHelloRequest = return HelloRequest
|
|
|
|
|
|
|
|
decodeClientHello :: Get Handshake
|
|
|
|
decodeClientHello = do
|
|
|
|
ver <- getVersion
|
|
|
|
random <- getClientRandom32
|
|
|
|
session <- getSession
|
|
|
|
ciphers <- getWords16
|
|
|
|
compressions <- getWords8
|
|
|
|
r <- remaining
|
2010-09-26 07:46:09 +00:00
|
|
|
exts <- if hasHelloExtensions ver && r > 0
|
2010-09-09 21:47:19 +00:00
|
|
|
then fmap fromIntegral getWord16 >>= getExtensions >>= return . Just
|
|
|
|
else return Nothing
|
|
|
|
return $ ClientHello ver random session ciphers compressions exts
|
|
|
|
|
|
|
|
decodeServerHello :: Get Handshake
|
|
|
|
decodeServerHello = do
|
|
|
|
ver <- getVersion
|
|
|
|
random <- getServerRandom32
|
|
|
|
session <- getSession
|
|
|
|
cipherid <- getWord16
|
|
|
|
compressionid <- getWord8
|
|
|
|
r <- remaining
|
2010-09-26 07:46:09 +00:00
|
|
|
exts <- if hasHelloExtensions ver && r > 0
|
2010-09-09 21:47:19 +00:00
|
|
|
then fmap fromIntegral getWord16 >>= getExtensions >>= return . Just
|
|
|
|
else return Nothing
|
|
|
|
return $ ServerHello ver random session cipherid compressionid exts
|
|
|
|
|
|
|
|
decodeServerHelloDone :: Get Handshake
|
|
|
|
decodeServerHelloDone = return ServerHelloDone
|
|
|
|
|
|
|
|
decodeCertificates :: Get Handshake
|
|
|
|
decodeCertificates = do
|
|
|
|
certslen <- getWord24
|
|
|
|
certs <- getCerts certslen >>= return . map (decodeCertificate . L.fromChunks . (:[]))
|
|
|
|
let (l, r) = partitionEithers certs
|
|
|
|
if length l > 0
|
|
|
|
then throwError $ Error_Certificate $ show l
|
|
|
|
else return $ Certificates r
|
|
|
|
|
|
|
|
decodeFinished :: Version -> Get Handshake
|
|
|
|
decodeFinished ver = do
|
|
|
|
-- unfortunately passing the verify_data_size here would be tedious for >=TLS12,
|
|
|
|
-- so just return the remaining string.
|
|
|
|
len <- if ver >= TLS12
|
|
|
|
then remaining
|
2010-09-26 15:32:28 +00:00
|
|
|
else if ver == SSL3 then return 36
|
|
|
|
else return 12
|
2010-09-09 21:47:19 +00:00
|
|
|
opaque <- getBytes (fromIntegral len)
|
|
|
|
return $ Finished $ B.unpack opaque
|
|
|
|
|
|
|
|
getSignatureHashAlgorithm :: Int -> Get [ (HashAlgorithm, SignatureAlgorithm) ]
|
|
|
|
getSignatureHashAlgorithm 0 = return []
|
|
|
|
getSignatureHashAlgorithm len = do
|
2010-09-19 09:49:42 +00:00
|
|
|
h <- fromJust . valToType <$> getWord8
|
|
|
|
s <- fromJust . valToType <$> getWord8
|
2010-09-09 21:47:19 +00:00
|
|
|
xs <- getSignatureHashAlgorithm (len - 2)
|
|
|
|
return ((h, s) : xs)
|
|
|
|
|
|
|
|
decodeCertRequest :: Version -> Get Handshake
|
|
|
|
decodeCertRequest ver = do
|
2010-09-19 09:49:42 +00:00
|
|
|
certTypes <- map (fromJust . valToType . fromIntegral) <$> getWords8
|
2010-09-09 21:47:19 +00:00
|
|
|
|
|
|
|
sigHashAlgs <- if ver >= TLS12
|
|
|
|
then do
|
|
|
|
sighashlen <- getWord16
|
2010-09-19 09:49:42 +00:00
|
|
|
Just <$> getSignatureHashAlgorithm (fromIntegral sighashlen)
|
2010-09-09 21:47:19 +00:00
|
|
|
else return Nothing
|
|
|
|
dNameLen <- getWord16
|
|
|
|
when (ver < TLS12 && dNameLen < 3) $ throwError (Error_Misc "certrequest distinguishname not of the correct size")
|
|
|
|
dName <- getBytes $ fromIntegral dNameLen
|
|
|
|
return $ CertRequest certTypes sigHashAlgs (B.unpack dName)
|
|
|
|
|
|
|
|
decodeCertVerify :: Get Handshake
|
|
|
|
decodeCertVerify =
|
|
|
|
{- FIXME -}
|
|
|
|
return $ CertVerify []
|
|
|
|
|
|
|
|
decodeClientKeyXchg :: Get Handshake
|
|
|
|
decodeClientKeyXchg = do
|
|
|
|
ver <- getVersion
|
2010-09-13 20:10:25 +00:00
|
|
|
ran <- getClientKeyData46
|
2010-09-09 21:47:19 +00:00
|
|
|
return $ ClientKeyXchg ver ran
|
|
|
|
|
|
|
|
-- FIXME need to work out how we marshall an opaque number
|
|
|
|
--numberise :: ByteString -> Integer
|
|
|
|
numberise _ = 0
|
|
|
|
|
|
|
|
decodeServerKeyXchg_DH :: Get ServerDHParams
|
|
|
|
decodeServerKeyXchg_DH = do
|
|
|
|
p <- getWord16 >>= getBytes . fromIntegral
|
|
|
|
g <- getWord16 >>= getBytes . fromIntegral
|
|
|
|
y <- getWord16 >>= getBytes . fromIntegral
|
|
|
|
return $ ServerDHParams { dh_p = numberise p, dh_g = numberise g, dh_Ys = numberise y }
|
|
|
|
|
|
|
|
decodeServerKeyXchg_RSA :: Get ServerRSAParams
|
|
|
|
decodeServerKeyXchg_RSA = do
|
|
|
|
modulus <- getWord16 >>= getBytes . fromIntegral
|
|
|
|
expo <- getWord16 >>= getBytes . fromIntegral
|
|
|
|
return $ ServerRSAParams { rsa_modulus = numberise modulus, rsa_exponent = numberise expo }
|
|
|
|
|
|
|
|
decodeServerKeyXchg :: Version -> Get Handshake
|
|
|
|
decodeServerKeyXchg ver = do
|
|
|
|
-- mostly unimplemented
|
|
|
|
skxAlg <- case ver of
|
|
|
|
TLS12 -> return $ SKX_RSA Nothing
|
|
|
|
TLS10 -> do
|
|
|
|
rsaparams <- decodeServerKeyXchg_RSA
|
|
|
|
return $ SKX_RSA $ Just rsaparams
|
|
|
|
_ -> do
|
|
|
|
return $ SKX_RSA Nothing
|
|
|
|
return (ServerKeyXchg skxAlg)
|
|
|
|
|
|
|
|
encodeHandshake :: Handshake -> ByteString
|
|
|
|
encodeHandshake o =
|
|
|
|
let content = runPut $ encodeHandshakeContent o in
|
2010-09-26 09:34:47 +00:00
|
|
|
let len = fromIntegral $ B.length content in
|
2010-09-09 21:47:19 +00:00
|
|
|
let header = runPut $ encodeHandshakeHeader (typeOfHandshake o) len in
|
2010-09-26 09:34:47 +00:00
|
|
|
B.concat [ header, content ]
|
2010-09-09 21:47:19 +00:00
|
|
|
|
|
|
|
encodeHandshakeHeader :: HandshakeType -> Int -> Put
|
|
|
|
encodeHandshakeHeader ty len = putWord8 (valOfType ty) >> putWord24 len
|
|
|
|
|
|
|
|
encodeHandshakeContent :: Handshake -> Put
|
|
|
|
|
|
|
|
encodeHandshakeContent (ClientHello version random session cipherIDs compressionIDs exts) = 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 certs) =
|
2010-09-26 09:34:47 +00:00
|
|
|
putWord24 len >> putBytes certbs
|
2010-09-09 21:47:19 +00:00
|
|
|
where
|
|
|
|
certbs = runPut $ mapM_ putCert certs
|
2010-09-26 09:34:47 +00:00
|
|
|
len = fromIntegral $ B.length certbs
|
2010-09-09 21:47:19 +00:00
|
|
|
|
|
|
|
encodeHandshakeContent (ClientKeyXchg version random) = do
|
|
|
|
putVersion version
|
2010-09-13 20:10:25 +00:00
|
|
|
putClientKeyData46 random
|
2010-09-09 21:47:19 +00:00
|
|
|
|
|
|
|
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
|
2010-09-26 09:34:47 +00:00
|
|
|
putBytes $ B.pack certAuthorities
|
2010-09-09 21:47:19 +00:00
|
|
|
|
|
|
|
encodeHandshakeContent (CertVerify _) = undefined
|
|
|
|
|
|
|
|
encodeHandshakeContent (Finished opaque) = mapM_ putWord8 opaque
|
|
|
|
|
|
|
|
{- marshall helpers -}
|
|
|
|
getVersion :: Get Version
|
|
|
|
getVersion = do
|
|
|
|
major <- getWord8
|
|
|
|
minor <- getWord8
|
|
|
|
case verOfNum (major, minor) of
|
|
|
|
Just v -> return v
|
|
|
|
Nothing -> throwError (Error_Unknown_Version major minor)
|
|
|
|
|
|
|
|
putVersion :: Version -> Put
|
|
|
|
putVersion ver = putWord8 major >> putWord8 minor
|
|
|
|
where (major, minor) = numericalVer ver
|
|
|
|
|
|
|
|
{- FIXME make sure it return error if not 32 available -}
|
2010-09-26 09:34:47 +00:00
|
|
|
getRandom32 :: Get Bytes
|
|
|
|
getRandom32 = getBytes 32
|
2010-09-09 21:47:19 +00:00
|
|
|
|
|
|
|
getServerRandom32 :: Get ServerRandom
|
2010-09-19 09:49:42 +00:00
|
|
|
getServerRandom32 = ServerRandom <$> getRandom32
|
2010-09-09 21:47:19 +00:00
|
|
|
|
|
|
|
getClientRandom32 :: Get ClientRandom
|
2010-09-19 09:49:42 +00:00
|
|
|
getClientRandom32 = ClientRandom <$> getRandom32
|
2010-09-09 21:47:19 +00:00
|
|
|
|
2010-09-26 09:34:47 +00:00
|
|
|
putRandom32 :: Bytes -> Put
|
|
|
|
putRandom32 = putBytes
|
2010-09-09 21:47:19 +00:00
|
|
|
|
|
|
|
putClientRandom32 :: ClientRandom -> Put
|
|
|
|
putClientRandom32 (ClientRandom r) = putRandom32 r
|
|
|
|
|
|
|
|
putServerRandom32 :: ServerRandom -> Put
|
|
|
|
putServerRandom32 (ServerRandom r) = putRandom32 r
|
|
|
|
|
2010-09-13 20:10:25 +00:00
|
|
|
getClientKeyData46 :: Get ClientKeyData
|
2010-09-26 09:34:47 +00:00
|
|
|
getClientKeyData46 = ClientKeyData <$> getBytes 46
|
2010-09-09 21:47:19 +00:00
|
|
|
|
2010-09-13 20:10:25 +00:00
|
|
|
putClientKeyData46 :: ClientKeyData -> Put
|
2010-09-26 09:34:47 +00:00
|
|
|
putClientKeyData46 (ClientKeyData d) = putBytes d
|
2010-09-09 21:47:19 +00:00
|
|
|
|
|
|
|
getSession :: Get Session
|
|
|
|
getSession = do
|
|
|
|
len8 <- getWord8
|
|
|
|
case fromIntegral len8 of
|
|
|
|
0 -> return $ Session Nothing
|
2010-09-26 09:34:47 +00:00
|
|
|
len -> Session . Just <$> getBytes len
|
2010-09-09 21:47:19 +00:00
|
|
|
|
|
|
|
putSession :: Session -> Put
|
|
|
|
putSession (Session session) =
|
|
|
|
case session of
|
|
|
|
Nothing -> putWord8 0
|
2010-09-26 09:34:47 +00:00
|
|
|
Just s -> putWord8 (fromIntegral $ B.length s) >> putBytes s
|
2010-09-09 21:47:19 +00:00
|
|
|
|
2010-09-26 09:34:47 +00:00
|
|
|
getCerts :: Int -> Get [Bytes]
|
2010-09-09 21:47:19 +00:00
|
|
|
getCerts 0 = return []
|
|
|
|
getCerts len = do
|
|
|
|
certlen <- getWord24
|
|
|
|
cert <- getBytes certlen
|
|
|
|
certxs <- getCerts (len - certlen - 3)
|
|
|
|
return (cert : certxs)
|
|
|
|
|
|
|
|
putCert :: Certificate -> Put
|
2010-09-26 09:34:47 +00:00
|
|
|
putCert cert = putWord24 (fromIntegral $ B.length content) >> putBytes content
|
|
|
|
where content = B.concat $ L.toChunks $ encodeCertificate cert
|
2010-09-09 21:47:19 +00:00
|
|
|
|
|
|
|
getExtensions :: Int -> Get [Extension]
|
|
|
|
getExtensions 0 = return []
|
|
|
|
getExtensions len = do
|
|
|
|
extty <- getWord16
|
|
|
|
extdatalen <- getWord16
|
|
|
|
extdata <- getBytes $ fromIntegral extdatalen
|
|
|
|
extxs <- getExtensions (len - fromIntegral extdatalen - 4)
|
|
|
|
return $ (extty, B.unpack extdata) : extxs
|
|
|
|
|
|
|
|
putExtension :: Extension -> Put
|
|
|
|
putExtension (ty, l) = do
|
|
|
|
putWord16 ty
|
|
|
|
putWord16 (fromIntegral $ length l)
|
2010-09-26 09:34:47 +00:00
|
|
|
putBytes (B.pack l)
|
2010-09-09 21:47:19 +00:00
|
|
|
|
|
|
|
putExtensions :: Maybe [Extension] -> Put
|
|
|
|
putExtensions Nothing = return ()
|
|
|
|
putExtensions (Just es) =
|
2010-09-26 09:34:47 +00:00
|
|
|
putWord16 (fromIntegral $ B.length extbs) >> putBytes extbs
|
2010-09-09 21:47:19 +00:00
|
|
|
where
|
|
|
|
extbs = runPut $ mapM_ putExtension es
|
|
|
|
|
|
|
|
{-
|
|
|
|
- decode and encode ALERT
|
|
|
|
-}
|
|
|
|
|
|
|
|
decodeChangeCipherSpec :: ByteString -> Either TLSError ()
|
|
|
|
decodeChangeCipherSpec b = do
|
|
|
|
x <- runGet getWord8 b
|
|
|
|
if x == 1 then Right () else Left $ Error_Misc "unknown change cipher spec content"
|
|
|
|
|
|
|
|
encodeChangeCipherSpec :: ByteString
|
|
|
|
encodeChangeCipherSpec = runPut (putWord8 1)
|
|
|
|
|
|
|
|
{-
|
|
|
|
- generate things for packet content
|
|
|
|
-}
|
2010-09-26 15:07:14 +00:00
|
|
|
generateMasterSecret_TLS, generateMasterSecret_SSL :: Bytes -> ClientRandom -> ServerRandom -> Bytes
|
|
|
|
generateMasterSecret_TLS premasterSecret (ClientRandom c) (ServerRandom s) =
|
2010-09-09 21:47:19 +00:00
|
|
|
prf_MD5SHA1 premasterSecret seed 48
|
|
|
|
where
|
2010-10-05 17:45:10 +00:00
|
|
|
seed = B.concat [ "master secret", c, s ]
|
2010-09-09 21:47:19 +00:00
|
|
|
|
2010-09-26 15:07:14 +00:00
|
|
|
generateMasterSecret_SSL premasterSecret (ClientRandom c) (ServerRandom s) =
|
2010-10-05 17:45:10 +00:00
|
|
|
B.concat $ map (computeMD5) ["A","BB","CCC"]
|
2010-09-26 15:07:14 +00:00
|
|
|
where
|
|
|
|
computeMD5 label = hashMD5 $ B.concat [ premasterSecret, computeSHA1 label ]
|
|
|
|
computeSHA1 label = hashSHA1 $ B.concat [ label, premasterSecret, c, s ]
|
|
|
|
|
|
|
|
generateMasterSecret :: Version -> Bytes -> ClientRandom -> ServerRandom -> Bytes
|
|
|
|
generateMasterSecret ver =
|
|
|
|
if ver < TLS10 then generateMasterSecret_SSL else generateMasterSecret_TLS
|
|
|
|
|
2010-10-05 17:45:10 +00:00
|
|
|
generateKeyBlock_TLS :: ClientRandom -> ServerRandom -> Bytes -> Int -> Bytes
|
|
|
|
generateKeyBlock_TLS (ClientRandom c) (ServerRandom s) mastersecret kbsize =
|
2010-09-09 21:47:19 +00:00
|
|
|
prf_MD5SHA1 mastersecret seed kbsize
|
|
|
|
where
|
2010-10-05 17:45:10 +00:00
|
|
|
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 = hashMD5 $ B.concat [ mastersecret, computeSHA1 label ]
|
|
|
|
computeSHA1 label = hashSHA1 $ B.concat [ label, mastersecret, s, c ]
|
|
|
|
|
|
|
|
generateKeyBlock :: Version -> ClientRandom -> ServerRandom -> Bytes -> Int -> Bytes
|
|
|
|
generateKeyBlock ver =
|
|
|
|
if ver < TLS10 then generateKeyBlock_SSL else generateKeyBlock_TLS
|
2010-09-09 21:47:19 +00:00
|
|
|
|
2010-09-26 15:32:28 +00:00
|
|
|
generateFinished_TLS :: Bytes -> Bytes -> HashCtx -> HashCtx -> Bytes
|
|
|
|
generateFinished_TLS label mastersecret md5ctx sha1ctx =
|
2010-09-09 21:47:19 +00:00
|
|
|
prf_MD5SHA1 mastersecret seed 12
|
|
|
|
where
|
2010-09-26 09:34:47 +00:00
|
|
|
seed = B.concat [ label, finalizeHash md5ctx, finalizeHash sha1ctx ]
|
2010-09-09 21:47:19 +00:00
|
|
|
|
2010-09-26 15:32:28 +00:00
|
|
|
generateFinished_SSL :: Bytes -> Bytes -> HashCtx -> HashCtx -> Bytes
|
|
|
|
generateFinished_SSL sender mastersecret md5ctx sha1ctx =
|
|
|
|
B.concat [md5hash, sha1hash]
|
|
|
|
where
|
2010-10-05 17:45:10 +00:00
|
|
|
md5hash = hashMD5 $ B.concat [ mastersecret, pad2, md5left ]
|
|
|
|
sha1hash = hashSHA1 $ B.concat [ mastersecret, B.take 40 pad2, sha1left ]
|
|
|
|
md5left = finalizeHash $ foldl updateHash md5ctx [ sender, mastersecret, pad1 ]
|
|
|
|
sha1left = finalizeHash $ foldl updateHash sha1ctx [ sender, mastersecret, B.take 40 pad1 ]
|
|
|
|
pad2 = B.replicate 48 0x5c
|
|
|
|
pad1 = B.replicate 48 0x36
|
2010-09-26 15:32:28 +00:00
|
|
|
|
|
|
|
generateClientFinished :: Version -> Bytes -> HashCtx -> HashCtx -> Bytes
|
|
|
|
generateClientFinished ver =
|
2010-10-05 17:45:10 +00:00
|
|
|
if ver < TLS10 then generateFinished_SSL "CLNT" else generateFinished_TLS "client finished"
|
2010-09-26 15:32:28 +00:00
|
|
|
|
|
|
|
generateServerFinished :: Version -> Bytes -> HashCtx -> HashCtx -> Bytes
|
|
|
|
generateServerFinished ver =
|
2010-10-05 17:45:10 +00:00
|
|
|
if ver < TLS10 then generateFinished_SSL "SRVR" else generateFinished_TLS "server finished"
|