crypton-x509-validation 1.6.13 → 1.6.14
raw patch · 3 files changed
+144/−5 lines, 3 filesdep +iproutePVP ok
version bump matches the API change (PVP)
Dependencies added: iproute
API changes (from Hackage documentation)
+ Data.X509.Validation: instance GHC.Classes.Eq Data.X509.Validation.IPAddress
Files
- Data/X509/Validation.hs +53/−4
- Tests/Tests.hs +89/−0
- crypton-x509-validation.cabal +2/−1
Data/X509/Validation.hs view
@@ -1,3 +1,6 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ViewPatterns #-}+ -- | -- Module : Data.X509.Validation -- License : BSD-style@@ -35,14 +38,17 @@ module Data.X509.Validation.Signature, ) where -import Control.Applicative import Control.Monad (when) import Data.ASN1.Types+import Data.Bits+import Data.ByteString (unpack) import Data.Char (toLower) import Data.Default import Data.Hourglass+import Data.IP (IPv4, IPv6, toIPv4, toIPv6) import Data.List import Data.Maybe+import Data.Word (Word8) import Data.X509 import Data.X509.CertificateStore import Data.X509.Validation.Cache@@ -50,6 +56,7 @@ import Data.X509.Validation.Signature import Data.X509.Validation.Types import System.Hourglass+import Text.Read (readMaybe) -- | Possible reason of certificate and chain failure. --@@ -403,10 +410,47 @@ unAltName (AltNameDNS s) = Just s unAltName _ = Nothing +data IPAddress+ = IPv4Address IPv4+ | IPv6Address IPv6+ deriving (Eq)++getIPs :: Certificate -> [IPAddress]+getIPs cert = fromMaybe [] (toAltName <$> (extensionGet $ certExtensions cert))+ where+ toAltName (ExtSubjectAltName names) = catMaybes $ map unAltName names++ unAltName (AltNameIP s) = case unpack s of+ [a, b, c, d] -> Just $ IPv4Address $ toIPv4 $ fmap fromIntegral [a, b, c, d]+ [a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p] ->+ Just $+ IPv6Address $+ toIPv6+ [ fuse a b+ , fuse c d+ , fuse e f+ , fuse g h+ , fuse i j+ , fuse k l+ , fuse m n+ , fuse o p+ ]+ _ -> Nothing+ unAltName _ = Nothing++ fuse :: Word8 -> Word8 -> Int+ fuse a b = shiftL (fromIntegral a) 8 .|. (fromIntegral b)++parseIPAddress :: HostName -> Maybe IPAddress+parseIPAddress (readMaybe -> Just ipV4) = Just $ IPv4Address ipV4+parseIPAddress (readMaybe -> Just ipV6) = Just $ IPv6Address ipV6+parseIPAddress _ = Nothing+ -- | Validate that the fqhn is matched by at least one name in the certificate. -- If the subjectAltname extension is present, then the certificate commonName--- is ignored, and only the DNS names, if any, in the subjectAltName are--- considered. Otherwise, the commonName from the subjectDN is used.+-- is ignored, and only the DNS names and IP Addresses, if any, in the+-- subjectAltName are considered. Otherwise, the commonName from the subjectDN+-- is used. -- -- Note that DNS names in the subjectAltName are in IDNA A-label form. If the -- destination hostname is a UTF-8 name, it must be provided to the TLS context@@ -414,7 +458,12 @@ validateCertificateName :: HostName -> Certificate -> [FailedReason] validateCertificateName fqhn cert | not $ null altNames =- findMatch [] $ map matchDomain altNames+ case parseIPAddress fqhn of+ Nothing -> findMatch [] $ map matchDomain altNames+ Just ip ->+ if elem ip (getIPs cert)+ then []+ else [NameMismatch fqhn] | otherwise = case commonName of Nothing -> [NoCommonName]
Tests/Tests.hs view
@@ -17,6 +17,8 @@ import Data.X509.CertificateStore import Data.X509.Validation +import qualified Data.ByteString as BS+ import Data.Hourglass import System.Hourglass @@ -513,6 +515,47 @@ , AltNameDNS "dummy2" ] +-- | Tests certificate SubjectAltName against expected IP Address, with or+-- without 'checkFQHN'.+testSubjectAltNameIP+ :: IO (RData pub priv)+ -- ^ Common test resources+ -> BS.ByteString+ -- ^ Certificate SubjectAltName+ -> HostName+ -- ^ Connection identification+ -> Bool+ -- ^ Value for 'checkFQHN'+ -> [FailedReason]+ -- ^ Expected validation result+ -> TestTree+testSubjectAltNameIP res ip hostname check expected = testWithRes res caseName $ \rd -> do+ pair <-+ mkCertificate+ 2+ 100+ dn+ (present rd)+ (ext : leafStdExts)+ (CA $ intermediate rd)+ (keys1 rd)+ assertValidationResult rd checks hostname [pair, intermediate rd] expected+ where+ caseName = if null hostname then "empty" else hostname+ checks = defaultChecks{checkFQHN = check}+ dn = mkDn "cn-not-used" -- this CN value is to be tested too+ -- (to make sure CN is *not* considered when a+ -- SubjectAltName exists)+ ext =+ mkExtension False $+ -- wraps test value with other values+ ExtSubjectAltName+ [ AltNameDNS "dummy1"+ , AltNameRFC822 "test@example.com"+ , AltNameIP ip+ , AltNameDNS "dummy2"+ ]+ -- | Tests 'checkLeafKeyUsage'. testLeafKeyUsage :: IO (RData pub priv)@@ -797,6 +840,52 @@ "cn-not-used" True [NameMismatch "cn-not-used"]+ , testGroup+ "IP addresses"+ [ testSubjectAltNameIP res (BS.pack [10, 0, 0, 1]) "10.0.0.1" True []+ , testSubjectAltNameIP+ res+ (BS.pack [10, 0, 0, 1])+ "10.0.0.2"+ True+ [NameMismatch "10.0.0.2"]+ , testSubjectAltNameIP+ res+ (BS.pack [10, 0, 0, 1])+ "10.0.0.1.example.com"+ True+ [NameMismatch "10.0.0.1.example.com"]+ , testSubjectAltNameIP+ res+ (BS.pack [10, 0, 0, 1])+ "266.0.0.1"+ True+ [NameMismatch "266.0.0.1"] -- 266 read in Word8 is 10+ , testSubjectAltNameIP+ res+ (BS.pack [0x20, 0x01, 0x0d, 0xb8, 0x85, 0xa3, 0, 0, 0, 0, 0x8a, 0x2e, 0x03, 0x70, 0x73, 0x34])+ "2001:0db8:85a3:0000:0000:8a2e:0370:7334"+ True+ []+ , testSubjectAltNameIP+ res+ (BS.pack [0x20, 0x01, 0x0d, 0xb8, 0x85, 0xa3, 0, 0, 0, 0, 0x8a, 0x2e, 0x03, 0x70, 0x73, 0x34])+ "2001:0db8:85a3::8a2e:0370:7334"+ True+ []+ , testSubjectAltNameIP+ res+ (BS.pack [0x20, 0x01, 0x0d, 0xb8, 0x85, 0xa3, 0, 0, 0, 0, 0x8a, 0x2e, 0x03, 0x70, 0x73, 0x34])+ "2001:0db8:85a3:0:0:8a2e:0370:7334"+ True+ []+ , testSubjectAltNameIP+ res+ (BS.pack [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1])+ "::1"+ True+ []+ ] , testGroup "disabled" [ testSubjectAltName res "www.example.com" "www.example.com" False []
crypton-x509-validation.cabal view
@@ -1,5 +1,5 @@ Name: crypton-x509-validation-version: 1.6.13+version: 1.6.14 Description: X.509 Certificate and CRL validation. please see README License: BSD3 License-file: LICENSE@@ -28,6 +28,7 @@ , crypton-x509 >= 1.7.5 , crypton-x509-store >= 1.6 , crypton >= 0.24+ , iproute >= 1.2.2 Exposed-modules: Data.X509.Validation Other-modules: Data.X509.Validation.Signature Data.X509.Validation.Fingerprint