tls-debug 0.3.4 → 0.4.0
raw patch · 5 files changed
+57/−28 lines, 5 filesdep +cryptonitedep −cprng-aesdep −crypto-pubkeydep ~tls
Dependencies added: cryptonite
Dependencies removed: cprng-aes, crypto-pubkey
Dependency ranges changed: tls
Files
- LICENSE +1/−1
- src/RetrieveCertificate.hs +1/−4
- src/SimpleClient.hs +45/−10
- src/Stunnel.hs +3/−5
- tls-debug.cabal +7/−8
LICENSE view
@@ -1,4 +1,4 @@-Copyright (c) 2010-2012 Vincent Hanquez <vincent@snarc.org>+Copyright (c) 2010-2015 Vincent Hanquez <vincent@snarc.org> All rights reserved.
src/RetrieveCertificate.hs view
@@ -16,8 +16,6 @@ import Control.Monad import Control.Exception -import qualified Crypto.Random.AESCtr as RNG- import Data.Char (isDigit) import Data.PEM @@ -31,7 +29,6 @@ openConnection s p = do ref <- newIORef Nothing- rng <- RNG.makeSystem let params = (defaultParamsClient s (B.pack p)) { clientSupported = def { supportedCiphers = ciphersuite_all } , clientShared = def { sharedValidationCache = noValidate }@@ -46,7 +43,7 @@ sock <- bracketOnError (socket AF_INET Stream defaultProtocol) sClose $ \sock -> do connect sock (SockAddrInet pn (head $ hostAddresses he)) return sock- ctx <- contextNew sock params rng+ ctx <- contextNew sock params contextHookSetCertificateRecv ctx $ \l -> modifyIORef ref (const $ Just l)
src/SimpleClient.hs view
@@ -7,7 +7,6 @@ import System.Console.GetOpt import System.IO import System.Timeout-import qualified Crypto.Random.AESCtr as RNG import qualified Data.ByteString.Lazy.Char8 as LC import qualified Data.ByteString.Char8 as BC import Control.Exception@@ -19,6 +18,7 @@ import Data.Default.Class import Data.IORef+import Data.Monoid import Data.X509.Validation ciphers :: [Cipher]@@ -34,16 +34,18 @@ , cipher_RC4_128_MD5 , cipher_RC4_128_SHA1 , cipher_RSA_3DES_EDE_CBC_SHA1+ , cipher_DHE_RSA_AES128GCM_SHA256 ] +bogusCipher cid = cipher_AES128_SHA1 { cipherID = cid }+ runTLS debug ioDebug params hostname portNumber f = do- rng <- RNG.makeSystem he <- getHostByName hostname sock <- socket AF_INET Stream defaultProtocol let sockaddr = SockAddrInet portNumber (head $ hostAddresses he) E.catch (connect sock sockaddr) (\(e :: SomeException) -> sClose sock >> error ("cannot open socket " ++ show sockaddr ++ " " ++ show e))- ctx <- contextNew sock params rng+ ctx <- contextNew sock params contextHookSetLogging ctx getLogging () <- f ctx sClose sock@@ -65,15 +67,17 @@ , sessionInvalidate = \_ -> return () } -getDefaultParams flags host store sStorage session =+getDefaultParams flags host store sStorage certCredsRequest session = (defaultParamsClient host BC.empty)- { clientSupported = def { supportedVersions = supportedVers, supportedCiphers = ciphers }+ { clientSupported = def { supportedVersions = supportedVers, supportedCiphers = myCiphers } , clientWantSessionResume = session , clientUseServerNameIndication = not (NoSNI `elem` flags) , clientShared = def { sharedSessionManager = sessionRef sStorage , sharedCAStore = store , sharedValidationCache = validateCache+ , sharedCredentials = maybe mempty fst certCredsRequest }+ , clientHooks = def { onCertificateRequest = maybe (onCertificateRequest def) snd certCredsRequest } } where validateCache@@ -81,6 +85,13 @@ | otherwise = ValidationCache (\_ _ _ -> return ValidationCachePass) (\_ _ _ -> return ()) + myCiphers = foldl accBogusCipher ciphers flags+ where accBogusCipher acc (BogusCipher c) =+ case reads c of+ [(v, "")] -> acc ++ [bogusCipher v]+ _ -> acc+ accBogusCipher acc _ = acc+ tlsConnectVer | Tls12 `elem` flags = TLS12 | Tls11 `elem` flags = TLS11@@ -101,6 +112,8 @@ | UserAgent String | Output String | Timeout String+ | BogusCipher String+ | ClientCert String | Help deriving (Show,Eq) @@ -113,6 +126,7 @@ , Option ['O'] ["output"] (ReqArg Output "stdout") "output " , Option ['t'] ["timeout"] (ReqArg Timeout "timeout") "timeout in milliseconds (2s by default)" , Option [] ["no-validation"] (NoArg NoValidateCert) "disable certificate validation"+ , Option [] ["client-cert"] (ReqArg ClientCert "cert-file:key-file") "add a client certificate to use with the server" , Option [] ["http1.1"] (NoArg Http11) "use http1.1 instead of http1.0" , Option [] ["ssl3"] (NoArg Ssl3) "use SSL 3.0" , Option [] ["no-sni"] (NoArg NoSNI) "don't use server name indication"@@ -120,17 +134,20 @@ , Option [] ["tls10"] (NoArg Tls10) "use TLS 1.0" , Option [] ["tls11"] (NoArg Tls11) "use TLS 1.1" , Option [] ["tls12"] (NoArg Tls12) "use TLS 1.2 (default)"+ , Option [] ["bogocipher"] (ReqArg BogusCipher "cipher-id") "add a bogus cipher id for testing" , Option ['x'] ["no-version-downgrade"] (NoArg NoVersionDowngrade) "do not allow version downgrade" , Option [] ["uri"] (ReqArg Uri "URI") "optional URI requested by default /" , Option ['h'] ["help"] (NoArg Help) "request help" ] runOn (sStorage, certStore) flags port hostname = do- doTLS Nothing+ certCredRequest <- getCredRequest+ doTLS certCredRequest Nothing when (Session `elem` flags) $ do session <- readIORef sStorage- doTLS (Just session)- where doTLS sess = do+ doTLS certCredRequest (Just session)+ where+ doTLS certCredRequest sess = do let query = LC.pack ( "GET " ++ findURI flags@@ -141,7 +158,7 @@ out <- maybe (return stdout) (flip openFile WriteMode) getOutput runTLS (Debug `elem` flags) (IODebug `elem` flags)- (getDefaultParams flags hostname certStore sStorage sess) hostname port $ \ctx -> do+ (getDefaultParams flags hostname certStore sStorage certCredRequest sess) hostname port $ \ctx -> do handshake ctx sendData ctx $ query loopRecv out ctx@@ -154,6 +171,21 @@ Just b | BC.null b -> return () | otherwise -> BC.hPutStrLn out b >> loopRecv out ctx + getCredRequest =+ case clientCert of+ Nothing -> return Nothing+ Just s -> do+ case break (== ':') s of+ (_ ,"") -> error "wrong format for client-cert, expecting 'cert-file:key-file'"+ (cert,':':key) -> do+ ecred <- credentialLoadX509 cert key+ case ecred of+ Left err -> error ("cannot load client certificate: " ++ err)+ Right cred -> do+ let certRequest _ = return $ Just cred+ return $ Just (Credentials [cred], certRequest)+ (_ ,_) -> error "wrong format for client-cert, expecting 'cert-file:key-file'"+ findURI [] = "/" findURI (Uri u:_) = u findURI (_:xs) = findURI xs@@ -168,6 +200,9 @@ timeoutMs = foldl f 2000 flags where f _ (Timeout t) = read t f acc _ = acc+ clientCert = foldl f Nothing flags+ where f _ (ClientCert c) = Just c+ f acc _ = acc printUsage = putStrLn $ usageInfo "usage: simpleclient [opts] <hostname> [port]\n\n\t(port default to: 443)\noptions:\n" options@@ -184,7 +219,7 @@ exitSuccess certStore <- getSystemCertificateStore- sStorage <- newIORef undefined+ sStorage <- newIORef (error "storage ioref undefined") case other of [hostname] -> runOn (sStorage, certStore) opts 443 hostname [hostname,port] -> runOn (sStorage, certStore) opts (fromInteger $ read port) hostname
src/Stunnel.hs view
@@ -22,7 +22,7 @@ import Data.Char (isDigit) import Data.Default.Class -import qualified Crypto.Random.AESCtr as RNG+import Crypto.Random import Network.TLS import Network.TLS.Extra.Cipher @@ -96,7 +96,6 @@ } clientProcess dhParamsFile creds handle dsthandle dbg sessionStorage _ = do- rng <- RNG.makeSystem let logging = if not dbg then def else def { loggingPacketSent = putStrLn . ("debug: send: " ++)@@ -115,7 +114,7 @@ , serverDHEParams = dhParams } - ctx <- contextNew handle serverstate rng+ ctx <- contextNew handle serverstate contextHookSetLogging ctx logging tlsserver ctx dsthandle @@ -193,13 +192,12 @@ (StunnelSocket srcsocket) <- listenAddressDescription srcaddr forever $ do (s, _) <- accept srcsocket- rng <- RNG.makeSystem srch <- socketToHandle s ReadWriteMode (StunnelSocket dst) <- connectAddressDescription dstaddr dsth <- socketToHandle dst ReadWriteMode- dstctx <- contextNew dsth clientstate rng+ dstctx <- contextNew dsth clientstate contextHookSetLogging dstctx logging _ <- forkIO $ finally (tlsclient srch dstctx)
tls-debug.cabal view
@@ -1,5 +1,5 @@ Name: tls-debug-Version: 0.3.4+Version: 0.4.0 Description: A set of program to test and debug various aspect of the TLS package. .@@ -22,10 +22,9 @@ , network , bytestring , x509-system >= 1.0- , cprng-aes >= 0.5.0 , data-default-class- , crypto-pubkey- , tls >= 1.2.8 && < 1.3+ , cryptonite+ , tls >= 1.3.0 && < 1.4 if os(windows) Buildable: False else@@ -52,11 +51,11 @@ , bytestring , time , pem- , cprng-aes >= 0.5.0+ , cryptonite , x509 , x509-system >= 1.4 , x509-validation >= 1.5.0- , tls >= 1.2 && < 1.3+ , tls >= 1.3 && < 1.4 Buildable: True ghc-options: -Wall -fno-warn-missing-signatures @@ -67,9 +66,9 @@ , network , bytestring , data-default-class- , cprng-aes >= 0.5.0+ , cryptonite , x509-system >= 1.0- , tls >= 1.2 && < 1.3+ , tls >= 1.3 && < 1.4 Buildable: True ghc-options: -Wall -fno-warn-missing-signatures