Add an option to disable certificate validation (#6156)

This commit adds the option `--no-check-certificate`, which disables certificate
checking when resources are fetched by HTTP.

Co-authored-by: Cécile Chemin <cecile.chemin@insee.fr>
Co-authored-by: Juliette Fourcot <juliette.fourcot@insee.fr>

MANUAL.txt

@@ -903,6 +903,12 @@ header when requesting a document from a URL:
     downloaded). If you're behind a proxy, you also need to set
     the environment variable `http_proxy` to `http://...`.
 
+`--no-check-certificate
+
+:   Disable the certificate verification to allow access to 
+    unsecure HTTP resources (for example when the certificate
+    is no longer valid or self signed).
+
 ## Options affecting specific writers {.options}
 
 `--self-contained`

pandoc.cabal

@@ -426,6 +426,7 @@ library
                  doctemplates >= 0.8.2 && < 0.9,
                  network-uri >= 2.6 && < 2.7,
                  network >= 2.6,
+                 connection >= 0.3.1,
                  http-client >= 0.4.30 && < 0.7,
                  http-client-tls >= 0.2.4 && < 0.4,
                  http-types >= 0.8 && < 0.13,

src/Text/Pandoc/App.hs

@@ -270,6 +270,8 @@ convertWithOpts opts = do
 
     mapM_ (uncurry setRequestHeader) (optRequestHeaders opts)
 
+    setNoCheckCertificate (optNoCheckCertificate opts)
+
     doc <- sourceToDoc sources >>=
               (   (if isJust (optExtractMedia opts)
                       then fillMediaBag

src/Text/Pandoc/App/CommandLineOptions.hs

@@ -414,6 +414,11 @@ options =
                   "NAME:VALUE")
                  ""
 
+    , Option "" ["no-check-certificate"]
+                (NoArg
+                 (\opt -> return opt { optNoCheckCertificate = True }))
+                "" -- "Disable certificate validation"
+
     , Option "" ["abbreviations"]
                 (ReqArg
                  (\arg opt -> return opt { optAbbreviations = Just arg })

src/Text/Pandoc/App/Opt.hs

@@ -140,6 +140,7 @@ data Opt = Opt
     , optIncludeInHeader       :: [FilePath]       -- ^ Files to include in header
     , optResourcePath          :: [FilePath] -- ^ Path to search for images etc
     , optRequestHeaders        :: [(Text, Text)] -- ^ Headers for HTTP requests
+    , optNoCheckCertificate    :: Bool       -- ^ Disable certificate validation
     , optEol                   :: LineEnding -- ^ Style of line-endings to use
     , optStripComments         :: Bool       -- ^ Skip HTML comments
     } deriving (Generic, Show)
@@ -390,6 +391,9 @@ doOpt (k',v) = do
     "request-headers" ->
       parseYAML v >>= \x ->
              return (\o -> o{ optRequestHeaders = x })
+    "no-check-certificate" ->
+      parseYAML v >>= \x ->
+             return (\o -> o{ optNoCheckCertificate = x })
     "eol" ->
       parseYAML v >>= \x -> return (\o -> o{ optEol = x })
     "strip-comments" ->
@@ -466,6 +470,7 @@ defaultOpts = Opt
     , optIncludeInHeader       = []
     , optResourcePath          = ["."]
     , optRequestHeaders        = []
+    , optNoCheckCertificate    = False
     , optEol                   = Native
     , optStripComments         = False
     }

src/Text/Pandoc/Class/CommonState.hs

@@ -37,6 +37,8 @@ data CommonState = CommonState
     -- ^ Absolute URL + dir of 1st source file
   , stRequestHeaders :: [(Text, Text)]
     -- ^ Headers to add for HTTP requests
+  , stNoCheckCertificate :: Bool
+    -- ^ Controls whether certificate validation is disabled
   , stMediaBag     :: MediaBag
     -- ^ Media parsed from binary containers
   , stTranslations :: Maybe (Lang, Maybe Translations)
@@ -67,6 +69,7 @@ defaultCommonState = CommonState
   , stUserDataDir = Nothing
   , stSourceURL = Nothing
   , stRequestHeaders = []
+  , stNoCheckCertificate = False
   , stMediaBag = mempty
   , stTranslations = Nothing
   , stInputFiles = []

src/Text/Pandoc/Class/PandocIO.hs

@@ -54,7 +54,8 @@ import Network.HTTP.Client
        (httpLbs, responseBody, responseHeaders,
         Request(port, host, requestHeaders), parseRequest, newManager)
 import Network.HTTP.Client.Internal (addProxy)
-import Network.HTTP.Client.TLS (tlsManagerSettings)
+import Network.HTTP.Client.TLS (mkManagerSettings)
+import Network.Connection (TLSSettings (..))
 import Network.HTTP.Types.Header ( hContentType )
 import Network.Socket (withSocketsDo)
 import Network.URI ( unEscapeString )
@@ -139,6 +140,7 @@ instance PandocMonad PandocIO where
    | otherwise = do
        let toReqHeader (n, v) = (CI.mk (UTF8.fromText n), UTF8.fromText v)
        customHeaders <- map toReqHeader <$> getsCommonState stRequestHeaders
+       disableCertificateValidation <- getsCommonState stNoCheckCertificate
        report $ Fetching u
        res <- liftIO $ E.try $ withSocketsDo $ do
          let parseReq = parseRequest
@@ -149,7 +151,7 @@ instance PandocMonad PandocIO where
                                   return (addProxy (host r) (port r) x)
          req <- parseReq (T.unpack u) >>= addProxy'
          let req' = req{requestHeaders = customHeaders ++ requestHeaders req}
-         resp <- newManager tlsManagerSettings >>= httpLbs req'
+         resp <- newManager (mkManagerSettings  (TLSSettingsSimple disableCertificateValidation False False) Nothing) >>= httpLbs req'
          return (B.concat $ toChunks $ responseBody resp,
                  UTF8.toText `fmap` lookup hContentType (responseHeaders resp))
 

src/Text/Pandoc/Class/PandocMonad.hs

@@ -27,6 +27,7 @@ module Text.Pandoc.Class.PandocMonad
   , report
   , setTrace
   , setRequestHeader
+  , setNoCheckCertificate
   , getLog
   , setVerbosity
   , getVerbosity
@@ -189,6 +190,10 @@ setRequestHeader name val = modifyCommonState $ \st ->
   st{ stRequestHeaders =
        (name, val) : filter (\(n,_) -> n /= name) (stRequestHeaders st)  }
 
+-- | Determine whether certificate validation is disabled
+setNoCheckCertificate :: PandocMonad m => Bool -> m ()
+setNoCheckCertificate noCheckCertificate = modifyCommonState $ \st -> st{stNoCheckCertificate = noCheckCertificate}
+
 -- | Initialize the media bag.
 setMediaBag :: PandocMonad m => MediaBag -> m ()
 setMediaBag mb = modifyCommonState $ \st -> st{stMediaBag = mb}