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.IORef
|
||||
import Data.Time.Clock
|
||||
|
||||
import System.IO
|
||||
import Control.Monad
|
||||
|
@ -38,6 +39,8 @@ data PArgs = PArgs
|
|||
, port :: String
|
||||
, chain :: Bool
|
||||
, output :: String
|
||||
, verify :: Bool
|
||||
, verifyFQDN :: String
|
||||
} deriving (Show, Data, Typeable)
|
||||
|
||||
progArgs = PArgs
|
||||
|
@ -45,6 +48,8 @@ progArgs = PArgs
|
|||
, 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"
|
||||
, 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"
|
||||
&= details
|
||||
[ "Retrieve the remote certificate and optionally its chain from a remote destination"
|
||||
|
@ -61,7 +66,19 @@ main = do
|
|||
case (chain a) of
|
||||
True ->
|
||||
forM_ (zip [0..] certs) $ \(n, cert) -> do
|
||||
putStrLn ("###### Certificate " ++ show (n + 1) ++ " ######")
|
||||
putStrLn ("###### Certificate " ++ show (n + 1 :: Int) ++ " ######")
|
||||
showCert (output a) cert
|
||||
False ->
|
||||
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