x509-validation 1.6.4 → 1.6.5

raw patch · 2 files changed

+20/−14 lines, 2 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Data/X509/Validation.hs +19/−13
• x509-validation.cabal +1/−1

@@ -33,6 +33,7 @@ import Control.Monad (when) import Data.Default.Class import Data.ASN1.Types+import Data.Char (toLower) import Data.X509 import Data.X509.CertificateStore import Data.X509.Validation.Signature@@ -330,11 +331,11 @@ validateCertificateName :: HostName -> Certificate -> [FailedReason] validateCertificateName fqhn cert     | not $ null altNames =-        findMatch [] $ map (matchDomain . splitDot) altNames+        findMatch [] $ map matchDomain altNames     | otherwise =         case commonName of             Nothing -> [NoCommonName]-            Just cn -> findMatch [] $ [matchDomain $ splitDot $ cn]+            Just cn -> findMatch [] $ [matchDomain cn]   where (commonName, altNames) = getNames cert          findMatch :: [FailedReason] -> [[FailedReason]] -> [FailedReason]@@ -342,14 +343,19 @@         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]+        matchDomain :: String -> [FailedReason]+        matchDomain name = case splitDot name of+            l | any (== "") l       -> [InvalidName name]+              | head l == "*"       -> wildcardMatch (drop 1 l)+              | l == splitDot fqhn  -> [] -- success: we got a match+              | otherwise           -> [NameMismatch fqhn] -        -- only 1 wildcard is valid, and if multiples are present+        -- A wildcard matches a single domain name component.+        --+        -- e.g. *.server.com will match www.server.com but not www.m.server.com+        --+        -- Only 1 wildcard is valid and only for the left-most component. If+        -- used at other positions or 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.         --@@ -357,15 +363,15 @@         --         -- Also '*' is not accepted as a valid wildcard         wildcardMatch l-            | null l                                         = [InvalidWildcard] -- '*' is always invalid-            | l == take (length l) (reverse $ splitDot fqhn) = [] -- success: we got a match-            | otherwise                                      = [NameMismatch fqhn]+            | null l                      = [InvalidWildcard] -- '*' is always invalid+            | l == drop 1 (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)+            map toLower y : (if z == "" then [] else splitDot $ drop 1 z)   -- | return true if the 'subject' certificate's issuer match

@@ -1,5 +1,5 @@ Name:                x509-validation-Version:             1.6.4+Version:             1.6.5 Description:         X.509 Certificate and CRL validation License:             BSD3 License-file:        LICENSE