x509-validation-1.4.6/0000755000000000000000000000000012245300533012542 5ustar0000000000000000x509-validation-1.4.6/LICENSE0000644000000000000000000000273112245300533013552 0ustar0000000000000000Copyright (c) 2010-2013 Vincent Hanquez All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. 3. Neither the name of the author nor the names of his contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. x509-validation-1.4.6/x509-validation.cabal0000644000000000000000000000276512245300533016375 0ustar0000000000000000Name: x509-validation Version: 1.4.6 Description: X.509 Certificate and CRL validation License: BSD3 License-file: LICENSE Copyright: Vincent Hanquez Author: Vincent Hanquez Maintainer: Vincent Hanquez Synopsis: X.509 Certificate and CRL validation Build-Type: Simple Category: Data stability: experimental Homepage: http://github.com/vincenthz/hs-certificate Cabal-Version: >=1.6 Library Build-Depends: base >= 3 && < 5 , bytestring , mtl , containers , directory , filepath , process , time , pem >= 0.1 && < 0.3 , asn1-types >= 0.2 && < 0.3 , asn1-encoding >= 0.8 && < 0.9 , x509 >= 1.4.2 && < 1.5 , x509-store >= 1.4 && < 1.5 , crypto-pubkey >= 0.1.4 && < 0.3 , crypto-pubkey-types >= 0.4 && < 0.5 , cryptohash >= 0.9 && < 0.12 Exposed-modules: Data.X509.Validation Other-modules: Data.X509.Validation.Signature Data.X509.Validation.Fingerprint ghc-options: -Wall source-repository head type: git location: git://github.com/vincenthz/hs-certificate subdir: x509-validation x509-validation-1.4.6/Setup.hs0000644000000000000000000000005612245300533014177 0ustar0000000000000000import Distribution.Simple main = defaultMain x509-validation-1.4.6/Data/0000755000000000000000000000000012245300533013413 5ustar0000000000000000x509-validation-1.4.6/Data/X509/0000755000000000000000000000000012245300533014060 5ustar0000000000000000x509-validation-1.4.6/Data/X509/Validation.hs0000644000000000000000000003237512245300533016520 0ustar0000000000000000-- | -- Module : Data.X509.Validation -- License : BSD-style -- Maintainer : Vincent Hanquez -- Stability : experimental -- Portability : unknown -- -- X.509 Certificate checks and validations routines -- -- Follows RFC5280 / RFC6818 -- module Data.X509.Validation ( FailedReason(..) , Parameters(..) , Checks(..) , defaultChecks , validate , validateWith , getFingerprint ) where import Control.Applicative import Data.ASN1.Types import Data.X509 import Data.X509.CertificateStore import Data.X509.Validation.Signature import Data.X509.Validation.Fingerprint import Data.Time.Clock import Data.Maybe import Data.List -- | Possible reason of certificate and chain failure data FailedReason = UnknownCriticalExtension -- ^ certificate contains an unknown critical extension | Expired -- ^ validity ends before checking time | InFuture -- ^ validity starts after checking time | SelfSigned -- ^ certificate is self signed | UnknownCA -- ^ unknown Certificate Authority (CA) | NotAllowedToSign -- ^ certificate is not allowed to sign | NotAnAuthority -- ^ not a CA | InvalidSignature -- ^ signature failed | NoCommonName -- ^ Certificate doesn't have any common name (CN) | InvalidName String -- ^ Invalid name in certificate | NameMismatch String -- ^ connection name and certificate do not match | InvalidWildcard -- ^ invalid wildcard in certificate | LeafKeyUsageNotAllowed -- ^ the requested key usage is not compatible with the leaf certificate's key usage | LeafNotV3 -- ^ Only authorized an X509.V3 certificate as leaf certificate. | EmptyChain -- ^ empty chain of certificate deriving (Show,Eq) -- | A set of checks to activate or parametrize to perform on certificates. -- -- It's recommended to use 'defaultChecks' to create the structure, -- to better cope with future changes or expansion of the structure. data Checks = Checks { -- | check time validity of every certificate in the chain. -- the make sure that current time is between each validity bounds -- in the certificate checkTimeValidity :: Bool -- | Check that no certificate is included that shouldn't be included. -- unfortunately despite the specification violation, a lots of -- real world server serves useless and usually old certificates -- that are not relevant to the certificate sent, in their chain. , checkStrictOrdering :: Bool -- | Check that signing certificate got the CA basic constraint. -- this is absolutely not recommended to turn it off. , checkCAConstraints :: Bool -- | Check the whole certificate chain without stopping at the first failure. -- Allow gathering a exhaustive list of failure reasons. if this is -- turn off, it's absolutely not safe to ignore a failed reason even it doesn't look serious -- (e.g. Expired) as other more serious checks would not have been performed. , checkExhaustive :: Bool -- | Check that the leaf certificate is version 3. If disable, version 2 certificate -- is authorized in leaf position and key usage cannot be checked. , checkLeafV3 :: Bool -- | Check that the leaf certificate is authorized to be used for certain usage. -- If set to empty list no check are performed, otherwise all the flags is the list -- need to exists in the key usage extension , checkLeafKeyUsage :: [ExtKeyUsageFlag] -- | 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 } deriving (Show,Eq) -- | Validation parameters data Parameters = Parameters { parameterTime :: UTCTime } 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 { checkTimeValidity = True , checkStrictOrdering = False , checkCAConstraints = True , checkExhaustive = False , checkLeafV3 = True , checkLeafKeyUsage = [KeyUsage_keyEncipherment] , checkFQHN = fqhn } -- | 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 a certificate chain with explicit parameters validateWith :: Parameters -> CertificateStore -> Checks -> CertificateChain -> IO [FailedReason] validateWith _ _ _ (CertificateChain []) = return [EmptyChain] validateWith params store checks (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 where topCert = getCertificate top doCheckChain :: Int -> SignedCertificate -> [SignedCertificate] -> IO [FailedReason] doCheckChain level current chain = do r <- doCheckCertificate (getCertificate current) -- check if we have a trusted certificate in the store belonging to this issuer. return r |> (case findCertificate (certIssuerDN cert) store of Just trustedSignedCert -> return $ checkSignature current trustedSignedCert Nothing | isSelfSigned cert -> return [SelfSigned] |> return (checkSignature current current) | null chain -> return [UnknownCA] | otherwise -> case findIssuer (certIssuerDN cert) chain of Nothing -> return [UnknownCA] Just (issuer, remaining) -> return (checkCA $ getCertificate issuer) |> return (checkSignature current issuer) |> doCheckChain (level+1) issuer remaining) where cert = getCertificate current -- in a strict ordering check the next certificate has to be the issuer. -- otherwise we dynamically reorder the chain to have the necessary certificate findIssuer issuerDN chain | checkStrictOrdering checks = case chain of [] -> error "not possible" (c:cs) | matchSI issuerDN c -> Just (c, cs) | otherwise -> Nothing | otherwise = (\x -> (x, filter (/= x) chain)) `fmap` find (matchSI issuerDN) chain -- 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]) 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 doNameCheck Nothing _ = return [] doNameCheck (Just fqhn) cert = return (validateCertificateName fqhn (getCertificate cert)) doV3Check cert | checkLeafV3 checks = case certVersion cert of 2 {- confusingly it means X509.V3 -} -> return [] _ -> return [LeafNotV3] | otherwise = return [] doKeyUsageCheck cert = return $ case (certVersion cert, checkLeafKeyUsage checks) of (2, usage) -> if intersect usage flags == usage then [] else [LeafKeyUsageNotAllowed] _ -> [] where flags = case extensionGet $ certExtensions cert of Just (ExtKeyUsage keyflags) -> keyflags Nothing -> [] doCheckCertificate cert = exhaustiveList (checkExhaustive checks) [ (checkTimeValidity checks, return (validateTime (parameterTime params) cert)) ] isSelfSigned :: Certificate -> Bool isSelfSigned cert = certSubjectDN cert == certIssuerDN cert -- check signature of 'signedCert' against the 'signingCert' checkSignature signedCert signingCert = case verifySignedSignature signedCert (certPubKey $ getCertificate signingCert) of SignaturePass -> [] _ -> [InvalidSignature] -- | Validate that the current time is between validity bounds validateTime :: UTCTime -> Certificate -> [FailedReason] validateTime currentTime cert | currentTime < before = [InFuture] | currentTime > after = [Expired] | otherwise = [] where (before, after) = certValidity cert getNames :: Certificate -> (Maybe String, [String]) getNames cert = (commonName >>= asn1CharacterToString, altNames) where commonName = getDnElement DnCommonName $ certSubjectDN cert altNames = maybe [] toAltName $ extensionGet $ certExtensions cert toAltName (ExtSubjectAltName names) = catMaybes $ map unAltName names where unAltName (AltNameDNS s) = Just s unAltName _ = Nothing -- | 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 cert = case commonName of Nothing -> [NoCommonName] Just cn -> findMatch [] $ map (matchDomain . splitDot) (cn : altNames) where (commonName, altNames) = getNames cert findMatch :: [FailedReason] -> [[FailedReason]] -> [FailedReason] findMatch _ [] = [NameMismatch fqhn] findMatch _ ([]:_) = [] findMatch acc (_ :xs) = findMatch acc xs matchDomain :: [String] -> [FailedReason] matchDomain l | length (filter (== "") l) > 0 = [InvalidName (intercalate "." l)] | head l == "*" = wildcardMatch (reverse $ drop 1 l) | l == splitDot fqhn = [] -- success: we got a match | otherwise = [NameMismatch fqhn] -- only 1 wildcard is valid, and if multiples are present -- they won't have a wildcard meaning but will be match as normal star -- character to the fqhn and inevitably will fail. -- -- e.g. *.*.server.com will try to litteraly match the '*' subdomain of server.com wildcardMatch l -- .com or is always invalid | length l < 2 = [InvalidWildcard] -- some TLD like .uk got small subTLS like (.co.uk), and we don't want to accept *.co.uk | length (head l) <= 2 && length (head $ drop 1 l) <= 3 && length l < 3 = [InvalidWildcard] | l == take (length l) (reverse $ splitDot fqhn) = [] -- success: we got a match | otherwise = [NameMismatch fqhn] splitDot :: String -> [String] splitDot [] = [""] splitDot x = let (y, z) = break (== '.') x in y : (if z == "" then [] else splitDot $ drop 1 z) -- | 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 exhaustive :: Monad m => Bool -> m [FailedReason] -> m [FailedReason] -> m [FailedReason] exhaustive isExhaustive f1 f2 = f1 >>= cont where cont l1 | null l1 = f2 | isExhaustive = f2 >>= \l2 -> return (l1 ++ l2) | otherwise = return l1 exhaustiveList :: Monad m => Bool -> [(Bool, m [FailedReason])] -> m [FailedReason] exhaustiveList _ [] = return [] exhaustiveList isExhaustive ((performCheck,c):cs) | performCheck = exhaustive isExhaustive c (exhaustiveList isExhaustive cs) | otherwise = exhaustiveList isExhaustive cs x509-validation-1.4.6/Data/X509/Validation/0000755000000000000000000000000012245300533016152 5ustar0000000000000000x509-validation-1.4.6/Data/X509/Validation/Fingerprint.hs0000644000000000000000000000225712245300533021003 0ustar0000000000000000-- | -- Module : Data.X509.Validation.Fingerprint -- License : BSD-style -- Maintainer : Vincent Hanquez -- Stability : experimental -- Portability : unknown -- module Data.X509.Validation.Fingerprint ( getFingerprint , toDescr ) where import Crypto.PubKey.HashDescr import Data.X509 import Data.ASN1.Types import Data.ByteString (ByteString) -- | Get the fingerprint of the whole signed object -- using the hashing algorithm specified getFingerprint :: (Show a, Eq a, ASN1Object a) => SignedExact a -- ^ object to fingerprint -> HashALG -- ^ algorithm to compute the fingerprint -> ByteString -- ^ fingerprint in binary form getFingerprint sobj halg = hashF $ encodeSignedObject sobj where hashDescr = toDescr halg hashF = hashFunction hashDescr -- | Convert a hash algorithm into a Hash Description toDescr :: HashALG -> HashDescr toDescr HashMD2 = hashDescrMD2 toDescr HashMD5 = hashDescrMD5 toDescr HashSHA1 = hashDescrSHA1 toDescr HashSHA224 = hashDescrSHA224 toDescr HashSHA256 = hashDescrSHA256 toDescr HashSHA384 = hashDescrSHA384 toDescr HashSHA512 = hashDescrSHA512 x509-validation-1.4.6/Data/X509/Validation/Signature.hs0000644000000000000000000000652112245300533020453 0ustar0000000000000000-- | -- Module : Data.X509.Validation.Signature -- License : BSD-style -- Maintainer : Vincent Hanquez -- Stability : experimental -- Portability : unknown -- -- X.509 Certificate and CRL signature verification -- module Data.X509.Validation.Signature ( verifySignedSignature , verifySignature , SignatureVerification(..) ) where import qualified Crypto.PubKey.RSA.PKCS15 as RSA import qualified Crypto.PubKey.DSA as DSA import qualified Crypto.Hash.SHA1 as SHA1 import Data.ByteString (ByteString) import Data.X509 import Data.X509.Validation.Fingerprint import Data.ASN1.Types import Data.ASN1.Encoding import Data.ASN1.BinaryEncoding -- | A set of possible return from signature verification. -- -- Only SignaturePass should be accepted as success. -- -- Other values are only useful to differentiate the failure -- reason, but are all equivalent to failure. -- data SignatureVerification = SignaturePass -- ^ verification succeeded | SignatureFailed -- ^ verification failed | SignaturePubkeyMismatch -- ^ algorithm and public key mismatch, cannot proceed | SignatureUnimplemented -- ^ unimplemented signature algorithm deriving (Show,Eq) -- | Verify a Signed object against a specified public key verifySignedSignature :: (Show a, Eq a, ASN1Object a) => SignedExact a -> PubKey -> SignatureVerification verifySignedSignature signedObj pubKey = verifySignature (signedAlg signed) pubKey (getSignedData signedObj) (signedSignature signed) where signed = getSigned signedObj -- | verify signature using parameter verifySignature :: SignatureALG -- ^ Signature algorithm used -> PubKey -- ^ Public key to use for verify -> ByteString -- ^ Certificate data that need to be verified -> ByteString -- ^ Signature to verify -> SignatureVerification verifySignature (SignatureALG_Unknown _) _ _ _ = SignatureUnimplemented verifySignature (SignatureALG hashALG pubkeyALG) pubkey cdata signature | pubkeyToAlg pubkey == pubkeyALG = case verifyF pubkey of Nothing -> SignatureUnimplemented Just f -> if f cdata signature then SignaturePass else SignatureFailed | otherwise = SignaturePubkeyMismatch where verifyF (PubKeyRSA key) = Just $ RSA.verify (toDescr hashALG) key verifyF (PubKeyDSA key) | hashALG == HashSHA1 = Just $ \a b -> case dsaToSignature a of Nothing -> False Just dsaSig -> DSA.verify SHA1.hash key dsaSig b | otherwise = Nothing verifyF _ = Nothing dsaToSignature :: ByteString -> Maybe DSA.Signature dsaToSignature b = case decodeASN1' BER b of Left _ -> Nothing Right asn1 -> case fromASN1 asn1 of Left _ -> Nothing Right (dsaSig, _) -> Just dsaSig