tls-extra 0.1.4 → 0.1.5
raw patch · 3 files changed
+33/−11 lines, 3 files
Files
- Examples/Stunnel.hs +7/−3
- Network/TLS/Extra/Certificate.hs +25/−7
- tls-extra.cabal +1/−1
Examples/Stunnel.hs view
@@ -46,7 +46,7 @@ handshake dsthandle - forkIO $ forever $ do+ _ <- forkIO $ forever $ do dat <- recvData dsthandle putStrLn ("received " ++ show dat) L.hPut srchandle dat@@ -126,7 +126,8 @@ { destinationType :: String , destination :: String , sourceType :: String- , source :: String }+ , source :: String+ , validCert :: Bool } | Server { destinationType :: String , destination :: String@@ -141,6 +142,7 @@ , destination = "localhost:6061" &= help "destination address influenced by destination type" &= typ "ADDRESS" , sourceType = "tcp" &= help "type of source (tcp, unix, fd)" &= typ "SOURCETYPE" , source = "localhost:6060" &= help "source address influenced by source type" &= typ "ADDRESS"+ , validCert = False &= help "check if the certificate receive is valid" &= typ "Bool" } &= help "connect to a remote destination that use SSL/TLS" @@ -208,11 +210,13 @@ srcaddr <- getAddressDescription (sourceType pargs) (source pargs) dstaddr <- getAddressDescription (destinationType pargs) (destination pargs) + let crecv = if validCert pargs then certificateVerifyChain else (\_ -> return True) let clientstate = defaultParams { pConnectVersion = TLS10 , pAllowedVersions = [ TLS10, TLS11 ] , pCiphers = ciphers , pCertificates = []+ , onCertificatesRecv = crecv } case srcaddr of@@ -258,5 +262,5 @@ main = do x <- cmdArgsRun mode case x of- Client _ _ _ _ -> doClient x+ Client _ _ _ _ _ -> doClient x Server _ _ _ _ _ _ -> doServer x
Network/TLS/Extra/Certificate.hs view
@@ -8,7 +8,7 @@ -- module Network.TLS.Extra.Certificate ( certificateVerifyChain- , certificateVerify+ , certificateVerifyAgainst ) where import qualified Data.ByteString as B@@ -42,6 +42,16 @@ -- -- each certificate of the list is verified against the next certificate, until -- it can be verified against a system certificate (system certificates are assumed as trusted)+--+-- This helper only check that the chain of certificate is valid, which means that each items+-- received are signed by the next one, or by a system certificate. Some extra checks need to+-- be done at the user level so that the certificate chain received make sense in the context.+--+-- for example for HTTP, the user should typically verify the certificate subject match the URL+-- of connection.+--+-- TODO: verify validity, check revocation list if any, add optional user output to know+-- the rejection reason. certificateVerifyChain :: [X509] -> IO Bool certificateVerifyChain l | l == [] = return False@@ -49,9 +59,9 @@ -- 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+ Just sysx509 -> certificateVerifyAgainst (head l) sysx509 Nothing -> do- validChain <- certificateVerify (head l) (head $ tail l)+ validChain <- certificateVerifyAgainst (head l) (head $ tail l) if validChain then certificateVerifyChain $ tail l else return False@@ -64,8 +74,8 @@ -- | verify a certificate against another one. -- the first certificate need to be signed by the second one for this function to succeed.-certificateVerify :: X509 -> X509 -> IO Bool-certificateVerify ux509@(X509 _ _ sigalg sig) (X509 scert _ _ _) = do+certificateVerifyAgainst :: X509 -> X509 -> IO Bool+certificateVerifyAgainst ux509@(X509 _ _ sigalg sig) (X509 scert _ _ _) = do let f = verifyF sigalg pk case f udata esig of Right True -> return True@@ -77,14 +87,21 @@ verifyF :: SignatureALG -> PubKey -> B.ByteString -> B.ByteString -> Either String Bool +-- md[245]WithRSAEncryption:+--+-- pkcs-1 OBJECT IDENTIFIER ::= { iso(1) member-body(2) US(840) rsadsi(113549) pkcs(1) 1 }+-- rsaEncryption OBJECT IDENTIFIER ::= { pkcs-1 1 }+-- md2WithRSAEncryption OBJECT IDENTIFIER ::= { pkcs-1 2 }+-- md4WithRSAEncryption OBJECT IDENTIFIER ::= { pkcs-1 3 }+-- md5WithRSAEncryption OBJECT IDENTIFIER ::= { pkcs-1 4 } 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"+ where asn1 = "\x30\x20\x30\x0c\x06\x08\x2a\x86\x48\x86\xf7\x0d\x02\x05\x05\x00\x02\x10" 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 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"+ where asn1 = "\x30\x21\x30\x09\x06\x05\x2b\x0e\x03\x02\x1a\x05\x00\x04\x14" verifyF SignatureALG_dsaWithSHA1 (PubKeyDSA (pub,p,q,g)) = dsaSHA1Verify pk where@@ -96,5 +113,6 @@ 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 }
tls-extra.cabal view
@@ -1,5 +1,5 @@ Name: tls-extra-Version: 0.1.4+Version: 0.1.5 Description: a set of extra definitions, default values and helpers for tls. License: BSD3