tls-extra 0.1.0 → 0.1.1
raw patch · 3 files changed
+52/−46 lines, 3 files
Files
- Network/TLS/Extra.hs +2/−0
- Network/TLS/Extra/Certificate.hs +48/−44
- tls-extra.cabal +2/−2
Network/TLS/Extra.hs view
@@ -1,5 +1,7 @@ module Network.TLS.Extra ( module Network.TLS.Extra.Cipher+ , module Network.TLS.Extra.Certificate ) where import Network.TLS.Extra.Cipher+import Network.TLS.Extra.Certificate
Network/TLS/Extra/Certificate.hs view
@@ -1,21 +1,14 @@+{-# LANGUAGE OverloadedStrings #-} module Network.TLS.Extra.Certificate- (+ ( certificateVerifyChain+ , certificateVerify ) where-{- -import qualified Data.ByteString.Lazy as L-import qualified Data.ByteString.Lazy.Char8 as LC import qualified Data.ByteString as B---import qualified Data.Text.Lazy as T---import Data.Text.Lazy.Encoding (decodeUtf8)--import Data.Certificate.PEM+import qualified Data.ByteString.Lazy as L import Data.Certificate.X509 import System.Certificate.X509 as SysCert -import Control.Monad-import Control.Applicative ((<$>))- -- for signing/verifying certificate import qualified Crypto.Hash.SHA1 as SHA1 import qualified Crypto.Hash.MD2 as MD2@@ -23,45 +16,56 @@ import qualified Crypto.Cipher.RSA as RSA import qualified Crypto.Cipher.DSA as DSA -verifyCert x509@(X509.X509 cert _ sigalg sig) = do- sysx509 <- SysCert.findCertificate (matchsysX509 cert)- case sysx509 of- Nothing -> putStrLn "couldn't find signing certificate"- Just (X509.X509 syscert _ _ _) -> do- verifyAlg (B.concat $ L.toChunks $ X509.getSigningData x509)- (B.pack sig)- sigalg- (X509.certPubKey syscert)+certificateVerifyChain :: [X509] -> IO Bool+certificateVerifyChain l+ | l == [] = return False+ | otherwise = do+ -- find a matching certificate that we trust (== installed on the system)+ found <- SysCert.findCertificate (matchsysX509 $ head l)+ case found of+ Just sysx509 -> certificateVerify (head l) sysx509+ Nothing -> do+ validChain <- certificateVerify (head l) (head $ tail l)+ if validChain+ then certificateVerifyChain $ tail l+ else return False+ where+ matchsysX509 (X509 cert _ _ _) (X509 syscert _ _ _) = do+ let x = certSubjectDN syscert+ let y = certIssuerDN cert+ x == y -rsaVerify h hdesc pk a b = either (Left . show) (Right) $ RSA.verify h hdesc pk a b+certificateVerify :: X509 -> X509 -> IO Bool+certificateVerify ux509@(X509 _ _ sigalg sig) (X509 scert _ _ _) = do+ let f = verifyF sigalg pk+ case f udata esig of+ Right True -> return True+ _ -> return False+ where+ udata = B.concat $ L.toChunks $ getSigningData ux509+ esig = B.pack sig+ pk = certPubKey scert -verifyF X509.SignatureALG_md2WithRSAEncryption (X509.PubKeyRSA rsakey) =- rsaVerify MD2.hash (B.pack [0x30,0x20,0x30,0x0c,0x06,0x08,0x2a,0x86,0x48,0x86,0xf7,0x0d,0x02,0x05,0x05,0x00,0x04,0x10]) (mkRSA rsakey)+verifyF :: SignatureALG -> PubKey -> B.ByteString -> B.ByteString -> Either String Bool -verifyF X509.SignatureALG_md5WithRSAEncryption (X509.PubKeyRSA rsakey) =- rsaVerify MD5.hash (B.pack [0x30,0x20,0x30,0x0c,0x06,0x08,0x2a,0x86,0x48,0x86,0xf7,0x0d,0x02,0x05,0x05,0x00,0x04,0x10]) (mkRSA rsakey)+verifyF SignatureALG_md2WithRSAEncryption (PubKeyRSA rsak) = rsaVerify MD2.hash asn1 (mkRSA rsak)+ where asn1 = "\x30\x20\x30\x0c\x06\x08\x2a\x86\x48\x86\xf7\x0d\x02\x05\x05\x00\x04\x10" -verifyF X509.SignatureALG_sha1WithRSAEncryption (X509.PubKeyRSA rsakey) =- rsaVerify SHA1.hash (B.pack [0x30,0x20,0x30,0x0c,0x06,0x08,0x2a,0x86,0x48,0x86,0xf7,0x0d,0x02,0x05,0x05,0x00,0x04,0x10]) (mkRSA rsakey)+verifyF SignatureALG_md5WithRSAEncryption (PubKeyRSA rsak) = rsaVerify MD5.hash asn1 (mkRSA rsak)+ where asn1 = "\x30\x20\x30\x0c\x06\x08\x2a\x86\x48\x86\xf7\x0d\x02\x05\x05\x00\x04\x10" -verifyF X509.SignatureALG_dsaWithSHA1 (X509.PubKeyDSA (pub,p,q,g)) =- (\_ _ -> Left "unimplemented DSA checking")+verifyF SignatureALG_sha1WithRSAEncryption (PubKeyRSA rsak) = rsaVerify SHA1.hash asn1 (mkRSA rsak)+ where asn1 = "\x30\x20\x30\x0c\x06\x08\x2a\x86\x48\x86\xf7\x0d\x02\x05\x05\x00\x04\x10" -verifyF _ _ =- (\_ _ -> Left "unexpected/wrong signature")+verifyF SignatureALG_dsaWithSHA1 (PubKeyDSA (pub,p,q,g)) = dsaSHA1Verify pk+ where+ pk = DSA.PublicKey { DSA.public_params = (p,g,q), DSA.public_y = pub }+ +verifyF _ _ = (\_ _ -> Left "unexpected/wrong signature") +dsaSHA1Verify pk a 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 -}++rsaVerify h hdesc pk a b = either (Left . show) (Right) $ RSA.verify h hdesc pk a b mkRSA (lenmodulus, modulus, e) = RSA.PublicKey { RSA.public_sz = lenmodulus, RSA.public_n = modulus, RSA.public_e = e }--verifyAlg toSign expectedSig sigalg pk =- let f = verifyF sigalg pk in- case f toSign expectedSig of- Left err -> putStrLn ("certificate couldn't be verified: something happened: " ++ show err)- Right True -> putStrLn "certificate verified"- Right False -> putStrLn "certificate not verified"--matchsysX509 cert (X509.X509 syscert _ _ _) = do- let x = X509.certSubjectDN syscert- let y = X509.certIssuerDN cert- x == y--}
tls-extra.cabal view
@@ -1,5 +1,5 @@ Name: tls-extra-Version: 0.1.0+Version: 0.1.1 Description: a set of extra definitions, default values and helpers for tls. License: BSD3@@ -40,7 +40,7 @@ Network.TLS.Extra.Cipher Network.TLS.Extra.Compression Network.TLS.Extra.Thread- ghc-options: -Wall+ ghc-options: -Wall -fno-warn-missing-signatures Executable stunnel Main-is: Examples/Stunnel.hs