diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright (c) 2010-2012 Vincent Hanquez +Copyright (c) 2010-2015 Vincent Hanquez All rights reserved. diff --git a/src/RetrieveCertificate.hs b/src/RetrieveCertificate.hs --- a/src/RetrieveCertificate.hs +++ b/src/RetrieveCertificate.hs @@ -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) diff --git a/src/SimpleClient.hs b/src/SimpleClient.hs --- a/src/SimpleClient.hs +++ b/src/SimpleClient.hs @@ -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] [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 diff --git a/src/Stunnel.hs b/src/Stunnel.hs --- a/src/Stunnel.hs +++ b/src/Stunnel.hs @@ -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) diff --git a/tls-debug.cabal b/tls-debug.cabal --- a/tls-debug.cabal +++ b/tls-debug.cabal @@ -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