separate tx/rx compression and pending compression.
Fix issue with compression being turn on for tx and rx at the same time, and also at too early at the hello message instead of change cipher.
This commit is contained in:
parent
78535ff8c3
commit
8f99c325fb
5 changed files with 32 additions and 18 deletions
|
@ -94,9 +94,9 @@ handshakeServerWith sparams ctx clientHello@(ClientHello ver _ clientSession cip
|
|||
when (null commonCompressions) $
|
||||
throwCore $ Error_Protocol ("no compression in common with the client", True, HandshakeFailure)
|
||||
usingState_ ctx $ runRecordStateSt $ modify (\st -> st
|
||||
{ stVersion = ver
|
||||
, stPendingCipher = Just usedCipher
|
||||
, stCompression = usedCompression
|
||||
{ stVersion = ver
|
||||
, stPendingCipher = Just usedCipher
|
||||
, stPendingCompression = usedCompression
|
||||
})
|
||||
|
||||
resumeSessionData <- case clientSession of
|
||||
|
|
|
@ -30,7 +30,7 @@ disengageRecord = decryptRecord >=> uncompressRecord
|
|||
|
||||
uncompressRecord :: Record Compressed -> RecordM (Record Plaintext)
|
||||
uncompressRecord record = onRecordFragment record $ fragmentUncompress $ \bytes ->
|
||||
withCompression $ compressionInflate bytes
|
||||
withRxCompression $ compressionInflate bytes
|
||||
|
||||
decryptRecord :: Record Ciphertext -> RecordM (Record Compressed)
|
||||
decryptRecord record = onRecordFragment record $ fragmentUncipher $ \e -> do
|
||||
|
|
|
@ -29,7 +29,7 @@ engageRecord = compressRecord >=> encryptRecord
|
|||
compressRecord :: Record Plaintext -> RecordM (Record Compressed)
|
||||
compressRecord record =
|
||||
onRecordFragment record $ fragmentCompress $ \bytes -> do
|
||||
withCompression $ compressionDeflate bytes
|
||||
withTxCompression $ compressionDeflate bytes
|
||||
|
||||
{-
|
||||
- when Tx Encrypted is set, we pass the data through encryptContent, otherwise
|
||||
|
|
|
@ -14,7 +14,8 @@ module Network.TLS.Record.State
|
|||
, RecordState(..)
|
||||
, newRecordState
|
||||
, RecordM(..)
|
||||
, withCompression
|
||||
, withTxCompression
|
||||
, withRxCompression
|
||||
, genTLSRandom
|
||||
, makeDigest
|
||||
) where
|
||||
|
@ -61,7 +62,9 @@ data RecordState = RecordState
|
|||
, stActiveTxCipher :: Maybe Cipher
|
||||
, stActiveRxCipher :: Maybe Cipher
|
||||
, stPendingCipher :: Maybe Cipher
|
||||
, stCompression :: Compression
|
||||
, stTxCompression :: Compression
|
||||
, stRxCompression :: Compression
|
||||
, stPendingCompression :: Compression
|
||||
, stRandomGen :: StateRNG
|
||||
} deriving (Show)
|
||||
|
||||
|
@ -95,15 +98,24 @@ newRecordState rng clientContext = RecordState
|
|||
, stActiveTxCipher = Nothing
|
||||
, stActiveRxCipher = Nothing
|
||||
, stPendingCipher = Nothing
|
||||
, stCompression = nullCompression
|
||||
, stTxCompression = nullCompression
|
||||
, stRxCompression = nullCompression
|
||||
, stPendingCompression = nullCompression
|
||||
, stRandomGen = StateRNG rng
|
||||
}
|
||||
|
||||
withCompression :: (Compression -> (Compression, a)) -> RecordM a
|
||||
withCompression f = do
|
||||
withTxCompression :: (Compression -> (Compression, a)) -> RecordM a
|
||||
withTxCompression f = do
|
||||
st <- get
|
||||
let (nc, a) = f (stCompression st)
|
||||
put $ st { stCompression = nc }
|
||||
let (nc, a) = f (stTxCompression st)
|
||||
put $ st { stTxCompression = nc }
|
||||
return a
|
||||
|
||||
withRxCompression :: (Compression -> (Compression, a)) -> RecordM a
|
||||
withRxCompression f = do
|
||||
st <- get
|
||||
let (nc, a) = f (stRxCompression st)
|
||||
put $ st { stRxCompression = nc }
|
||||
return a
|
||||
|
||||
genTLSRandom :: Int -> RecordM Bytes
|
||||
|
|
|
@ -217,14 +217,16 @@ certVerifyHandshakeMaterial :: Handshake -> Bool
|
|||
certVerifyHandshakeMaterial = certVerifyHandshakeTypeMaterial . typeOfHandshake
|
||||
|
||||
switchTxEncryption, switchRxEncryption :: MonadState RecordState m => m ()
|
||||
switchTxEncryption = modify (\st -> st { stTxEncrypted = True
|
||||
, stActiveTxMacState = stPendingTxMacState st
|
||||
switchTxEncryption = modify (\st -> st { stTxEncrypted = True
|
||||
, stActiveTxMacState = stPendingTxMacState st
|
||||
, stActiveTxCryptState = stPendingTxCryptState st
|
||||
, stActiveTxCipher = stPendingCipher st })
|
||||
switchRxEncryption = modify (\st -> st { stRxEncrypted = True
|
||||
, stActiveRxMacState = stPendingRxMacState st
|
||||
, stActiveTxCipher = stPendingCipher st
|
||||
, stTxCompression = stPendingCompression st })
|
||||
switchRxEncryption = modify (\st -> st { stRxEncrypted = True
|
||||
, stActiveRxMacState = stPendingRxMacState st
|
||||
, stActiveRxCryptState = stPendingRxCryptState st
|
||||
, stActiveRxCipher = stPendingCipher st })
|
||||
, stActiveRxCipher = stPendingCipher st
|
||||
, stRxCompression = stPendingCompression st })
|
||||
|
||||
setServerRandom :: MonadState TLSState m => ServerRandom -> m ()
|
||||
setServerRandom ran = updateHandshake "srand" (\hst -> hst { hstServerRandom = Just ran })
|
||||
|
|
Loading…
Reference in a new issue