reorganize the way we decrypt data to be nicer.
as a bonus, finally check if padding is valid.
This commit is contained in:
parent
6d1e38a337
commit
f033a0d973
2 changed files with 59 additions and 36 deletions
|
@ -129,31 +129,40 @@ processHsPacket ver dcontent = do
|
||||||
when (finishHandshakeTypeMaterial ty) (updateHandshakeDigest dcontent)
|
when (finishHandshakeTypeMaterial ty) (updateHandshakeDigest dcontent)
|
||||||
return $ Handshake hs
|
return $ Handshake hs
|
||||||
|
|
||||||
decryptContentReally :: Header -> EncryptedData -> TLSRead ByteString
|
|
||||||
decryptContentReally hdr e = do
|
|
||||||
st <- getTLSState
|
|
||||||
unencrypted_content <- decryptData e
|
|
||||||
let digestSize = cipherDigestSize $ fromJust $ stCipher st
|
|
||||||
let (unencrypted_msg, digest) = B.splitAt (B.length unencrypted_content - fromIntegral digestSize) unencrypted_content
|
|
||||||
let (Header pt ver _) = hdr
|
|
||||||
let new_hdr = Header pt ver (fromIntegral $ B.length unencrypted_msg)
|
|
||||||
expected_digest <- makeDigest False new_hdr unencrypted_msg
|
|
||||||
|
|
||||||
if expected_digest == digest
|
|
||||||
then return $ unencrypted_msg
|
|
||||||
else throwError $ Error_Digest (B.unpack expected_digest, B.unpack digest)
|
|
||||||
|
|
||||||
decryptContent :: Header -> EncryptedData -> TLSRead ByteString
|
decryptContent :: Header -> EncryptedData -> TLSRead ByteString
|
||||||
decryptContent hdr e@(EncryptedData b) = do
|
decryptContent hdr e@(EncryptedData b) = do
|
||||||
st <- getTLSState
|
st <- getTLSState
|
||||||
if stRxEncrypted st
|
if stRxEncrypted st
|
||||||
then decryptContentReally hdr e
|
then decryptData e >>= getCipherData hdr
|
||||||
else return b
|
else return b
|
||||||
|
|
||||||
verifyPadding :: Bytes -> Bool
|
getCipherData :: Header -> CipherData -> TLSRead ByteString
|
||||||
verifyPadding p = False
|
getCipherData hdr cdata = do
|
||||||
|
-- check if the MAC is valid.
|
||||||
|
macValid <- case cipherDataMAC cdata of
|
||||||
|
Nothing -> return True
|
||||||
|
Just digest -> do
|
||||||
|
let (Header pt ver _) = hdr
|
||||||
|
let new_hdr = Header pt ver (fromIntegral $ B.length $ cipherDataContent cdata)
|
||||||
|
expected_digest <- makeDigest False new_hdr $ cipherDataContent cdata
|
||||||
|
if expected_digest == digest
|
||||||
|
then return True
|
||||||
|
else return False
|
||||||
|
|
||||||
decryptData :: EncryptedData -> TLSRead ByteString
|
-- check if the padding is filled with the correct pattern if it exists
|
||||||
|
paddingValid <- case cipherDataPadding cdata of
|
||||||
|
Nothing -> return True
|
||||||
|
Just pad -> do
|
||||||
|
let b = B.length pad - 1
|
||||||
|
return $ maybe True (const False) $ B.find (/= fromIntegral b) pad
|
||||||
|
|
||||||
|
unless (and $! [ macValid, paddingValid ]) $ do
|
||||||
|
throwError $ Error_Digest ([], [])
|
||||||
|
|
||||||
|
return $ cipherDataContent cdata
|
||||||
|
|
||||||
|
decryptData :: EncryptedData -> TLSRead CipherData
|
||||||
decryptData (EncryptedData econtent) = do
|
decryptData (EncryptedData econtent) = do
|
||||||
st <- getTLSState
|
st <- getTLSState
|
||||||
|
|
||||||
|
@ -164,35 +173,41 @@ decryptData (EncryptedData econtent) = do
|
||||||
let cipher = fromJust $ stCipher st
|
let cipher = fromJust $ stCipher st
|
||||||
let cst = fromJust $ stRxCryptState st
|
let cst = fromJust $ stRxCryptState st
|
||||||
let padding_size = fromIntegral $ cipherPaddingSize cipher
|
let padding_size = fromIntegral $ cipherPaddingSize cipher
|
||||||
|
let digestSize = fromIntegral $ cipherDigestSize cipher
|
||||||
let writekey = cstKey cst
|
let writekey = cstKey cst
|
||||||
|
|
||||||
contentpadded <- case cipherF cipher of
|
case cipherF cipher of
|
||||||
CipherNoneF -> fail "none decrypt"
|
CipherNoneF -> fail "none decrypt"
|
||||||
CipherBlockF _ decryptF -> do
|
CipherBlockF _ decryptF -> do
|
||||||
{- update IV -}
|
{- update IV -}
|
||||||
let (iv, econtent') =
|
let (iv, econtent') =
|
||||||
if hasExplicitBlockIV $ stVersion st
|
if hasExplicitBlockIV $ stVersion st
|
||||||
then
|
then B.splitAt (fromIntegral $ cipherIVSize cipher) econtent
|
||||||
B.splitAt (fromIntegral $ cipherIVSize cipher) econtent
|
else (cstIV cst, econtent)
|
||||||
else
|
|
||||||
(cstIV cst, econtent)
|
|
||||||
let newiv = fromJust $ takelast padding_size econtent'
|
let newiv = fromJust $ takelast padding_size econtent'
|
||||||
putTLSState $ st { stRxCryptState = Just $ cst { cstIV = newiv } }
|
putTLSState $ st { stRxCryptState = Just $ cst { cstIV = newiv } }
|
||||||
return $ decryptF writekey iv econtent'
|
|
||||||
|
let content' = decryptF writekey iv econtent'
|
||||||
|
let paddinglength = fromIntegral (B.last content') + 1
|
||||||
|
let contentlen = B.length content' - paddinglength - digestSize
|
||||||
|
let (content, mac, padding) = fromJust $ partition3 content' (contentlen, digestSize, paddinglength)
|
||||||
|
return $ CipherData
|
||||||
|
{ cipherDataContent = content
|
||||||
|
, cipherDataMAC = Just mac
|
||||||
|
, cipherDataPadding = Just padding
|
||||||
|
}
|
||||||
CipherStreamF initF _ decryptF -> do
|
CipherStreamF initF _ decryptF -> do
|
||||||
let iv = cstIV cst
|
let iv = cstIV cst
|
||||||
let (content, newiv) = decryptF (if iv /= B.empty then iv else initF writekey) econtent
|
let (content', newiv) = decryptF (if iv /= B.empty then iv else initF writekey) econtent
|
||||||
{- update Ctx -}
|
{- update Ctx -}
|
||||||
|
let contentlen = B.length content' - digestSize
|
||||||
|
let (content, mac, _) = fromJust $ partition3 content' (contentlen, digestSize, 0)
|
||||||
putTLSState $ st { stRxCryptState = Just $ cst { cstIV = newiv } }
|
putTLSState $ st { stRxCryptState = Just $ cst { cstIV = newiv } }
|
||||||
return $ content
|
return $ CipherData
|
||||||
let content =
|
{ cipherDataContent = content
|
||||||
if cipherPaddingSize cipher > 0
|
, cipherDataMAC = Just mac
|
||||||
then
|
, cipherDataPadding = Nothing
|
||||||
let pb = B.last contentpadded + 1 in
|
}
|
||||||
fst $ B.splitAt ((B.length contentpadded) - fromIntegral pb) contentpadded
|
|
||||||
else contentpadded
|
|
||||||
return content
|
|
||||||
|
|
||||||
processCertificates :: [Certificate] -> TLSRead ()
|
processCertificates :: [Certificate] -> TLSRead ()
|
||||||
processCertificates certs = do
|
processCertificates certs = do
|
||||||
|
|
|
@ -12,6 +12,7 @@ module Network.TLS.Struct
|
||||||
, Version(..)
|
, Version(..)
|
||||||
, ConnectionEnd(..)
|
, ConnectionEnd(..)
|
||||||
, CipherType(..)
|
, CipherType(..)
|
||||||
|
, CipherData(..)
|
||||||
, Extension
|
, Extension
|
||||||
, EncryptedData(..)
|
, EncryptedData(..)
|
||||||
, CertificateType(..)
|
, CertificateType(..)
|
||||||
|
@ -52,6 +53,13 @@ data Version = SSL2 | SSL3 | TLS10 | TLS11 | TLS12 deriving (Show, Eq, Ord)
|
||||||
|
|
||||||
data ConnectionEnd = ConnectionServer | ConnectionClient
|
data ConnectionEnd = ConnectionServer | ConnectionClient
|
||||||
data CipherType = CipherStream | CipherBlock | CipherAEAD
|
data CipherType = CipherStream | CipherBlock | CipherAEAD
|
||||||
|
|
||||||
|
data CipherData = CipherData
|
||||||
|
{ cipherDataContent :: Bytes
|
||||||
|
, cipherDataMAC :: Maybe Bytes
|
||||||
|
, cipherDataPadding :: Maybe Bytes
|
||||||
|
} deriving (Show,Eq)
|
||||||
|
|
||||||
data CertificateType =
|
data CertificateType =
|
||||||
CertificateType_RSA_Sign -- TLS10
|
CertificateType_RSA_Sign -- TLS10
|
||||||
| CertificateType_DSS_Sign -- TLS10
|
| CertificateType_DSS_Sign -- TLS10
|
||||||
|
|
Loading…
Reference in a new issue