From 34775b4128de2801e4d127064f012501ca18d208 Mon Sep 17 00:00:00 2001 From: Cédric Couralet Date: Mon, 13 Apr 2020 23:58:42 +0200 Subject: 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 Co-authored-by: Juliette Fourcot --- 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 +++++ 6 files changed, 24 insertions(+), 2 deletions(-) (limited to 'src/Text') 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} -- cgit v1.2.3