cleanup CertificateVerify signature data generation
This commit is contained in:
parent
0a032bbc27
commit
ad37d02523
3 changed files with 35 additions and 40 deletions
|
@ -155,32 +155,21 @@ sendClientData cparams ctx = sendCertificate >> sendClientKeyXchg >> sendCertifi
|
||||||
certSent <- usingHState ctx $ getClientCertSent
|
certSent <- usingHState ctx $ getClientCertSent
|
||||||
case certSent of
|
case certSent of
|
||||||
True -> do
|
True -> do
|
||||||
-- Fetch all handshake messages up to now.
|
|
||||||
msgs <- usingHState ctx $ B.concat <$> getHandshakeMessages
|
|
||||||
|
|
||||||
(malg, hashMethod, toSign) <- case usedVersion of
|
malg <- case usedVersion of
|
||||||
SSL3 -> do
|
TLS12 -> do
|
||||||
Just masterSecret <- usingHState ctx $ gets hstMasterSecret
|
|
||||||
let digest = generateCertificateVerify_SSL masterSecret (hashUpdate (hashInit hashMD5SHA1) msgs)
|
|
||||||
hsh = HashDescr id id
|
|
||||||
return (Nothing, hsh, digest)
|
|
||||||
|
|
||||||
x | x == TLS10 || x == TLS11 -> do
|
|
||||||
let hashf bs = hashFinal (hashUpdate (hashInit hashMD5SHA1) bs)
|
|
||||||
hsh = HashDescr hashf id
|
|
||||||
return (Nothing, hsh, msgs)
|
|
||||||
|
|
||||||
_ -> do
|
|
||||||
Just (_, Just hashSigs, _) <- usingHState ctx $ getClientCertRequest
|
Just (_, Just hashSigs, _) <- usingHState ctx $ getClientCertRequest
|
||||||
let suppHashSigs = pHashSignatures $ ctxParams ctx
|
let suppHashSigs = pHashSignatures $ ctxParams ctx
|
||||||
hashSigs' = filter (\ a -> a `elem` hashSigs) suppHashSigs
|
hashSigs' = filter (\ a -> a `elem` hashSigs) suppHashSigs
|
||||||
|
|
||||||
when (null hashSigs') $ do
|
when (null hashSigs') $
|
||||||
throwCore $ Error_Protocol ("no hash/signature algorithms in common with the server", True, HandshakeFailure)
|
throwCore $ Error_Protocol ("no hash/signature algorithms in common with the server", True, HandshakeFailure)
|
||||||
|
return $ Just $ head hashSigs'
|
||||||
|
_ -> return Nothing
|
||||||
|
|
||||||
let hashSig = head hashSigs'
|
-- Fetch all handshake messages up to now.
|
||||||
hsh <- getHashAndASN1 hashSig
|
msgs <- usingHState ctx $ B.concat <$> getHandshakeMessages
|
||||||
return (Just hashSig, hsh, msgs)
|
(hashMethod, toSign) <- prepareCertificateVerifySignatureData ctx usedVersion malg msgs
|
||||||
|
|
||||||
sigDig <- signRSA ctx hashMethod toSign
|
sigDig <- signRSA ctx hashMethod toSign
|
||||||
sendPacket ctx $ Handshake [CertVerify malg (CertVerifyData sigDig)]
|
sendPacket ctx $ Handshake [CertVerify malg (CertVerifyData sigDig)]
|
||||||
|
|
|
@ -11,13 +11,11 @@ module Network.TLS.Handshake.Server
|
||||||
, handshakeServerWith
|
, handshakeServerWith
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Network.TLS.Crypto
|
|
||||||
import Network.TLS.Context
|
import Network.TLS.Context
|
||||||
import Network.TLS.Session
|
import Network.TLS.Session
|
||||||
import Network.TLS.Struct
|
import Network.TLS.Struct
|
||||||
import Network.TLS.Cipher
|
import Network.TLS.Cipher
|
||||||
import Network.TLS.Compression
|
import Network.TLS.Compression
|
||||||
import Network.TLS.Packet
|
|
||||||
import Network.TLS.Extension
|
import Network.TLS.Extension
|
||||||
import Network.TLS.Util (catchException)
|
import Network.TLS.Util (catchException)
|
||||||
import Network.TLS.IO
|
import Network.TLS.IO
|
||||||
|
@ -255,29 +253,13 @@ recvClientData sparams ctx = runRecvState ctx (RecvStateHandshake processClientC
|
||||||
|
|
||||||
checkValidClientCertChain "change cipher message expected"
|
checkValidClientCertChain "change cipher message expected"
|
||||||
|
|
||||||
|
usedVersion <- usingState_ ctx getVersion
|
||||||
-- Fetch all handshake messages up to now.
|
-- Fetch all handshake messages up to now.
|
||||||
msgs <- usingHState ctx $ B.concat <$> getHandshakeMessages
|
msgs <- usingHState ctx $ B.concat <$> getHandshakeMessages
|
||||||
|
(hashMethod, toSign) <- prepareCertificateVerifySignatureData ctx usedVersion mbHashSig msgs
|
||||||
usedVersion <- usingState_ ctx getVersion
|
|
||||||
|
|
||||||
(signature, hsh) <- case usedVersion of
|
|
||||||
SSL3 -> do
|
|
||||||
Just masterSecret <- usingHState ctx $ gets hstMasterSecret
|
|
||||||
let digest = generateCertificateVerify_SSL masterSecret (hashUpdate (hashInit hashMD5SHA1) msgs)
|
|
||||||
hsh = HashDescr id id
|
|
||||||
return (digest, hsh)
|
|
||||||
|
|
||||||
x | x == TLS10 || x == TLS11 -> do
|
|
||||||
let hashf bs' = hashFinal (hashUpdate (hashInit hashMD5SHA1) bs')
|
|
||||||
hsh = HashDescr hashf id
|
|
||||||
return (msgs,hsh)
|
|
||||||
_ -> do
|
|
||||||
let Just sentHashSig = mbHashSig
|
|
||||||
hsh <- getHashAndASN1 sentHashSig
|
|
||||||
return (msgs,hsh)
|
|
||||||
|
|
||||||
-- Verify the signature.
|
-- Verify the signature.
|
||||||
verif <- verifyRSA ctx hsh signature bs
|
verif <- verifyRSA ctx hashMethod toSign bs
|
||||||
|
|
||||||
case verif of
|
case verif of
|
||||||
True -> do
|
True -> do
|
||||||
|
|
|
@ -8,11 +8,15 @@
|
||||||
--
|
--
|
||||||
module Network.TLS.Handshake.Signature
|
module Network.TLS.Handshake.Signature
|
||||||
( getHashAndASN1
|
( getHashAndASN1
|
||||||
|
, prepareCertificateVerifySignatureData
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Crypto.PubKey.HashDescr
|
import Crypto.PubKey.HashDescr
|
||||||
|
import Network.TLS.Crypto
|
||||||
import Network.TLS.Context
|
import Network.TLS.Context
|
||||||
import Network.TLS.Struct
|
import Network.TLS.Struct
|
||||||
|
import Network.TLS.Packet (generateCertificateVerify_SSL)
|
||||||
|
import Network.TLS.Handshake.State
|
||||||
|
|
||||||
import Control.Monad.State
|
import Control.Monad.State
|
||||||
|
|
||||||
|
@ -24,3 +28,23 @@ getHashAndASN1 hashSig = case hashSig of
|
||||||
(HashSHA384, SignatureRSA) -> return hashDescrSHA384
|
(HashSHA384, SignatureRSA) -> return hashDescrSHA384
|
||||||
(HashSHA512, SignatureRSA) -> return hashDescrSHA512
|
(HashSHA512, SignatureRSA) -> return hashDescrSHA512
|
||||||
_ -> throwCore $ Error_Misc "unsupported hash/sig algorithm"
|
_ -> throwCore $ Error_Misc "unsupported hash/sig algorithm"
|
||||||
|
|
||||||
|
prepareCertificateVerifySignatureData :: Context
|
||||||
|
-> Version
|
||||||
|
-> Maybe (HashAlgorithm, SignatureAlgorithm)
|
||||||
|
-> Bytes
|
||||||
|
-> IO (HashDescr, Bytes)
|
||||||
|
prepareCertificateVerifySignatureData ctx usedVersion malg msgs
|
||||||
|
| usedVersion == SSL3 = do
|
||||||
|
Just masterSecret <- usingHState ctx $ gets hstMasterSecret
|
||||||
|
let digest = generateCertificateVerify_SSL masterSecret (hashUpdate (hashInit hashMD5SHA1) msgs)
|
||||||
|
hsh = HashDescr id id
|
||||||
|
return (hsh, digest)
|
||||||
|
| usedVersion == TLS10 || usedVersion == TLS11 = do
|
||||||
|
let hashf bs = hashFinal (hashUpdate (hashInit hashMD5SHA1) bs)
|
||||||
|
hsh = HashDescr hashf id
|
||||||
|
return (hsh, msgs)
|
||||||
|
| otherwise = do
|
||||||
|
let Just hashSig = malg
|
||||||
|
hsh <- getHashAndASN1 hashSig
|
||||||
|
return (hsh, msgs)
|
||||||
|
|
Loading…
Reference in a new issue