2011-04-10 20:34:28 +00:00
|
|
|
{-# 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)
|
|
|
|
|
2011-04-11 19:03:49 +00:00
|
|
|
import qualified Crypto.Random.AESCtr as RNG
|
|
|
|
|
2011-04-10 20:34:28 +00:00
|
|
|
import Text.Printf
|
|
|
|
|
|
|
|
import System.Console.CmdArgs
|
|
|
|
|
|
|
|
openConnection s p = do
|
|
|
|
ref <- newIORef Nothing
|
2011-04-11 19:03:49 +00:00
|
|
|
rng <- RNG.makeSystem
|
2011-04-10 20:34:28 +00:00
|
|
|
let params = defaultParams
|
|
|
|
{ pCiphers = ciphersuite_all
|
|
|
|
, onCertificatesRecv = \l -> do
|
|
|
|
modifyIORef ref (const $ Just l)
|
2011-05-14 08:12:30 +00:00
|
|
|
return CertificateUsageAccept
|
2011-04-10 20:34:28 +00:00
|
|
|
}
|
|
|
|
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
|