packages feed

tls-debug 0.2.0 → 0.2.1

raw patch · 3 files changed

+96/−47 lines, 3 filesdep ~cprng-aes

Dependency ranges changed: cprng-aes

Files

src/CheckCiphers.hs view
@@ -82,7 +82,7 @@ 	, cipherMinVer       = Nothing 	} -clienthello ciphers = ClientHello TLS10 (ClientRandom $ B.pack [0..31]) (Session Nothing) ciphers [0] []+clienthello ciphers = ClientHello TLS10 (ClientRandom $ B.pack [0..31]) (Session Nothing) ciphers [0] [] Nothing  openConnection :: String -> String -> [Word16] -> IO (Maybe Word16) openConnection s p ciphers = do
src/SimpleClient.hs view
@@ -1,22 +1,23 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} import Network.BSD-import Network.Socket+import Network.Socket (socket, socketToHandle, Family(..), SocketType(..), sClose, SockAddr(..), connect) import Network.TLS import Network.TLS.Extra+import System.Console.GetOpt import System.IO 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 import qualified Control.Exception as E+import Control.Monad import System.Environment+import System.Exit import System.Certificate.X509  import Data.IORef -validateCert = True-debug = False- ciphers :: [Cipher] ciphers = 	[ cipher_AES128_SHA1@@ -34,7 +35,7 @@ 	      (\(e :: SomeException) -> sClose sock >> error ("cannot open socket " ++ show sockaddr ++ " " ++ show e)) 	dsth <- socketToHandle sock ReadWriteMode 	ctx <- contextNewOnHandle dsth params rng-	f ctx+	() <- f ctx 	hClose dsth  data SessionRef = SessionRef (IORef (SessionID, SessionData))@@ -44,43 +45,91 @@     sessionResume (SessionRef ref) sid = readIORef ref >>= \(s,d) -> if s == sid then return (Just d) else return Nothing     sessionInvalidate _ _ = return () -getDefaultParams store sStorage session = updateClientParams setCParams $ setSessionManager (SessionRef sStorage) $ defaultParamsClient-	{ pConnectVersion    = TLS10-	, pAllowedVersions   = [TLS10,TLS11,TLS12]-	, pCiphers           = ciphers-	, pCertificates      = []-	, pLogging           = logging-	, onCertificatesRecv = crecv-	}-	where-		setCParams cparams = cparams { clientWantSessionResume = session }-		logging = if not debug then defaultLogging else defaultLogging-			{ loggingPacketSent = putStrLn . ("debug: >> " ++)-			, loggingPacketRecv = putStrLn . ("debug: << " ++)-			}-		crecv = if validateCert then certificateVerifyChain store else (\_ -> return CertificateUsageAccept)+getDefaultParams flags store sStorage session =+    updateClientParams setCParams $ setSessionManager (SessionRef sStorage) $ defaultParamsClient+        { pConnectVersion    = tlsConnectVer+        , pAllowedVersions   = [TLS10,TLS11,TLS12]+        , pCiphers           = ciphers+        , pCertificates      = []+        , pLogging           = logging+        , onCertificatesRecv = crecv+        }+    where+            setCParams cparams = cparams { clientWantSessionResume = session }+            logging = if not debug then defaultLogging else defaultLogging+                { loggingPacketSent = putStrLn . ("debug: >> " ++)+                , loggingPacketRecv = putStrLn . ("debug: << " ++)+                }+            crecv = if validateCert then certificateVerifyChain store else (\_ -> return CertificateUsageAccept) +            tlsConnectVer+                | Tls12 `elem` flags = TLS12+                | Tls11 `elem` flags = TLS11+                | Ssl3  `elem` flags = SSL3+                | otherwise          = TLS10+            debug = Debug `elem` flags+            validateCert = not (NoValidateCert `elem` flags) +data Flag = Verbose | Debug | NoValidateCert | Session | Http11+          | Ssl3 | Tls11 | Tls12+          | Uri String+          | Help+          deriving (Show,Eq)++options :: [OptDescr Flag]+options =+    [ Option ['v']  ["verbose"] (NoArg Verbose) "verbose output on stdout"+    , Option ['d']  ["debug"]   (NoArg Debug) "TLS debug output on stdout"+    , Option ['s']  ["session"] (NoArg Session) "try to resume a session"+    , Option []     ["no-validation"] (NoArg NoValidateCert) "disable certificate validation"+    , Option []     ["http1.1"] (NoArg Http11) "use http1.1 instead of http1.0"+    , Option []     ["ssl3"]    (NoArg Ssl3) "use SSL 3.0 as default"+    , Option []     ["tls11"]   (NoArg Tls11) "use TLS 1.1 as default"+    , Option []     ["tls12"]   (NoArg Tls12) "use TLS 1.2 as default"+    , 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+    when (Session `elem` flags) $ do+        session <- readIORef sStorage+        doTLS (Just session)+    where doTLS sess = do+            let query = LC.pack (+                        "GET "+                        ++ findURI flags+                        ++ (if Http11 `elem` flags then (" HTTP/1.1\r\nHost: " ++ hostname) else " HTTP/1.0")+                        ++ "\r\n\r\n")+            when (Verbose `elem` flags) (putStrLn "sending query:" >> LC.putStrLn query >> putStrLn "")+            runTLS (getDefaultParams flags certStore sStorage sess) hostname (fromIntegral port) $ \ctx -> do+                handshake ctx+                sendData ctx $ query+                d <- recvData ctx+                bye ctx+                BC.putStrLn d+                return ()+          findURI []        = "/"+          findURI (Uri u:_) = u+          findURI (_:xs)    = findURI xs++printUsage =+    putStrLn $ usageInfo "usage: simpleclient [opts] <hostname> [port]\n\n\t(port default to: 443)\noptions:\n" options+ main = do-	sStorage <- newIORef undefined-	args     <- getArgs-	let hostname = args !! 0-	let port = read (args !! 1) :: Int-	store <- getSystemCertificateStore-	runTLS (getDefaultParams store sStorage Nothing) hostname (fromIntegral port) $ \ctx -> do-		handshake ctx-		sendData ctx $ LC.pack "GET / HTTP/1.0\r\n\r\n"-		d <- recvData' ctx-		bye ctx-		LC.putStrLn d-		return ()-{--	session <- readIORef sStorage-	runTLS (getDefaultParams sStorage $ Just session) hostname port $ \ctx -> do-		handshake ctx-		sendData ctx $ LC.pack "GET / HTTP/1.0\r\n\r\n"-		d <- recvData ctx-		bye ctx-		LC.putStrLn d-		return ()--}+    args <- getArgs+    let (opts,other,errs) = getOpt Permute options args+    when (not $ null errs) $ do+        putStrLn $ show errs+        exitFailure++    when (Help `elem` opts) $ do+        printUsage+        exitSuccess++    certStore <- getSystemCertificateStore+    sStorage <- newIORef undefined+    case other of+        [hostname]      -> runOn (sStorage, certStore) opts 443 hostname+        [hostname,port] -> runOn (sStorage, certStore) opts (read port) hostname+        _               -> printUsage >> exitFailure
tls-debug.cabal view
@@ -1,5 +1,5 @@ Name:                tls-debug-Version:             0.2.0+Version:             0.2.1 Description:    A set of program to test and debug various aspect of the TLS package.    .@@ -23,7 +23,7 @@                    , bytestring                    , cmdargs                    , certificate >= 1.0-                   , cprng-aes >= 0.2.3+                   , cprng-aes >= 0.3.0                    , tls >= 1.0 && < 1.1                    , tls-extra >= 0.5 && < 0.6   Buildable:         True@@ -50,7 +50,7 @@                    , bytestring                    , cmdargs                    , time-                   , cprng-aes >= 0.2.3+                   , cprng-aes >= 0.3.0                    , certificate >= 1.0                    , tls >= 1.0 && < 1.1                    , tls-extra >= 0.5 && < 0.6@@ -64,7 +64,7 @@                    , network                    , bytestring                    , cmdargs-                   , cprng-aes >= 0.2.3+                   , cprng-aes >= 0.3.0                    , certificate >= 1.0                    , tls >= 1.0 && < 1.1                    , tls-extra >= 0.5 && < 0.6