tls-extra 0.1.7 → 0.1.8

raw patch · 4 files changed

+114/−1 lines, 4 filesnew-component:exe:retrievecertificate

Files

• Examples/RetrieveCertificate.hs +65/−0
• Network/TLS/Extra.hs +3/−0
• Network/TLS/Extra/Connection.hs +34/−0
• tls-extra.cabal +12/−1

@@ -0,0 +1,65 @@+{-# LANGUAGE ScopedTypeVariables, DeriveDataTypeable #-}++import Network.TLS+import Network.TLS.Extra++import Data.Char+import Data.IORef++import System.IO+import Control.Monad+import Prelude hiding (catch)++import Text.Printf++import System.Console.CmdArgs++openConnection s p = do+	ref <- newIORef Nothing+	(Right rng) <- makeSRandomGen+	let params = defaultParams+		{ pCiphers           = ciphersuite_all+		, onCertificatesRecv = \l -> do+			modifyIORef ref (const $ Just l)+			return True+		}+	ctx <- connectionClient s p params rng+	handshake ctx+	bye ctx+	r <- readIORef ref+	case r of+		Nothing    -> error "cannot retrieve any certificate"+		Just certs -> return certs++data PArgs = PArgs+	{ destination :: String+	, port        :: String+	, chain       :: Bool+	, output      :: String+	} deriving (Show, Data, Typeable)++progArgs = PArgs+	{ destination = "localhost" &= help "destination address to connect to" &= typ "address"+	, port        = "443"       &= help "destination port to connect to" &= typ "port"+	, chain       = False       &= help "also output the chain of certificate used"+	, output      = "pem"       &= help "define the format of output (PEM by default)" &= typ "format"+	} &= summary "RetrieveCertificate remotely for SSL/TLS protocol"+	&= details+		[ "Retrieve the remote certificate and optionally its chain from a remote destination"+		]++showCert _ cert =+	putStrLn $ show cert++main = do+	a <- cmdArgs progArgs+	_ <- printf "connecting to %s on port %s ...\n" (destination a) (port a)++	certs <- openConnection (destination a) (port a)+	case (chain a) of+		True ->+			forM_ (zip [0..] certs) $ \(n, cert) -> do+				putStrLn ("###### Certificate " ++ show (n + 1) ++ " ######")+				showCert (output a) cert+		False ->+			showCert (output a) $ head certs

@@ -11,7 +11,10 @@ 	  module Network.TLS.Extra.Cipher 	-- * Certificate helpers 	, module Network.TLS.Extra.Certificate+	-- * Connection helpers+	, module Network.TLS.Extra.Connection 	) where  import Network.TLS.Extra.Cipher import Network.TLS.Extra.Certificate+import Network.TLS.Extra.Connection

@@ -0,0 +1,34 @@+-- |+-- Module      : Network.TLS.Extra.Connection+-- License     : BSD-style+-- Maintainer  : Vincent Hanquez <vincent@snarc.org>+-- Stability   : experimental+-- Portability : unknown+--+module Network.TLS.Extra.Connection+	( connectionClient+	) where++import Control.Applicative ((<$>))+import Control.Exception+import Data.Char++import System.IO++import Network.BSD+import Network.Socket+import Network.TLS++-- | open a TCP client connection to a destination and port description (number or name)+-- +connectionClient :: String -> String -> TLSParams -> SRandomGen -> IO TLSCtx+connectionClient s p params rng = do+	pn <- if and $ map isDigit $ p+		then return $ fromIntegral $ (read p :: Int)+		else servicePort <$> getServiceByName p "tcp"+        he <- getHostByName s++	h  <- bracketOnError (socket AF_INET Stream defaultProtocol) sClose $ \sock -> do+		connect sock (SockAddrInet pn (head $ hostAddresses he))+		socketToHandle sock ReadWriteMode+	client params rng h

@@ -1,5 +1,5 @@ Name:                tls-extra-Version:             0.1.7+Version:             0.1.8 Description:    a set of extra definitions, default values and helpers for tls. License:             BSD3@@ -41,6 +41,7 @@   other-modules:     Network.TLS.Extra.Certificate                      Network.TLS.Extra.Cipher                      Network.TLS.Extra.Compression+                     Network.TLS.Extra.Connection                      Network.TLS.Extra.Thread   ghc-options:       -Wall -fno-warn-missing-signatures   if os(windows) || os(osx)@@ -58,6 +59,16 @@  Executable           checkciphers   Main-is:           Examples/CheckCiphers.hs+  if flag(executable)+    Build-Depends:   network+                   , cmdargs+    Buildable:       True+  else+    Buildable:       False+  ghc-options:       -Wall -fno-warn-missing-signatures++Executable           retrievecertificate+  Main-is:           Examples/RetrieveCertificate.hs   if flag(executable)     Build-Depends:   network                    , cmdargs