aboutsummaryrefslogtreecommitdiff
path: root/src/Text/Pandoc
diff options
context:
space:
mode:
authorFrancesco Occhipinti <focchi.pinti@gmail.com>2018-05-04 19:31:02 +0200
committerJohn MacFarlane <jgm@berkeley.edu>2018-05-04 10:31:02 -0700
commit59f0c1d83bb573341f8ca0bf796ae41c82afd044 (patch)
treedb3f12a0c722dee2beebb640b6eb84486b644039 /src/Text/Pandoc
parent8cd3f19dc54124ec033069bc2f7018dc34866745 (diff)
downloadpandoc-59f0c1d83bb573341f8ca0bf796ae41c82afd044.tar.gz
catch IO errors when writing media files, closes #4559 (#4619)
If we do not catch these errors, any malformed entry in a media bag could cause the loss of a whole document output. An example of malformed entry is an entry with an empty file path.
Diffstat (limited to 'src/Text/Pandoc')
-rw-r--r--src/Text/Pandoc/Class.hs10
-rw-r--r--src/Text/Pandoc/Logging.hs6
2 files changed, 15 insertions, 1 deletions
diff --git a/src/Text/Pandoc/Class.hs b/src/Text/Pandoc/Class.hs
index 3529054e6..911ba98b5 100644
--- a/src/Text/Pandoc/Class.hs
+++ b/src/Text/Pandoc/Class.hs
@@ -477,6 +477,14 @@ liftIOError f u = do
Left e -> throwError $ PandocIOError u e
Right r -> return r
+-- | Show potential IO errors to the user continuing execution anyway
+logIOError :: IO () -> PandocIO ()
+logIOError f = do
+ res <- liftIO $ tryIOError f
+ case res of
+ Left e -> report $ IgnoredIOError (E.displayException e)
+ Right _ -> pure ()
+
instance PandocMonad PandocIO where
lookupEnv = liftIO . IO.lookupEnv
getCurrentTime = liftIO IO.getCurrentTime
@@ -862,7 +870,7 @@ writeMedia dir mediabag subpath = do
Just (_, bs) -> do
report $ Extracting fullpath
liftIOError (createDirectoryIfMissing True) (takeDirectory fullpath)
- liftIOError (\p -> BL.writeFile p bs) fullpath
+ logIOError $ BL.writeFile fullpath bs
adjustImagePath :: FilePath -> [FilePath] -> Inline -> Inline
adjustImagePath dir paths (Image attr lab (src, tit))
diff --git a/src/Text/Pandoc/Logging.hs b/src/Text/Pandoc/Logging.hs
index e6f4fe956..4b025821c 100644
--- a/src/Text/Pandoc/Logging.hs
+++ b/src/Text/Pandoc/Logging.hs
@@ -85,6 +85,7 @@ data LogMessage =
| InlineNotRendered Inline
| BlockNotRendered Block
| DocxParserWarning String
+ | IgnoredIOError String
| CouldNotFetchResource String String
| CouldNotDetermineImageSize String String
| CouldNotConvertImage String String
@@ -175,6 +176,8 @@ instance ToJSON LogMessage where
["contents" .= toJSON bl]
DocxParserWarning s ->
["contents" .= Text.pack s]
+ IgnoredIOError s ->
+ ["contents" .= Text.pack s]
CouldNotFetchResource fp s ->
["path" .= Text.pack fp,
"message" .= Text.pack s]
@@ -265,6 +268,8 @@ showLogMessage msg =
"Not rendering " ++ show bl
DocxParserWarning s ->
"Docx parser warning: " ++ s
+ IgnoredIOError s ->
+ "IO Error (ignored): " ++ s
CouldNotFetchResource fp s ->
"Could not fetch resource '" ++ fp ++ "'" ++
if null s then "" else ": " ++ s
@@ -332,6 +337,7 @@ messageVerbosity msg =
InlineNotRendered{} -> INFO
BlockNotRendered{} -> INFO
DocxParserWarning{} -> INFO
+ IgnoredIOError{} -> WARNING
CouldNotFetchResource{} -> WARNING
CouldNotDetermineImageSize{} -> WARNING
CouldNotConvertImage{} -> WARNING