yogsototh/hs-tls
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

add some option to do certificate verification when retriving a certificate.

Browse source
This commit is contained in:
Vincent Hanquez 2011-11-23 21:49:33 +00:00
parent 3117e468b0
commit f927d408ab
1 changed files with 18 additions and 1 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

19
Examples/RetrieveCertificate.hs
View file

@ -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)