checkcert.hs

{-# LANGUAGE OverloadedStrings #-}

import Prelude hiding (putStrLn, writeFile)
import System.Environment (getArgs)
import Data.Word (Word16)
import Data.Maybe (fromMaybe)
import Data.Monoid ((<>), mempty)
import Data.ByteString (ByteString, writeFile)
import Data.ByteString.Char8 (putStrLn)
import Text.Regex.TDFA (match, makeRegexOpts, blankCompOpt)
import Text.Regex.TDFA.Common
import Data.Conduit.Shell (run, proc, conduit, ($|), Segment)
import Conduit (foldC)

type Port = Word16

emptyInput = conduit mempty

tlsConnect :: String -> Maybe Port -> Segment ()
tlsConnect hostname mPort = proc "openssl" ["s_client", "-showcerts", "-connect", host]
  where
    host = hostname <> ":" <> (show $ fromMaybe 443 mPort)

dumpCerts host port = emptyInput $| tlsConnect host port $| conduit foldC

extractCert :: ByteString -> ByteString
extractCert dump = cert
  where
    regex = makeRegexOpts blankCompOpt (ExecOption{captureGroups=False}) ("-----BEGIN CERTIFICATE-----[^-]*-----END CERTIFICATE-----" :: ByteString)
    (_, cert, _) = (match regex dump :: (ByteString, ByteString, ByteString))

verifyCert root cert = proc "openssl" ["verify", "-CAfile", root, cert]

main = do root:[host] <- getArgs
          cert <- fmap extractCert $ run $ dumpCerts host Nothing
          writeFile "/tmp/tempdownloadedcert" cert
          run $ verifyCert root "/tmp/tempdownloadedcert"