tls-extra 0.6.1 → 0.6.3
raw patch · 7 files changed
+43/−72 lines, 7 filesdep ~crypto-pubkey
Dependency ranges changed: crypto-pubkey
Files
- Network/TLS/Extra/Certificate.hs +34/−34
- Network/TLS/Extra/Cipher.hs +2/−19
- Network/TLS/Extra/Compression.hs +1/−1
- Network/TLS/Extra/Connection.hs +3/−3
- Network/TLS/Extra/Thread.hs +0/−3
- Tests.hs +0/−2
- tls-extra.cabal +3/−10
Network/TLS/Extra/Certificate.hs view
@@ -66,38 +66,37 @@ #else certificateVerifyChain_ :: CertificateStore -> [X509] -> IO CertificateUsage certificateVerifyChain_ _ [] = return $ CertificateUsageReject (CertificateRejectOther "empty chain / no certificates")-certificateVerifyChain_ store (x:xs) =- -- find a matching certificate that we trust (== installed on the system)- case findCertificate (certIssuerDN $ x509Cert x) store of- Just sysx509 -> do- validChain <- certificateVerifyAgainst x sysx509- if validChain- then return CertificateUsageAccept- else return certificateChainDoesntMatch- Nothing ->- case xs of- [] -> return $ CertificateUsageReject CertificateRejectUnknownCA- cert:_ -> do- let exts = certExtensions (x509Cert cert)- case checkCA exts of- Just r -> return r- Nothing -> do- validChain <- certificateVerifyAgainst x cert- if validChain- then certificateVerifyChain_ store xs- else return certificateChainDoesntMatch- where checkCA Nothing = return $ certificateNotAllowedToSign- checkCA (Just es) = do+certificateVerifyChain_ store (x:xs) = loop 0 x xs >>= return . maybe CertificateUsageAccept CertificateUsageReject+ where checkTrusted _ cert notFound =+ case findCertificate (certIssuerDN $ x509Cert cert) store of+ Just tCer -> verifyAgainstTrusted tCer cert+ Nothing -> notFound++ loop :: Int -> X509 -> [X509] -> IO (Maybe CertificateRejectReason)+ loop depth cert [] = checkTrusted depth cert (return $ Just (CertificateRejectUnknownCA))+ loop depth cert (n:ns) = checkTrusted depth cert $ do+ case checkCA $ certExtensions $ x509Cert n of+ Just r -> return (Just r)+ Nothing | certificateVerifyAgainst cert n -> loop (depth+1) n ns+ | otherwise -> return certificateChainDoesntMatch++ verifyAgainstTrusted trustedCer cert+ | validChain = return Nothing+ | otherwise = return certificateChainDoesntMatch+ where validChain = certificateVerifyAgainst cert trustedCer++ checkCA Nothing = certificateNotAllowedToSign+ checkCA (Just es) = let kuCanCertSign = case extensionGet es of Just (ExtKeyUsage l) -> elem KeyUsage_keyCertSign l Nothing -> False- case extensionGet es of- Just (ExtBasicConstraints True _)- | kuCanCertSign -> Nothing- | otherwise -> Just certificateNotAllowedToSign- _ -> Just certificateNotAllowedToSign- certificateNotAllowedToSign = CertificateUsageReject $ CertificateRejectOther "certificate is not allowed to sign another certificate"- certificateChainDoesntMatch = CertificateUsageReject $ CertificateRejectOther "chain doesn't match each other"+ in case extensionGet es of+ Just (ExtBasicConstraints True _)+ | kuCanCertSign -> Nothing+ | otherwise -> certificateNotAllowedToSign+ _ -> certificateNotAllowedToSign+ certificateNotAllowedToSign = Just $ CertificateRejectOther "certificate is not allowed to sign another certificate"+ certificateChainDoesntMatch = Just $ CertificateRejectOther "chain doesn't match" #endif -- | verify a certificates chain using the system certificates available.@@ -125,10 +124,10 @@ -- | verify a certificate against another one. -- the first certificate need to be signed by the second one for this function to succeed.-certificateVerifyAgainst :: X509 -> X509 -> IO Bool-certificateVerifyAgainst ux509@(X509 _ _ _ sigalg sig) (X509 scert _ _ _ _) =- return $ (verifyF sigalg pk) udata esig+certificateVerifyAgainst :: X509 -> X509 -> Bool+certificateVerifyAgainst ux509@(X509 _ _ _ sigalg sig) (X509 scert _ _ _ _) = verified where+ verified = (verifyF sigalg pk) udata esig udata = B.concat $ L.toChunks $ getSigningData ux509 esig = B.pack sig pk = certPubKey scert@@ -154,11 +153,12 @@ verifyF (SignatureALG HashMD5 PubKeyALG_RSA) (PubKeyRSA rsak) = RSA.verify HD.hashDescrMD5 rsak verifyF (SignatureALG HashSHA1 PubKeyALG_RSA) (PubKeyRSA rsak) = RSA.verify HD.hashDescrSHA1 rsak verifyF (SignatureALG HashSHA1 PubKeyALG_DSA) (PubKeyDSA dsak) = dsaSHA1Verify dsak+verifyF (SignatureALG HashSHA256 PubKeyALG_RSA) (PubKeyRSA rsak) = RSA.verify HD.hashDescrSHA256 rsak verifyF _ _ = \_ _ -> False -dsaSHA1Verify pk _ b = DSA.verify SHA1.hash pk asig b- where asig = (0,0) {- FIXME : need to work out how to get R/S from the bytestring a -}+dsaSHA1Verify pk _ b = False -- DSA.verify SHA1.hash pk asig b+ --where asig = DSA.Signature 0 0 {- FIXME : need to work out how to get R/S from the bytestring a -} -- | Verify that the given certificate chain is application to the given fully qualified host name. certificateVerifyDomain :: String -> [X509] -> CertificateUsage
Network/TLS/Extra/Cipher.hs view
@@ -15,7 +15,6 @@ , ciphersuite_strong , ciphersuite_unencrypted -- * individual ciphers- , cipher_null_null , cipher_null_SHA1 , cipher_null_MD5 , cipher_RC4_128_MD5@@ -91,8 +90,9 @@ , bulkKeySize = 0 , bulkIVSize = 0 , bulkBlockSize = 0- , bulkF = BulkNoneF+ , bulkF = BulkStreamF (const B.empty) streamId streamId }+ where streamId = \iv b -> (b,iv) bulk_rc4 = Bulk { bulkName = "RC4-128"@@ -134,23 +134,6 @@ { hashName = "SHA256" , hashSize = 32 , hashF = SHA256.hash- }--hash_null = Hash- { hashName = "null"- , hashSize = 0- , hashF = const B.empty- }---- | this is not stricly a usable cipher; it's the initial cipher of a TLS connection-cipher_null_null :: Cipher-cipher_null_null = Cipher- { cipherID = 0x0- , cipherName = "null-null"- , cipherBulk = bulk_null- , cipherHash = hash_null- , cipherKeyExchange = CipherKeyExchange_RSA- , cipherMinVer = Nothing } -- | unencrypted cipher using RSA for key exchange and MD5 for digest
Network/TLS/Extra/Compression.hs view
@@ -9,4 +9,4 @@ ( ) where -import Network.TLS.Compression+--import Network.TLS.Compression
Network/TLS/Extra/Connection.hs view
@@ -26,12 +26,12 @@ -- -- @ -- import Network.TLS.Extra--- import Crypto.Random+-- import Crypto.Random.AESCtr -- ...--- conn <- (newGenIO::IO SystemRandom) >>= connectionClient 192.168.2.2 7777 defaultParams g+-- conn <- makeSystem >>= connectionClient 192.168.2.2 7777 defaultParams -- @ ----- will make a new RNG (using system entropy) and connect to IP 192.168.2.2+-- will make a new RNG (using cprng-aes) and connect to IP 192.168.2.2 -- on port 7777. connectionClient :: CPRG g => String -> String -> TLSParams -> g -> IO Context connectionClient s p params rng = do
− Network/TLS/Extra/Thread.hs
@@ -1,3 +0,0 @@-module Network.TLS.Extra.Thread- (- ) where
Tests.hs view
@@ -1,5 +1,3 @@-{-# LANGUAGE CPP #-}- import qualified Tests.Connection as Connection import qualified Tests.Ciphers as Ciphers
tls-extra.cabal view
@@ -1,5 +1,5 @@ Name: tls-extra-Version: 0.6.1+Version: 0.6.3 Description: a set of extra definitions, default values and helpers for tls. License: BSD3@@ -18,10 +18,6 @@ Description: Build unit test Default: False -Flag fastaes- Description: Use fast AES if available- Default: True- Library Build-Depends: base > 3 && < 5 , tls >= 1.1.0 && < 1.2.0@@ -33,7 +29,7 @@ , cipher-rc4 , cipher-aes >= 0.1 && < 0.2 , certificate >= 1.3.5 && < 1.4.0- , crypto-pubkey+ , crypto-pubkey >= 0.1.4 , crypto-random-api , pem >= 0.1.0 && < 0.2.0 , text >= 0.5 && < 1.0@@ -43,7 +39,6 @@ Network.TLS.Extra.Cipher Network.TLS.Extra.Compression Network.TLS.Extra.Connection- Network.TLS.Extra.Thread Network.TLS.Extra.File ghc-options: -Wall -fno-warn-missing-signatures if os(windows)@@ -58,13 +53,11 @@ , QuickCheck >= 2 , bytestring , cprng-aes >= 0.3.0+ , cipher-aes >= 0.1 && < 0.2 else Buildable: False if os(windows) cpp-options: -DNOCERTVERIFY- if flag(fastaes)- cpp-options: -DCIPHER_AES- Build-Depends: cipher-aes >= 0.1 && < 0.2 source-repository head type: git