add some option to do certificate verification when retriving a certificate.
This commit is contained in:
parent
3117e468b0
commit
f927d408ab
1 changed files with 18 additions and 1 deletions
|
@ -5,6 +5,7 @@ import Network.TLS.Extra
|
||||||
|
|
||||||
import Data.Char
|
import Data.Char
|
||||||
import Data.IORef
|
import Data.IORef
|
||||||
|
import Data.Time.Clock
|
||||||
|
|
||||||
import System.IO
|
import System.IO
|
||||||
import Control.Monad
|
import Control.Monad
|
||||||
|
@ -38,6 +39,8 @@ data PArgs = PArgs
|
||||||
, port :: String
|
, port :: String
|
||||||
, chain :: Bool
|
, chain :: Bool
|
||||||
, output :: String
|
, output :: String
|
||||||
|
, verify :: Bool
|
||||||
|
, verifyFQDN :: String
|
||||||
} deriving (Show, Data, Typeable)
|
} deriving (Show, Data, Typeable)
|
||||||
|
|
||||||
progArgs = PArgs
|
progArgs = PArgs
|
||||||
|
@ -45,6 +48,8 @@ progArgs = PArgs
|
||||||
, port = "443" &= help "destination port to connect to" &= typ "port"
|
, port = "443" &= help "destination port to connect to" &= typ "port"
|
||||||
, chain = False &= help "also output the chain of certificate used"
|
, chain = False &= help "also output the chain of certificate used"
|
||||||
, output = "pem" &= help "define the format of output (PEM by default)" &= typ "format"
|
, output = "pem" &= help "define the format of output (PEM by default)" &= typ "format"
|
||||||
|
, verify = False &= help "verify the chain received with the trusted system certificates"
|
||||||
|
, verifyFQDN = "" &= help "verify the chain against a specific fully qualified domain name (e.g. web.example.com)" &= explicit &= name "verify-domain-name"
|
||||||
} &= summary "RetrieveCertificate remotely for SSL/TLS protocol"
|
} &= summary "RetrieveCertificate remotely for SSL/TLS protocol"
|
||||||
&= details
|
&= details
|
||||||
[ "Retrieve the remote certificate and optionally its chain from a remote destination"
|
[ "Retrieve the remote certificate and optionally its chain from a remote destination"
|
||||||
|
@ -61,7 +66,19 @@ main = do
|
||||||
case (chain a) of
|
case (chain a) of
|
||||||
True ->
|
True ->
|
||||||
forM_ (zip [0..] certs) $ \(n, cert) -> do
|
forM_ (zip [0..] certs) $ \(n, cert) -> do
|
||||||
putStrLn ("###### Certificate " ++ show (n + 1) ++ " ######")
|
putStrLn ("###### Certificate " ++ show (n + 1 :: Int) ++ " ######")
|
||||||
showCert (output a) cert
|
showCert (output a) cert
|
||||||
False ->
|
False ->
|
||||||
showCert (output a) $ head certs
|
showCert (output a) $ head certs
|
||||||
|
|
||||||
|
when (verify a) $ do
|
||||||
|
putStrLn "### certificate chain trust"
|
||||||
|
ctime <- utctDay `fmap` getCurrentTime
|
||||||
|
certificateVerifyChain certs >>= showUsage "chain validity"
|
||||||
|
showUsage "time validity" (certificateVerifyValidity ctime certs)
|
||||||
|
when (verifyFQDN a /= "") $
|
||||||
|
showUsage "fqdn match" (certificateVerifyDomain (verifyFQDN a) certs)
|
||||||
|
where
|
||||||
|
showUsage :: String -> TLSCertificateUsage -> IO ()
|
||||||
|
showUsage s CertificateUsageAccept = printf "%s : accepted\n" s
|
||||||
|
showUsage s (CertificateUsageReject r) = printf "%s : rejected: %s\n" s (show r)
|
||||||
|
|
Loading…
Reference in a new issue