diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright (c) 2010-2011 Vincent Hanquez +Copyright (c) 2010-2012 Vincent Hanquez All rights reserved. diff --git a/Network/TLS/Extra/Certificate.hs b/Network/TLS/Extra/Certificate.hs --- a/Network/TLS/Extra/Certificate.hs +++ b/Network/TLS/Extra/Certificate.hs @@ -7,46 +7,42 @@ -- Portability : unknown -- module Network.TLS.Extra.Certificate - ( certificateChecks - , certificateVerifyChain - , certificateVerifyChainAgainst - , certificateVerifyAgainst - , certificateSelfSigned - , certificateVerifyDomain - , certificateVerifyValidity - , certificateFingerprint - ) where + ( certificateChecks + , certificateVerifyChain + , certificateVerifyAgainst + , certificateSelfSigned + , certificateVerifyDomain + , certificateVerifyValidity + , certificateFingerprint + ) where import Control.Applicative ((<$>)) import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as L import Data.Certificate.X509 -import System.Certificate.X509 as SysCert -- for signing/verifying certificate import qualified Crypto.Hash.SHA1 as SHA1 -import qualified Crypto.Hash.MD2 as MD2 -import qualified Crypto.Hash.MD5 as MD5 -import qualified Crypto.Cipher.RSA as RSA -import qualified Crypto.Cipher.DSA as DSA +import qualified Crypto.PubKey.HashDescr as HD +import qualified Crypto.PubKey.RSA.PKCS15 as RSA +import qualified Crypto.PubKey.DSA as DSA +import Data.CertificateStore import Data.Certificate.X509.Cert (oidCommonName) -import Network.TLS (TLSCertificateUsage(..), TLSCertificateRejectReason(..)) +import Network.TLS (CertificateUsage(..), CertificateRejectReason(..)) import Data.Time.Calendar import Data.List (find) import Data.Maybe (fromMaybe) #if defined(NOCERTVERIFY) - import System.IO (hPutStrLn, stderr, hIsTerminalDevice) import Control.Monad (when) - #endif --- | Returns 'CertificateUsageAccept' if all the checks pass, or the first +-- | Returns 'CertificateUsageAccept' if all the checks pass, or the first -- failure. -certificateChecks :: [ [X509] -> IO TLSCertificateUsage ] -> [X509] -> IO TLSCertificateUsage +certificateChecks :: [ [X509] -> IO CertificateUsage ] -> [X509] -> IO CertificateUsage certificateChecks checks x509s = fromMaybe CertificateUsageAccept . find (CertificateUsageAccept /=) <$> mapM ($ x509s) checks @@ -56,10 +52,10 @@ # warning "********please consider contributing to the certificate to fix this issue *************" # warning "********getting trusted system certificate is platform dependant *************" -{- on windows and OSX, the trusted certificates are not yet accessible, +{- on windows, the trusted certificates are not yet accessible, - for now, print a big fat warning (better than nothing) and returns true -} -certificateVerifyChain_ :: [X509] -> IO TLSCertificateUsage -certificateVerifyChain_ _ = do +certificateVerifyChain_ :: CertificateStore -> [X509] -> IO CertificateUsage +certificateVerifyChain_ _ _ = do wvisible <- hIsTerminalDevice stderr when wvisible $ do hPutStrLn stderr "tls-extra:Network.TLS.Extra.Certificate" @@ -68,39 +64,41 @@ return CertificateUsageAccept #else -certificateVerifyChain_ :: [X509] -> IO TLSCertificateUsage -certificateVerifyChain_ [] = return $ CertificateUsageReject (CertificateRejectOther "empty chain / no certificates") -certificateVerifyChain_ (x:xs) = do - -- find a matching certificate that we trust (== installed on the system) - foundCert <- SysCert.findCertificate (certMatchDN x) - case foundCert of - Just sysx509 -> - if certificateVerifyAgainst x sysx509 - then return CertificateUsageAccept - else return $ CertificateUsageReject (CertificateRejectOther "chain doesn't match each other") - Nothing -> case xs of - [] -> return $ CertificateUsageReject CertificateRejectUnknownCA - _ -> if certificateVerifyAgainst x (head xs) - then certificateVerifyChain_ xs - else return $ CertificateUsageReject (CertificateRejectOther "chain doesn't match each other") -#endif +certificateVerifyChain_ :: CertificateStore -> [X509] -> IO CertificateUsage +certificateVerifyChain_ _ [] = return $ CertificateUsageReject (CertificateRejectOther "empty chain / no certificates") +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 -certificateVerifyChainAgainst_ :: [X509] -> [X509] -> TLSCertificateUsage -certificateVerifyChainAgainst_ _ [] = CertificateUsageReject (CertificateRejectOther "empty chain / no certificates") -certificateVerifyChainAgainst_ allCerts (x:xs) = - -- find a matching certificate that we trust (== installed on the system) - -- foundCert <- SysCert.findCertificate (certMatchDN x) - case find (certMatchDN x) allCerts of - Just sysx509 -> - if certificateVerifyAgainst x sysx509 - then CertificateUsageAccept - else CertificateUsageReject (CertificateRejectOther "chain doesn't match each other") - Nothing -> case xs of - [] -> CertificateUsageReject CertificateRejectUnknownCA - _ -> if certificateVerifyAgainst x (head xs) - then certificateVerifyChainAgainst_ allCerts xs - else CertificateUsageReject (CertificateRejectOther "chain doesn't match each other") + 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 -> True + 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. -- -- each certificate of the list is verified against the next certificate, until @@ -115,35 +113,24 @@ -- -- TODO: verify validity, check revocation list if any, add optional user output to know -- the rejection reason. -certificateVerifyChain :: [X509] -> IO TLSCertificateUsage -certificateVerifyChain = certificateVerifyChain_ . reorderList - where - reorderList [] = [] - reorderList (x:xs) = - case find (certMatchDN x) xs of - Nothing -> x : reorderList xs - Just found -> x : found : reorderList (filter (/= found) xs) - -certificateVerifyChainAgainst :: [X509] -> [X509] -> TLSCertificateUsage -certificateVerifyChainAgainst allCerts = certificateVerifyChainAgainst_ allCerts . reorderList - where - reorderList [] = [] - reorderList (x:xs) = - case find (certMatchDN x) xs of - Nothing -> x : reorderList xs - Just found -> x : found : reorderList (filter (/= found) xs) +certificateVerifyChain :: CertificateStore -> [X509] -> IO CertificateUsage +certificateVerifyChain store = certificateVerifyChain_ store . reorderList + where + reorderList [] = [] + reorderList (x:xs) = + case find (certMatchDN x) xs of + Nothing -> x : reorderList xs + Just found -> x : found : reorderList (filter (/= found) xs) -- | 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 -> Bool -certificateVerifyAgainst ux509@(X509 _ _ _ sigalg sig) (X509 scert _ _ _ _) = do - case verifyF sigalg pk udata esig of - Right True -> True - _ -> False - where - udata = B.concat $ L.toChunks $ getSigningData ux509 - esig = B.pack sig - pk = certPubKey scert +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 -- | Is this certificate self signed? certificateSelfSigned :: X509 -> Bool @@ -151,9 +138,9 @@ certMatchDN :: X509 -> X509 -> Bool certMatchDN (X509 testedCert _ _ _ _) (X509 issuerCert _ _ _ _) = - certSubjectDN issuerCert == certIssuerDN testedCert + certSubjectDN issuerCert == certIssuerDN testedCert -verifyF :: SignatureALG -> PubKey -> B.ByteString -> B.ByteString -> Either String Bool +verifyF :: SignatureALG -> PubKey -> B.ByteString -> B.ByteString -> Bool -- md[245]WithRSAEncryption: -- @@ -162,75 +149,68 @@ -- md2WithRSAEncryption OBJECT IDENTIFIER ::= { pkcs-1 2 } -- md4WithRSAEncryption OBJECT IDENTIFIER ::= { pkcs-1 3 } -- md5WithRSAEncryption OBJECT IDENTIFIER ::= { pkcs-1 4 } -verifyF (SignatureALG HashMD2 PubKeyALG_RSA) (PubKeyRSA rsak) = rsaVerify MD2.hash asn1 rsak - where asn1 = "\x30\x20\x30\x0c\x06\x08\x2a\x86\x48\x86\xf7\x0d\x02\x05\x05\x00\x02\x10" - -verifyF (SignatureALG HashMD5 PubKeyALG_RSA) (PubKeyRSA rsak) = rsaVerify MD5.hash asn1 rsak - where asn1 = "\x30\x20\x30\x0c\x06\x08\x2a\x86\x48\x86\xf7\x0d\x02\x05\x05\x00\x04\x10" - -verifyF (SignatureALG HashSHA1 PubKeyALG_RSA) (PubKeyRSA rsak) = rsaVerify SHA1.hash asn1 rsak - where asn1 = "\x30\x21\x30\x09\x06\x05\x2b\x0e\x03\x02\x1a\x05\x00\x04\x14" - +verifyF (SignatureALG HashMD2 PubKeyALG_RSA) (PubKeyRSA rsak) = RSA.verify HD.hashDescrMD2 rsak +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 _ _ = (\_ _ -> Left "unexpected/wrong signature") +verifyF (SignatureALG HashSHA256 PubKeyALG_RSA) (PubKeyRSA rsak) = RSA.verify HD.hashDescrSHA256 rsak -dsaSHA1Verify pk _ b = either (Left . show) (Right) $ DSA.verify asig SHA1.hash pk b - where asig = (0,0) {- FIXME : need to work out how to get R/S from the bytestring a -} +verifyF _ _ = \_ _ -> False -rsaVerify h hdesc pk a b = either (Left . show) (Right) $ RSA.verify h hdesc pk a b +dsaSHA1Verify pk _ b = False + --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] -> TLSCertificateUsage +certificateVerifyDomain :: String -> [X509] -> CertificateUsage certificateVerifyDomain _ [] = CertificateUsageReject (CertificateRejectOther "empty list") certificateVerifyDomain fqhn (X509 cert _ _ _ _:_) = - let names = maybe [] ((:[]) . snd) (lookup oidCommonName $ certSubjectDN cert) - ++ maybe [] (maybe [] toAltName . extensionGet) (certExtensions cert) in - orUsage $ map (matchDomain . splitDot) names - where - orUsage [] = rejectMisc "FQDN do not match this certificate" - orUsage (x:xs) - | x == CertificateUsageAccept = CertificateUsageAccept - | otherwise = orUsage xs + let names = maybe [] ((:[]) . snd) (lookup oidCommonName $ getDistinguishedElements $ certSubjectDN cert) + ++ maybe [] (maybe [] toAltName . extensionGet) (certExtensions cert) in + orUsage $ map (matchDomain . splitDot) names + where + orUsage [] = rejectMisc "FQDN do not match this certificate" + orUsage (x:xs) + | x == CertificateUsageAccept = CertificateUsageAccept + | otherwise = orUsage xs - toAltName (ExtSubjectAltName l) = l - matchDomain l - | length (filter (== "") l) > 0 = rejectMisc "commonname OID got empty subdomain" - | head l == "*" = wildcardMatch (reverse $ drop 1 l) - | otherwise = if l == splitDot fqhn - then CertificateUsageAccept - else rejectMisc "FQDN and common name OID do not match" + toAltName (ExtSubjectAltName l) = l + matchDomain l + | length (filter (== "") l) > 0 = rejectMisc "commonname OID got empty subdomain" + | head l == "*" = wildcardMatch (reverse $ drop 1 l) + | otherwise = if l == splitDot fqhn + then CertificateUsageAccept + else rejectMisc "FQDN and common name OID do not match" - -- 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 - -- .com or is always invalid - | length l < 2 = rejectMisc "commonname OID wildcard match too widely" - -- .com. is always invalid - | length (head l) <= 2 && length (head $ drop 1 l) <= 3 && length l < 3 = rejectMisc "commonname OID wildcard match too widely" - | otherwise = - if l == take (length l) (reverse $ splitDot fqhn) - then CertificateUsageAccept - else rejectMisc "FQDN and common name OID do not match" + -- 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 + -- .com or is always invalid + | length l < 2 = rejectMisc "commonname OID wildcard match too widely" + -- .com. is always invalid + | length (head l) <= 2 && length (head $ drop 1 l) <= 3 && length l < 3 = rejectMisc "commonname OID wildcard match too widely" + | otherwise = + if l == take (length l) (reverse $ splitDot fqhn) + then CertificateUsageAccept + else rejectMisc "FQDN and common name OID do not match" - splitDot :: String -> [String] - splitDot [] = [""] - splitDot x = - let (y, z) = break (== '.') x in - y : (if z == "" then [] else splitDot $ drop 1 z) + splitDot :: String -> [String] + splitDot [] = [""] + splitDot x = + let (y, z) = break (== '.') x in + y : (if z == "" then [] else splitDot $ drop 1 z) - rejectMisc s = CertificateUsageReject (CertificateRejectOther s) + rejectMisc s = CertificateUsageReject (CertificateRejectOther s) -- | Verify certificate validity period that need to between the bounds of the certificate. -- TODO: maybe should verify whole chain. -certificateVerifyValidity :: Day -> [X509] -> TLSCertificateUsage +certificateVerifyValidity :: Day -> [X509] -> CertificateUsage certificateVerifyValidity _ [] = CertificateUsageReject $ CertificateRejectOther "empty list" certificateVerifyValidity ctime (X509 cert _ _ _ _ :_) = - let ((beforeDay,_,_) , (afterDay,_,_)) = certValidity cert in - if beforeDay < ctime && ctime <= afterDay - then CertificateUsageAccept - else CertificateUsageReject CertificateRejectExpired + let ((beforeDay,_,_) , (afterDay,_,_)) = certValidity cert in + if beforeDay < ctime && ctime <= afterDay + then CertificateUsageAccept + else CertificateUsageReject CertificateRejectExpired -- | hash the certificate signing data using the supplied hash function. certificateFingerprint :: (L.ByteString -> B.ByteString) -> X509 -> B.ByteString diff --git a/Network/TLS/Extra/Cipher.hs b/Network/TLS/Extra/Cipher.hs --- a/Network/TLS/Extra/Cipher.hs +++ b/Network/TLS/Extra/Cipher.hs @@ -5,80 +5,73 @@ -- Stability : experimental -- Portability : unknown -- +{-# LANGUAGE CPP #-} +{-# LANGUAGE PackageImports #-} module Network.TLS.Extra.Cipher - ( - -- * cipher suite - ciphersuite_all - , ciphersuite_medium - , ciphersuite_strong - , ciphersuite_unencrypted - -- * individual ciphers - , cipher_null_null - , cipher_null_SHA1 - , cipher_null_MD5 - , cipher_RC4_128_MD5 - , cipher_RC4_128_SHA1 - , cipher_AES128_SHA1 - , cipher_AES256_SHA1 - , cipher_AES128_SHA256 - , cipher_AES256_SHA256 - ) where + ( + -- * cipher suite + ciphersuite_all + , ciphersuite_medium + , ciphersuite_strong + , ciphersuite_unencrypted + -- * individual ciphers + , cipher_null_SHA1 + , cipher_null_MD5 + , cipher_RC4_128_MD5 + , cipher_RC4_128_SHA1 + , cipher_AES128_SHA1 + , cipher_AES256_SHA1 + , cipher_AES128_SHA256 + , cipher_AES256_SHA256 + ) where -import qualified Data.Vector.Unboxed as Vector (fromList, toList) import qualified Data.ByteString as B import Network.TLS (Version(..)) import Network.TLS.Cipher -import qualified Crypto.Cipher.AES as AES -import qualified Crypto.Cipher.RC4 as RC4 +import qualified "cipher-rc4" Crypto.Cipher.RC4 as RC4 import qualified Crypto.Hash.SHA256 as SHA256 import qualified Crypto.Hash.SHA1 as SHA1 import qualified Crypto.Hash.MD5 as MD5 -aes128_cbc_encrypt :: Key -> IV -> B.ByteString -> B.ByteString -aes128_cbc_encrypt key iv d = AES.encryptCBC pkey iv d - where (Right pkey) = AES.initKey128 key +import qualified "cipher-aes" Crypto.Cipher.AES as AES -aes128_cbc_decrypt :: Key -> IV -> B.ByteString -> B.ByteString -aes128_cbc_decrypt key iv d = AES.decryptCBC pkey iv d - where (Right pkey) = AES.initKey128 key +aes_cbc_encrypt :: Key -> IV -> B.ByteString -> B.ByteString +aes_cbc_encrypt key iv d = AES.encryptCBC (AES.initAES key) iv d -aes256_cbc_encrypt :: Key -> IV -> B.ByteString -> B.ByteString -aes256_cbc_encrypt key iv d = AES.encryptCBC pkey iv d - where (Right pkey) = AES.initKey256 key +aes_cbc_decrypt :: Key -> IV -> B.ByteString -> B.ByteString +aes_cbc_decrypt key iv d = AES.decryptCBC (AES.initAES key) iv d -aes256_cbc_decrypt :: Key -> IV -> B.ByteString -> B.ByteString -aes256_cbc_decrypt key iv d = AES.decryptCBC pkey iv d - where (Right pkey) = AES.initKey256 key +aes128_cbc_encrypt = aes_cbc_encrypt +aes128_cbc_decrypt = aes_cbc_decrypt +aes256_cbc_encrypt = aes_cbc_encrypt +aes256_cbc_decrypt = aes_cbc_decrypt toIV :: RC4.Ctx -> IV -toIV (v, x, y) = B.pack (x : y : Vector.toList v) +toIV (RC4.Ctx ctx) = ctx toCtx :: IV -> RC4.Ctx -toCtx iv = - case B.unpack iv of - x:y:l -> (Vector.fromList l, x, y) - _ -> (Vector.fromList [], 0, 0) +toCtx iv = RC4.Ctx iv initF_rc4 :: Key -> IV -initF_rc4 key = toIV $ RC4.initCtx (B.unpack key) +initF_rc4 key = toIV $ RC4.initCtx key encryptF_rc4 :: IV -> B.ByteString -> (B.ByteString, IV) -encryptF_rc4 iv d = (\(ctx, e) -> (e, toIV ctx)) $ RC4.encrypt (toCtx iv) d +encryptF_rc4 iv d = (\(ctx, e) -> (e, toIV ctx)) $ RC4.combine (toCtx iv) d decryptF_rc4 :: IV -> B.ByteString -> (B.ByteString, IV) -decryptF_rc4 iv e = (\(ctx, d) -> (d, toIV ctx)) $ RC4.decrypt (toCtx iv) e +decryptF_rc4 iv e = (\(ctx, d) -> (d, toIV ctx)) $ RC4.combine (toCtx iv) e -- | all encrypted ciphers supported ordered from strong to weak. -- this choice of ciphersuite should satisfy most normal need ciphersuite_all :: [Cipher] ciphersuite_all = - [ cipher_AES128_SHA256, cipher_AES256_SHA256 - , cipher_AES128_SHA1, cipher_AES256_SHA1 - , cipher_RC4_128_SHA1, cipher_RC4_128_MD5 - ] + [ cipher_AES128_SHA256, cipher_AES256_SHA256 + , cipher_AES128_SHA1, cipher_AES256_SHA1 + , cipher_RC4_128_SHA1, cipher_RC4_128_MD5 + ] -- | list of medium ciphers. ciphersuite_medium :: [Cipher] @@ -93,159 +86,143 @@ ciphersuite_unencrypted = [cipher_null_MD5, cipher_null_SHA1] bulk_null = Bulk - { bulkName = "null" - , bulkKeySize = 0 - , bulkIVSize = 0 - , bulkBlockSize = 0 - , bulkF = BulkNoneF - } + { bulkName = "null" + , bulkKeySize = 0 + , bulkIVSize = 0 + , bulkBlockSize = 0 + , bulkF = BulkStreamF (const B.empty) streamId streamId + } + where streamId = \iv b -> (b,iv) bulk_rc4 = Bulk - { bulkName = "RC4-128" - , bulkKeySize = 16 - , bulkIVSize = 0 - , bulkBlockSize = 0 - , bulkF = BulkStreamF initF_rc4 encryptF_rc4 decryptF_rc4 - } + { bulkName = "RC4-128" + , bulkKeySize = 16 + , bulkIVSize = 0 + , bulkBlockSize = 0 + , bulkF = BulkStreamF initF_rc4 encryptF_rc4 decryptF_rc4 + } bulk_aes128 = Bulk - { bulkName = "AES128" - , bulkKeySize = 16 - , bulkIVSize = 16 - , bulkBlockSize = 16 - , bulkF = BulkBlockF aes128_cbc_encrypt aes128_cbc_decrypt - } + { bulkName = "AES128" + , bulkKeySize = 16 + , bulkIVSize = 16 + , bulkBlockSize = 16 + , bulkF = BulkBlockF aes128_cbc_encrypt aes128_cbc_decrypt + } bulk_aes256 = Bulk - { bulkName = "AES256" - , bulkKeySize = 32 - , bulkIVSize = 16 - , bulkBlockSize = 16 - , bulkF = BulkBlockF aes256_cbc_encrypt aes256_cbc_decrypt - } + { bulkName = "AES256" + , bulkKeySize = 32 + , bulkIVSize = 16 + , bulkBlockSize = 16 + , bulkF = BulkBlockF aes256_cbc_encrypt aes256_cbc_decrypt + } hash_md5 = Hash - { hashName = "MD5" - , hashSize = 16 - , hashF = MD5.hash - } + { hashName = "MD5" + , hashSize = 16 + , hashF = MD5.hash + } hash_sha1 = Hash - { hashName = "SHA1" - , hashSize = 20 - , hashF = SHA1.hash - } + { hashName = "SHA1" + , hashSize = 20 + , hashF = SHA1.hash + } hash_sha256 = Hash - { 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 - } + { hashName = "SHA256" + , hashSize = 32 + , hashF = SHA256.hash + } -- | unencrypted cipher using RSA for key exchange and MD5 for digest cipher_null_MD5 :: Cipher cipher_null_MD5 = Cipher - { cipherID = 0x1 - , cipherName = "RSA-null-MD5" - , cipherBulk = bulk_null - , cipherHash = hash_md5 - , cipherKeyExchange = CipherKeyExchange_RSA - , cipherMinVer = Nothing - } + { cipherID = 0x1 + , cipherName = "RSA-null-MD5" + , cipherBulk = bulk_null + , cipherHash = hash_md5 + , cipherKeyExchange = CipherKeyExchange_RSA + , cipherMinVer = Nothing + } -- | unencrypted cipher using RSA for key exchange and SHA1 for digest cipher_null_SHA1 :: Cipher cipher_null_SHA1 = Cipher - { cipherID = 0x2 - , cipherName = "RSA-null-SHA1" - , cipherBulk = bulk_null - , cipherHash = hash_sha1 - , cipherKeyExchange = CipherKeyExchange_RSA - , cipherMinVer = Nothing - } + { cipherID = 0x2 + , cipherName = "RSA-null-SHA1" + , cipherBulk = bulk_null + , cipherHash = hash_sha1 + , cipherKeyExchange = CipherKeyExchange_RSA + , cipherMinVer = Nothing + } -- | RC4 cipher, RSA key exchange and MD5 for digest cipher_RC4_128_MD5 :: Cipher cipher_RC4_128_MD5 = Cipher - { cipherID = 0x04 - , cipherName = "RSA-rc4-128-md5" - , cipherBulk = bulk_rc4 - , cipherHash = hash_md5 - , cipherKeyExchange = CipherKeyExchange_RSA - , cipherMinVer = Nothing - } + { cipherID = 0x04 + , cipherName = "RSA-rc4-128-md5" + , cipherBulk = bulk_rc4 + , cipherHash = hash_md5 + , cipherKeyExchange = CipherKeyExchange_RSA + , cipherMinVer = Nothing + } -- | RC4 cipher, RSA key exchange and SHA1 for digest cipher_RC4_128_SHA1 :: Cipher cipher_RC4_128_SHA1 = Cipher - { cipherID = 0x05 - , cipherName = "RSA-rc4-128-sha1" - , cipherBulk = bulk_rc4 - , cipherHash = hash_sha1 - , cipherKeyExchange = CipherKeyExchange_RSA - , cipherMinVer = Nothing - } + { cipherID = 0x05 + , cipherName = "RSA-rc4-128-sha1" + , cipherBulk = bulk_rc4 + , cipherHash = hash_sha1 + , cipherKeyExchange = CipherKeyExchange_RSA + , cipherMinVer = Nothing + } -- | AES cipher (128 bit key), RSA key exchange and SHA1 for digest cipher_AES128_SHA1 :: Cipher cipher_AES128_SHA1 = Cipher - { cipherID = 0x2f - , cipherName = "RSA-aes128-sha1" - , cipherBulk = bulk_aes128 - , cipherHash = hash_sha1 - , cipherKeyExchange = CipherKeyExchange_RSA - , cipherMinVer = Just SSL3 - } + { cipherID = 0x2f + , cipherName = "RSA-aes128-sha1" + , cipherBulk = bulk_aes128 + , cipherHash = hash_sha1 + , cipherKeyExchange = CipherKeyExchange_RSA + , cipherMinVer = Just SSL3 + } -- | AES cipher (256 bit key), RSA key exchange and SHA1 for digest cipher_AES256_SHA1 :: Cipher cipher_AES256_SHA1 = Cipher - { cipherID = 0x35 - , cipherName = "RSA-aes256-sha1" - , cipherBulk = bulk_aes256 - , cipherHash = hash_sha1 - , cipherKeyExchange = CipherKeyExchange_RSA - , cipherMinVer = Just SSL3 - } + { cipherID = 0x35 + , cipherName = "RSA-aes256-sha1" + , cipherBulk = bulk_aes256 + , cipherHash = hash_sha1 + , cipherKeyExchange = CipherKeyExchange_RSA + , cipherMinVer = Just SSL3 + } -- | AES cipher (128 bit key), RSA key exchange and SHA256 for digest cipher_AES128_SHA256 :: Cipher cipher_AES128_SHA256 = Cipher - { cipherID = 0x3c - , cipherName = "RSA-aes128-sha256" - , cipherBulk = bulk_aes128 - , cipherHash = hash_sha256 - , cipherKeyExchange = CipherKeyExchange_RSA - , cipherMinVer = Just TLS12 - } + { cipherID = 0x3c + , cipherName = "RSA-aes128-sha256" + , cipherBulk = bulk_aes128 + , cipherHash = hash_sha256 + , cipherKeyExchange = CipherKeyExchange_RSA + , cipherMinVer = Just TLS12 + } -- | AES cipher (256 bit key), RSA key exchange and SHA256 for digest cipher_AES256_SHA256 :: Cipher cipher_AES256_SHA256 = Cipher - { cipherID = 0x3d - , cipherName = "RSA-aes256-sha256" - , cipherBulk = bulk_aes256 - , cipherHash = hash_sha256 - , cipherKeyExchange = CipherKeyExchange_RSA - , cipherMinVer = Just TLS12 - } + { cipherID = 0x3d + , cipherName = "RSA-aes256-sha256" + , cipherBulk = bulk_aes256 + , cipherHash = hash_sha256 + , cipherKeyExchange = CipherKeyExchange_RSA + , cipherMinVer = Just TLS12 + } {- TLS 1.0 ciphers definition diff --git a/Network/TLS/Extra/Compression.hs b/Network/TLS/Extra/Compression.hs --- a/Network/TLS/Extra/Compression.hs +++ b/Network/TLS/Extra/Compression.hs @@ -1,5 +1,12 @@ +-- | +-- Module : Network.TLS.Extra.Compression +-- License : BSD-style +-- Maintainer : Vincent Hanquez +-- Stability : experimental +-- Portability : unknown +-- module Network.TLS.Extra.Compression - ( - ) where + ( + ) where -import Network.TLS.Compression +--import Network.TLS.Compression diff --git a/Network/TLS/Extra/Connection.hs b/Network/TLS/Extra/Connection.hs --- a/Network/TLS/Extra/Connection.hs +++ b/Network/TLS/Extra/Connection.hs @@ -6,10 +6,10 @@ -- Portability : unknown -- module Network.TLS.Extra.Connection - ( connectionClient - ) where + ( connectionClient + ) where -import Crypto.Random +import Crypto.Random.API import Control.Applicative ((<$>)) import Control.Exception import Data.Char @@ -26,21 +26,21 @@ -- -- @ -- 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 :: CryptoRandomGen g => String -> String -> TLSParams -> g -> IO (TLSCtx Handle) +connectionClient :: CPRG g => String -> String -> TLSParams -> g -> IO Context connectionClient s p params rng = do - pn <- if and $ map isDigit $ p - then return $ fromIntegral $ (read p :: Int) - else servicePort <$> getServiceByName p "tcp" - he <- getHostByName s + pn <- if and $ map isDigit $ p + then return $ fromIntegral $ (read p :: Int) + else servicePort <$> getServiceByName p "tcp" + he <- getHostByName s - h <- bracketOnError (socket AF_INET Stream defaultProtocol) sClose $ \sock -> do - connect sock (SockAddrInet pn (head $ hostAddresses he)) - socketToHandle sock ReadWriteMode - client params rng h + h <- bracketOnError (socket AF_INET Stream defaultProtocol) sClose $ \sock -> do + connect sock (SockAddrInet pn (head $ hostAddresses he)) + socketToHandle sock ReadWriteMode + contextNewOnHandle h params rng diff --git a/Network/TLS/Extra/Thread.hs b/Network/TLS/Extra/Thread.hs deleted file mode 100644 --- a/Network/TLS/Extra/Thread.hs +++ /dev/null @@ -1,3 +0,0 @@ -module Network.TLS.Extra.Thread - ( - ) where diff --git a/Tests.hs b/Tests.hs --- a/Tests.hs +++ b/Tests.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE CPP #-} - import qualified Tests.Connection as Connection import qualified Tests.Ciphers as Ciphers diff --git a/tls-extra.cabal b/tls-extra.cabal --- a/tls-extra.cabal +++ b/tls-extra.cabal @@ -1,5 +1,5 @@ Name: tls-extra -Version: 0.4.7.1 +Version: 0.6.6 Description: a set of extra definitions, default values and helpers for tls. License: BSD3 @@ -12,7 +12,7 @@ Category: Network stability: experimental Cabal-Version: >=1.6 -Homepage: http://github.com/vincenthz/hs-tls-extra +Homepage: http://github.com/vincenthz/hs-tls Flag test Description: Build unit test @@ -20,24 +20,24 @@ Library Build-Depends: base > 3 && < 5 - , tls >= 0.9.4 && < 1.0.0 + , tls >= 1.1.0 && < 1.2.0 , mtl , network >= 2.3 , cryptohash >= 0.6 , bytestring , vector - , crypto-api >= 0.5 - , cryptocipher >= 0.3.0 && < 0.4.0 - , certificate >= 1.2.0 && < 1.3.0 - , pem >= 0.1.0 && < 0.2.0 - , text >= 0.5 && < 1.0 + , cipher-rc4 + , cipher-aes >= 0.2 && < 0.3 + , certificate >= 1.3.5 && < 1.4.0 + , crypto-pubkey >= 0.2.0 + , crypto-random + , pem >= 0.1 && < 0.3 , time Exposed-modules: Network.TLS.Extra other-modules: Network.TLS.Extra.Certificate 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) @@ -51,10 +51,13 @@ , HUnit , QuickCheck >= 2 , bytestring - , cprng-aes >= 0.2.3 + , cprng-aes >= 0.5.0 + , cipher-aes >= 0.2 && < 0.3 else Buildable: False + if os(windows) + cpp-options: -DNOCERTVERIFY source-repository head type: git - location: git://github.com/vincenthz/hs-tls-extra + location: git://github.com/vincenthz/hs-tls