x509-validation 1.4.7 → 1.4.8
raw patch · 3 files changed
+99/−48 lines, 3 files
Files
- Data/X509/Validation.hs +84/−40
- Data/X509/Validation/Signature.hs +14/−7
- x509-validation.cabal +1/−1
Data/X509/Validation.hs view
@@ -10,10 +10,14 @@ -- Follows RFC5280 / RFC6818 -- module Data.X509.Validation- ( FailedReason(..)+ ( FQHN+ , FailedReason(..)+ , SignatureFailure(..) , Parameters(..) , Checks(..)+ , Hooks(..) , defaultChecks+ , defaultHooks , validate , validateWith , getFingerprint@@ -29,6 +33,9 @@ import Data.Maybe import Data.List +-- | a Fully Qualified Host Name, e.g. www.example.com+type FQHN = String+ -- | Possible reason of certificate and chain failure data FailedReason = UnknownCriticalExtension -- ^ certificate contains an unknown critical extension@@ -38,7 +45,7 @@ | UnknownCA -- ^ unknown Certificate Authority (CA) | NotAllowedToSign -- ^ certificate is not allowed to sign | NotAnAuthority -- ^ not a CA- | InvalidSignature -- ^ signature failed+ | AuthorityTooDeep -- ^ Violation of the optional Basic constraint's path length | NoCommonName -- ^ Certificate doesn't have any common name (CN) | InvalidName String -- ^ Invalid name in certificate | NameMismatch String -- ^ connection name and certificate do not match@@ -47,6 +54,7 @@ | LeafKeyPurposeNotAllowed -- ^ the requested key purpose is not compatible with the leaf certificate's extended key usage | LeafNotV3 -- ^ Only authorized an X509.V3 certificate as leaf certificate. | EmptyChain -- ^ empty chain of certificate+ | InvalidSignature SignatureFailure -- ^ signature failed deriving (Show,Eq) -- | A set of checks to activate or parametrize to perform on certificates.@@ -89,21 +97,40 @@ , checkLeafKeyPurpose :: [ExtKeyUsagePurpose] -- | Check the top certificate names matching the fully qualified hostname (FQHN). -- it's not recommended to turn this check off, if no other name checks are performed.- , checkFQHN :: Maybe String+ , checkFQHN :: Bool } deriving (Show,Eq) --- | Validation parameters+-- | A set of hooks to manipulate the way the verification works.+--+-- BEWARE, it's easy to change behavior leading to compromised security.+data Hooks = Hooks+ {+ -- | check the the issuer 'DistinguishedName' match the subject 'DistinguishedName'+ -- of a certificate.+ hookMatchSubjectIssuer :: DistinguishedName -> Certificate -> Bool+ -- | validate that the parametrized time valide with the certificate in argument+ , hookValidateTime :: UTCTime -> Certificate -> [FailedReason]+ -- | validate the certificate leaf name with the DNS named used to connect+ , hookValidateName :: FQHN -> Certificate -> [FailedReason]+ }++-- | Validation parameters. List all the conditions where/when we want the certificate checks+-- to happen. data Parameters = Parameters- { parameterTime :: UTCTime+ { parameterTime :: UTCTime -- ^ the time when we want the certificate check to happen.+ -- usually should be the time as of now.+ , parameterFQHN :: FQHN -- ^ fqhn to match } deriving (Show,Eq) -- | Default checks to perform ----- It's not recommended to use Nothing as FQDN, doing so--- will ignore an important validation parameter check.-defaultChecks :: Maybe String -- ^ fully qualified host name that we need to match in the certificate- -> Checks-defaultChecks fqhn = Checks+-- The default checks are:+-- * Each certificate time is valid+-- * CA constraints is enforced for signing certificate+-- * Leaf certificate is X.509 v3+-- * Check that the FQHN match+defaultChecks :: Checks+defaultChecks = Checks { checkTimeValidity = True , checkStrictOrdering = False , checkCAConstraints = True@@ -111,25 +138,33 @@ , checkLeafV3 = True , checkLeafKeyUsage = [] , checkLeafKeyPurpose = []- , checkFQHN = fqhn+ , checkFQHN = True } +-- | Default hooks in the validation process+defaultHooks :: Hooks+defaultHooks = Hooks+ { hookMatchSubjectIssuer = matchSI+ , hookValidateTime = validateTime+ , hookValidateName = validateCertificateName+ }+ -- | validate a certificate chain.-validate :: Checks -> CertificateStore -> CertificateChain -> IO [FailedReason]-validate _ _ (CertificateChain []) = return [EmptyChain]-validate checks store cc@(CertificateChain (_:_)) = do- params <- Parameters <$> getCurrentTime- validateWith params store checks cc+validate :: Hooks -> Checks -> CertificateStore -> FQHN -> CertificateChain -> IO [FailedReason]+validate _ _ _ _ (CertificateChain []) = return [EmptyChain]+validate hooks checks store fqhn cc@(CertificateChain (_:_)) = do+ params <- Parameters <$> getCurrentTime <*> pure fqhn+ validateWith params hooks checks store cc -- | Validate a certificate chain with explicit parameters-validateWith :: Parameters -> CertificateStore -> Checks -> CertificateChain -> IO [FailedReason]-validateWith _ _ _ (CertificateChain []) = return [EmptyChain]-validateWith params store checks (CertificateChain (top:rchain)) =+validateWith :: Parameters -> Hooks -> Checks -> CertificateStore -> CertificateChain -> IO [FailedReason]+validateWith _ _ _ _ (CertificateChain []) = return [EmptyChain]+validateWith params hooks checks store (CertificateChain (top:rchain)) = doLeafChecks |> doCheckChain 0 top rchain where isExhaustive = checkExhaustive checks a |> b = exhaustive isExhaustive a b - doLeafChecks = doNameCheck (checkFQHN checks) top |> doV3Check topCert |> doKeyUsageCheck topCert+ doLeafChecks = doNameCheck top |> doV3Check topCert |> doKeyUsageCheck topCert where topCert = getCertificate top doCheckChain :: Int -> SignedCertificate -> [SignedCertificate] -> IO [FailedReason]@@ -144,7 +179,7 @@ case findIssuer (certIssuerDN cert) chain of Nothing -> return [UnknownCA] Just (issuer, remaining) ->- return (checkCA $ getCertificate issuer)+ return (checkCA level $ getCertificate issuer) |> return (checkSignature current issuer) |> doCheckChain (level+1) issuer remaining) where cert = getCertificate current@@ -154,31 +189,40 @@ | checkStrictOrdering checks = case chain of [] -> error "not possible"- (c:cs) | matchSI issuerDN c -> Just (c, cs)- | otherwise -> Nothing+ (c:cs) | matchSubjectIdentifier issuerDN (getCertificate c) -> Just (c, cs)+ | otherwise -> Nothing | otherwise =- (\x -> (x, filter (/= x) chain)) `fmap` find (matchSI issuerDN) chain+ (\x -> (x, filter (/= x) chain)) `fmap` find (matchSubjectIdentifier issuerDN . getCertificate) chain+ matchSubjectIdentifier = hookMatchSubjectIssuer hooks -- we check here that the certificate is allowed to be a certificate -- authority, by checking the BasicConstraint extension. We also check, -- if present the key usage extension for ability to cert sign. If this -- extension is not present, then according to RFC 5280, it's safe to -- assume that only cert sign (and crl sign) are allowed by this certificate.- checkCA :: Certificate -> [FailedReason]- checkCA cert- | allowedSign && allowedCA = []- | otherwise = (if allowedSign then [] else [NotAllowedToSign])- ++ (if allowedCA then [] else [NotAnAuthority])+ checkCA :: Int -> Certificate -> [FailedReason]+ checkCA level cert+ | not (checkCAConstraints checks) = []+ | and [allowedSign,allowedCA,allowedDepth] = []+ | otherwise = (if allowedSign then [] else [NotAllowedToSign])+ ++ (if allowedCA then [] else [NotAnAuthority])+ ++ (if allowedDepth then [] else [AuthorityTooDeep]) where extensions = certExtensions cert allowedSign = case extensionGet extensions of Just (ExtKeyUsage flags) -> KeyUsage_keyCertSign `elem` flags Nothing -> True- allowedCA = case extensionGet extensions of- Just (ExtBasicConstraints True _) -> True- _ -> False+ (allowedCA,pathLen) = case extensionGet extensions of+ Just (ExtBasicConstraints True pl) -> (True, pl)+ _ -> (False, Nothing)+ allowedDepth = case pathLen of+ Nothing -> True+ Just pl | fromIntegral pl >= level -> True+ | otherwise -> False - doNameCheck Nothing _ = return []- doNameCheck (Just fqhn) cert = return (validateCertificateName fqhn (getCertificate cert))+ doNameCheck cert+ | not (checkFQHN checks) = return []+ | otherwise = return $ (hookValidateName hooks) fqhn (getCertificate cert)+ where fqhn = parameterFQHN params doV3Check cert | checkLeafV3 checks = case certVersion cert of@@ -206,7 +250,7 @@ doCheckCertificate cert = exhaustiveList (checkExhaustive checks)- [ (checkTimeValidity checks, return (validateTime (parameterTime params) cert))+ [ (checkTimeValidity checks, return ((hookValidateTime hooks) (parameterTime params) cert)) ] isSelfSigned :: Certificate -> Bool isSelfSigned cert = certSubjectDN cert == certIssuerDN cert@@ -214,8 +258,8 @@ -- check signature of 'signedCert' against the 'signingCert' checkSignature signedCert signingCert = case verifySignedSignature signedCert (certPubKey $ getCertificate signingCert) of- SignaturePass -> []- _ -> [InvalidSignature]+ SignaturePass -> []+ SignatureFailed r -> [InvalidSignature r] -- | Validate that the current time is between validity bounds validateTime :: UTCTime -> Certificate -> [FailedReason]@@ -236,7 +280,7 @@ -- | Validate that the fqhn is matched by at least one name in the certificate. -- The name can be either the common name or one of the alternative names if -- the SubjectAltName extension is present.-validateCertificateName :: String -> Certificate -> [FailedReason]+validateCertificateName :: FQHN -> Certificate -> [FailedReason] validateCertificateName fqhn cert = case commonName of Nothing -> [NoCommonName]@@ -277,8 +321,8 @@ -- | return true if the 'subject' certificate's issuer match -- the 'issuer' certificate's subject-matchSI :: DistinguishedName -> SignedCertificate -> Bool-matchSI issuerDN issuer = certSubjectDN (getCertificate issuer) == issuerDN+matchSI :: DistinguishedName -> Certificate -> Bool+matchSI issuerDN issuer = certSubjectDN issuer == issuerDN exhaustive :: Monad m => Bool -> m [FailedReason] -> m [FailedReason] -> m [FailedReason] exhaustive isExhaustive f1 f2 = f1 >>= cont
Data/X509/Validation/Signature.hs view
@@ -11,6 +11,7 @@ ( verifySignedSignature , verifySignature , SignatureVerification(..)+ , SignatureFailure(..) ) where import qualified Crypto.PubKey.RSA.PKCS15 as RSA@@ -26,14 +27,20 @@ -- | A set of possible return from signature verification. ----- Only SignaturePass should be accepted as success.+-- When SignatureFailed is return, the signature shouldn't be+-- accepted. -- -- Other values are only useful to differentiate the failure -- reason, but are all equivalent to failure. -- data SignatureVerification =- SignaturePass -- ^ verification succeeded- | SignatureFailed -- ^ verification failed+ SignaturePass -- ^ verification succeeded+ | SignatureFailed SignatureFailure -- ^ verification failed+ deriving (Show,Eq)++-- | Various failure possible during signature checking+data SignatureFailure =+ SignatureInvalid -- ^ signature doesn't verify | SignaturePubkeyMismatch -- ^ algorithm and public key mismatch, cannot proceed | SignatureUnimplemented -- ^ unimplemented signature algorithm deriving (Show,Eq)@@ -56,14 +63,14 @@ -> ByteString -- ^ Certificate data that need to be verified -> ByteString -- ^ Signature to verify -> SignatureVerification-verifySignature (SignatureALG_Unknown _) _ _ _ = SignatureUnimplemented+verifySignature (SignatureALG_Unknown _) _ _ _ = SignatureFailed SignatureUnimplemented verifySignature (SignatureALG hashALG pubkeyALG) pubkey cdata signature | pubkeyToAlg pubkey == pubkeyALG = case verifyF pubkey of- Nothing -> SignatureUnimplemented+ Nothing -> SignatureFailed SignatureUnimplemented Just f -> if f cdata signature then SignaturePass- else SignatureFailed- | otherwise = SignaturePubkeyMismatch+ else SignatureFailed SignatureInvalid+ | otherwise = SignatureFailed SignaturePubkeyMismatch where verifyF (PubKeyRSA key) = Just $ RSA.verify (toDescr hashALG) key verifyF (PubKeyDSA key)
x509-validation.cabal view
@@ -1,5 +1,5 @@ Name: x509-validation-Version: 1.4.7+Version: 1.4.8 Description: X.509 Certificate and CRL validation License: BSD3 License-file: LICENSE