check that a certificate has the ability to actually sign another certificate.
this is done basically by verifying that the CA is set in basic constraints, and then that the key usage allow certificate signing.
This commit is contained in:
parent
0b51f14b80
commit
15885c0649
1 changed files with 24 additions and 8 deletions
|
@ -28,7 +28,7 @@ import qualified Crypto.PubKey.RSA.PKCS15 as RSA
|
|||
import qualified Crypto.PubKey.DSA as DSA
|
||||
|
||||
import Data.CertificateStore
|
||||
import Data.Certificate.X509.Cert (oidCommonName, extensionGet, certExtensions)
|
||||
import Data.Certificate.X509.Cert (oidCommonName)
|
||||
import Network.TLS (CertificateUsage(..), CertificateRejectReason(..))
|
||||
|
||||
import Data.Time.Calendar
|
||||
|
@ -73,15 +73,31 @@ certificateVerifyChain_ store (x:xs) =
|
|||
validChain <- certificateVerifyAgainst x sysx509
|
||||
if validChain
|
||||
then return CertificateUsageAccept
|
||||
else return $ CertificateUsageReject (CertificateRejectOther "chain doesn't match each other")
|
||||
else return certificateChainDoesntMatch
|
||||
Nothing ->
|
||||
case xs of
|
||||
[] -> return $ CertificateUsageReject CertificateRejectUnknownCA
|
||||
_ -> do
|
||||
validChain <- certificateVerifyAgainst x (head xs)
|
||||
cert:_ -> do
|
||||
let exts = certExtensions (x509Cert cert)
|
||||
case checkCA exts of
|
||||
Just r -> return r
|
||||
Nothing -> do
|
||||
validChain <- certificateVerifyAgainst x cert
|
||||
if validChain
|
||||
then certificateVerifyChain_ store xs
|
||||
else return $ CertificateUsageReject (CertificateRejectOther "chain doesn't match each other")
|
||||
else return certificateChainDoesntMatch
|
||||
where checkCA Nothing = return $ certificateNotAllowedToSign
|
||||
checkCA (Just es) = do
|
||||
let kuCanCertSign = case extensionGet es of
|
||||
Just (ExtKeyUsage l) -> elem KeyUsage_keyCertSign l
|
||||
Nothing -> False
|
||||
case extensionGet es of
|
||||
Just (ExtBasicConstraints True _)
|
||||
| kuCanCertSign -> Nothing
|
||||
| otherwise -> Just certificateNotAllowedToSign
|
||||
_ -> Just certificateNotAllowedToSign
|
||||
certificateNotAllowedToSign = CertificateUsageReject $ CertificateRejectOther "certificate is not allowed to sign another certificate"
|
||||
certificateChainDoesntMatch = CertificateUsageReject $ CertificateRejectOther "chain doesn't match each other"
|
||||
#endif
|
||||
|
||||
-- | verify a certificates chain using the system certificates available.
|
||||
|
|
Loading…
Reference in a new issue