remove the need to pass the RNG in record engage.
This commit is contained in:
parent
bcc53155f1
commit
4a9389c5c2
2 changed files with 25 additions and 8 deletions
|
@ -70,13 +70,9 @@ encryptData content = do
|
||||||
else
|
else
|
||||||
B.empty
|
B.empty
|
||||||
|
|
||||||
-- before TLS 1.1, the block cipher IV is made of the residual of the previous block.
|
let e = encrypt writekey (cstIV cst) (B.concat [ content, padding ])
|
||||||
iv <- if hasExplicitBlockIV $ stVersion st
|
|
||||||
then genTLSRandom (bulkIVSize bulk)
|
|
||||||
else return $ cstIV cst
|
|
||||||
let e = encrypt writekey iv (B.concat [ content, padding ])
|
|
||||||
if hasExplicitBlockIV $ stVersion st
|
if hasExplicitBlockIV $ stVersion st
|
||||||
then return $ B.concat [iv,e]
|
then return $ B.concat [cstIV cst,e]
|
||||||
else do
|
else do
|
||||||
let newiv = fromJust "new iv" $ takelast (bulkIVSize bulk) e
|
let newiv = fromJust "new iv" $ takelast (bulkIVSize bulk) e
|
||||||
modifyTxState_ $ \txs -> txs { stCryptState = cst { cstIV = newiv } }
|
modifyTxState_ $ \txs -> txs { stCryptState = cst { cstIV = newiv } }
|
||||||
|
|
|
@ -18,12 +18,15 @@ import qualified Data.ByteString as B
|
||||||
|
|
||||||
import Network.TLS.Util
|
import Network.TLS.Util
|
||||||
import Network.TLS.Types (Role(..))
|
import Network.TLS.Types (Role(..))
|
||||||
|
import Network.TLS.Cap
|
||||||
import Network.TLS.Struct
|
import Network.TLS.Struct
|
||||||
import Network.TLS.Record
|
import Network.TLS.Record
|
||||||
import Network.TLS.Packet
|
import Network.TLS.Packet
|
||||||
import Network.TLS.State
|
import Network.TLS.State
|
||||||
import Network.TLS.Handshake.State
|
import Network.TLS.Handshake.State
|
||||||
|
import Network.TLS.Record.State
|
||||||
import Network.TLS.Crypto
|
import Network.TLS.Crypto
|
||||||
|
import Network.TLS.Cipher
|
||||||
|
|
||||||
-- | 'makePacketData' create a Header and a content bytestring related to a packet
|
-- | 'makePacketData' create a Header and a content bytestring related to a packet
|
||||||
-- this doesn't change any state
|
-- this doesn't change any state
|
||||||
|
@ -52,12 +55,30 @@ writePacket pkt@(Handshake hss) = do
|
||||||
let encoded = encodeHandshake hs
|
let encoded = encodeHandshake hs
|
||||||
when (certVerifyHandshakeMaterial hs) $ withHandshakeM $ addHandshakeMessage encoded
|
when (certVerifyHandshakeMaterial hs) $ withHandshakeM $ addHandshakeMessage encoded
|
||||||
when (finishHandshakeTypeMaterial $ typeOfHandshake hs) $ withHandshakeM $ updateHandshakeDigest encoded
|
when (finishHandshakeTypeMaterial $ typeOfHandshake hs) $ withHandshakeM $ updateHandshakeDigest encoded
|
||||||
runRecordStateSt (makeRecord pkt >>= engageRecord >>= encodeRecord)
|
prepareRecord (makeRecord pkt >>= engageRecord >>= encodeRecord)
|
||||||
writePacket pkt = do
|
writePacket pkt = do
|
||||||
d <- runRecordStateSt (makeRecord pkt >>= engageRecord >>= encodeRecord)
|
d <- prepareRecord (makeRecord pkt >>= engageRecord >>= encodeRecord)
|
||||||
when (pkt == ChangeCipherSpec) $ switchTxEncryption
|
when (pkt == ChangeCipherSpec) $ switchTxEncryption
|
||||||
return d
|
return d
|
||||||
|
|
||||||
|
-- before TLS 1.1, the block cipher IV is made of the residual of the previous block,
|
||||||
|
-- so we use cstIV as is, however in other case we generate an explicit IV
|
||||||
|
prepareRecord :: RecordM a -> TLSSt a
|
||||||
|
prepareRecord f = do
|
||||||
|
st <- get
|
||||||
|
ver <- getVersion
|
||||||
|
let sz = case stCipher $ stTxState $ stRecordState st of
|
||||||
|
Nothing -> 0
|
||||||
|
Just cipher -> bulkIVSize $ cipherBulk cipher
|
||||||
|
if hasExplicitBlockIV ver && sz > 0
|
||||||
|
then do newIV <- genRandom sz
|
||||||
|
runRecordStateSt $ modify $ \rts ->
|
||||||
|
let ts = stTxState rts
|
||||||
|
nts = ts { stCryptState = (stCryptState ts) { cstIV = newIV } }
|
||||||
|
in rts { stTxState = nts }
|
||||||
|
runRecordStateSt f
|
||||||
|
else runRecordStateSt f
|
||||||
|
|
||||||
{------------------------------------------------------------------------------}
|
{------------------------------------------------------------------------------}
|
||||||
{- SENDING Helpers -}
|
{- SENDING Helpers -}
|
||||||
{------------------------------------------------------------------------------}
|
{------------------------------------------------------------------------------}
|
||||||
|
|
Loading…
Reference in a new issue