tls-extra 0.1.5 → 0.1.6

raw patch · 2 files changed

+36/−1 lines, 2 filesdep +text

Dependencies added: text

Files

• Network/TLS/Extra/Certificate.hs +34/−0
• tls-extra.cabal +2/−1

@@ -9,6 +9,7 @@ module Network.TLS.Extra.Certificate 	( certificateVerifyChain 	, certificateVerifyAgainst+	, certificateVerifyDomain 	) where  import qualified Data.ByteString as B@@ -23,6 +24,9 @@ import qualified Crypto.Cipher.RSA as RSA import qualified Crypto.Cipher.DSA as DSA +import Data.Text.Lazy (unpack)+import Data.Certificate.X509Cert (oidCommonName)+ #if defined(NOCERTVERIFY)  # warning "********certificate verify chain doesn't yet work on your platform *************"@@ -116,3 +120,33 @@  mkRSA (lenmodulus, modulus, e) = 	RSA.PublicKey { RSA.public_sz = lenmodulus, RSA.public_n = modulus, RSA.public_e = e }++-- | Verify that the given certificate chain is application to the given fully qualified host name.+certificateVerifyDomain :: String -> [X509] -> Bool+certificateVerifyDomain _      []                  = False+certificateVerifyDomain fqhn (X509 cert _ _ _:_) =+	case lookup oidCommonName $ certSubjectDN cert of+		Nothing       -> False+		Just (_, val) -> matchDomain (splitDot $ unpack val)+	where+		matchDomain l+			| length (filter (== "") l) > 0 = False+			| head l == "*"                 = wildcardMatch (reverse $ drop 1 l)+			| otherwise                     = l == splitDot 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.+		wildcardMatch l+			-- * or *.com is always invalid+			| length l < 2                         = False+			-- *.com.<country> is always invalid+			| length (head l) <= 2 && length (head $ drop 1 l) <= 3 && length l < 3 = False+			| otherwise                            =+				l == take (length l) (reverse $ splitDot fqhn)++		splitDot :: String -> [String]+		splitDot [] = [""]+		splitDot x  =+			let (y, z) = break (== '.') x in+			y : (if z == "" then [] else splitDot $ drop 1 z)

@@ -1,5 +1,5 @@ Name:                tls-extra-Version:             0.1.5+Version:             0.1.6 Description:    a set of extra definitions, default values and helpers for tls. License:             BSD3@@ -36,6 +36,7 @@                    , crypto-api >= 0.5                    , cryptocipher >= 0.2.5                    , certificate >= 0.7 && < 0.8+                   , text >= 0.5 && < 1.0   Exposed-modules:   Network.TLS.Extra   other-modules:     Network.TLS.Extra.Certificate                      Network.TLS.Extra.Cipher