From 34775b4128de2801e4d127064f012501ca18d208 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?C=C3=A9dric=20Couralet?= <cedric.couralet@gmail.com>
Date: Mon, 13 Apr 2020 23:58:42 +0200
Subject: [PATCH] Add an option to disable certificate validation (#6156)
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
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 | 6 ++++++
pandoc.cabal | 1 +
src/Text/Pandoc/App.hs | 2 ++
src/Text/Pandoc/App/CommandLineOptions.hs | 5 +++++
src/Text/Pandoc/App/Opt.hs | 5 +++++
src/Text/Pandoc/Class/CommonState.hs | 3 +++
src/Text/Pandoc/Class/PandocIO.hs | 6 ++++--
src/Text/Pandoc/Class/PandocMonad.hs | 5 +++++
8 files changed, 31 insertions(+), 2 deletions(-)
diff --git a/MANUAL.txt b/MANUAL.txt
index 0568bbeb8..98f225cdd 100644
--- a/MANUAL.txt
+++ b/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`
diff --git a/pandoc.cabal b/pandoc.cabal
index be552eb87..163f77029 100644
--- a/pandoc.cabal
+++ b/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,
diff --git a/src/Text/Pandoc/App.hs b/src/Text/Pandoc/App.hs
index 899c35e23..aa75436a4 100644
--- a/src/Text/Pandoc/App.hs
+++ b/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
diff --git a/src/Text/Pandoc/App/CommandLineOptions.hs b/src/Text/Pandoc/App/CommandLineOptions.hs
index 164ef17d5..06ee73299 100644
--- a/src/Text/Pandoc/App/CommandLineOptions.hs
+++ b/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 })
diff --git a/src/Text/Pandoc/App/Opt.hs b/src/Text/Pandoc/App/Opt.hs
index d4b36bef3..fb2aeab22 100644
--- a/src/Text/Pandoc/App/Opt.hs
+++ b/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
}
diff --git a/src/Text/Pandoc/Class/CommonState.hs b/src/Text/Pandoc/Class/CommonState.hs
index 4a0f66859..7e1735c2b 100644
--- a/src/Text/Pandoc/Class/CommonState.hs
+++ b/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 = []
diff --git a/src/Text/Pandoc/Class/PandocIO.hs b/src/Text/Pandoc/Class/PandocIO.hs
index 1cbfd680e..ee6a041ba 100644
--- a/src/Text/Pandoc/Class/PandocIO.hs
+++ b/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))
diff --git a/src/Text/Pandoc/Class/PandocMonad.hs b/src/Text/Pandoc/Class/PandocMonad.hs
index 8229668e7..991aeed41 100644
--- a/src/Text/Pandoc/Class/PandocMonad.hs
+++ b/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}