3776e82 · typeable/pandoc

git.iko.soy/typeable/pandoc

Fix MediaBag regressions.

With the 2.14 release `--extract-media` stopped working as before; there could be mismatches between the paths in the rendered document and the extracted media. This patch makes several changes (while keeping the same API). The `mediaPath` in 2.14 was always constructed from the SHA1 hash of the media contents. Now, we preserve the original path unless it's an absolute path or contains `..` segments (in that case we use a path based on the SHA1 hash of the contents). When constructing a path from the SHA1 hash, we always use the original extension, if there is one. Otherwise we look up an appropriate extension for the mime type. `mediaDirectory` and `mediaItems` now use the `mediaPath`, rather than the mediabag key, for the first component of the tuple. This makes more sense, I think, and fits with the documentation of these functions; eventually, though, we should rework the API so that `mediaItems` returns both the keys and the MediaItems. Rewriting of source paths in `extractMedia` has been fixed. `fillMediaBag` has been modified so that it doesn't modify image paths (that was part of the problem in #7345). We now do path normalization (e.g. `\` separators on Windows) only in writing the media; the paths are left unchanged in the image links (sensibly, since they might be URLs and not file paths). These changes should restore the original behavior from before 2.14. Closes #7345.

commit3776e828a83048697e5c64d9fb4bedc0145197dc authorJohn MacFarlane <jgm@berkeley.edu> dateThu 10 Jun 2021, 16:47 (5 years ago) parentaa79b30

4 files changed+47−48

compare with master

unifiedsplit

MANUAL.txt+6−6 src/Text/Pandoc/Class/IO.hs+21−20 src/Text/Pandoc/Class/PandocMonad.hs+6−11 src/Text/Pandoc/MediaBag.hs+14−11

MANUAL.txt+6−6

@@ -675,12 +675,12 @@ header when requesting a document from a URL:

675675: Extract images and other media contained in or linked from

676676 the source document to the path *DIR*, creating it if

677677 necessary, and adjust the images references in the document

678− so they point to the extracted files. If the source format is

679− a binary container (docx, epub, or odt), the media is

680− extracted from the container and the original

681− filenames are used. Otherwise the media is read from the

682− file system or downloaded, and new filenames are constructed

683− based on SHA1 hashes of the contents.

678+ so they point to the extracted files. Media are downloaded,

679+ read from the file system, or extracted from a binary

680+ container (e.g. docx), as needed. The original file paths

681+ are used if they are relative paths not containing `..`.

682+ Otherwise filenames are constructed from the SHA1 hash of

683+ the contents.

684684

685685`--abbreviations=`*FILE*

686686

src/Text/Pandoc/Class/IO.hs+21−20

@@ -62,7 +62,7 @@ import Text.Pandoc.Definition (Pandoc, Inline (Image))

6262import Text.Pandoc.Error (PandocError (..))

6363import Text.Pandoc.Logging (LogMessage (..), messageVerbosity, showLogMessage)

6464import Text.Pandoc.MIME (MimeType)

65−import Text.Pandoc.MediaBag (MediaBag, MediaItem(..), lookupMedia, mediaDirectory)

65+import Text.Pandoc.MediaBag (MediaBag, MediaItem(..), lookupMedia, mediaItems)

6666import Text.Pandoc.Walk (walk)

6767import qualified Control.Exception as E

6868import qualified Data.ByteString as B

@@ -200,31 +200,32 @@ alertIndent (l:ls) = do

200200extractMedia :: (PandocMonad m, MonadIO m) => FilePath -> Pandoc -> m Pandoc

201201extractMedia dir d = do

202202 media <- getMediaBag

203− case [fp | (fp, _, _) <- mediaDirectory media] of

204− [] -> return d

205− fps -> do

206− mapM_ (writeMedia dir media) fps

207− return $ walk (adjustImagePath dir fps) d

203+ let items = mediaItems media

204+ if null items

205+ then return d

206+ else do

207+ mapM_ (writeMedia dir) items

208+ return $ walk (adjustImagePath dir media) d

208209

209210-- | Write the contents of a media bag to a path.

210211writeMedia :: (PandocMonad m, MonadIO m)

211− => FilePath -> MediaBag -> FilePath

212+ => FilePath

213+ -> (FilePath, MimeType, BL.ByteString)

212214 -> m ()

213−writeMedia dir mediabag subpath = do

214− let mbcontents = lookupMedia subpath mediabag

215− case mbcontents of

216− Nothing -> throwError $ PandocResourceNotFound $ pack subpath

217− Just item -> do

218− -- we normalize to get proper path separators for the platform

219− let fullpath = dir </> normalise (mediaPath item)

220− liftIOError (createDirectoryIfMissing True) (takeDirectory fullpath)

221− logIOError $ BL.writeFile fullpath $ mediaContents item

215+writeMedia dir (fp, _mt, bs) = do

216+ -- we normalize to get proper path separators for the platform

217+ let fullpath = normalise $ dir </> fp

218+ liftIOError (createDirectoryIfMissing True) (takeDirectory fullpath)

219+ logIOError $ BL.writeFile fullpath bs

222220

223221-- | If the given Inline element is an image with a @src@ path equal to

224222-- one in the list of @paths@, then prepends @dir@ to the image source;

225223-- returns the element unchanged otherwise.

226−adjustImagePath :: FilePath -> [FilePath] -> Inline -> Inline

227−adjustImagePath dir paths (Image attr lab (src, tit))

228− | unpack src `elem` paths

229− = Image attr lab (pack (normalise $ dir </> unpack src), tit)

224+adjustImagePath :: FilePath -> MediaBag -> Inline -> Inline

225+adjustImagePath dir mediabag (Image attr lab (src, tit)) =

226+ case lookupMedia (T.unpack src) mediabag of

227+ Nothing -> Image attr lab (src, tit)

228+ Just item ->

229+ let fullpath = dir </> mediaPath item

230+ in Image attr lab (T.pack fullpath, tit)

230231adjustImagePath _ _ x = x

src/Text/Pandoc/Class/PandocMonad.hs+6−11

@@ -638,17 +638,12 @@ fillMediaBag d = walkM handleImage d

638638 handleImage (Image attr lab (src, tit)) = catchError

639639 (do mediabag <- getMediaBag

640640 let fp = T.unpack src

641− src' <- T.pack <$> case lookupMedia fp mediabag of

642− Just item -> return $ mediaPath item

643− Nothing -> do

644− (bs, mt) <- fetchItem src

645− insertMedia fp mt (BL.fromStrict bs)

646− mediabag' <- getMediaBag

647− case lookupMedia fp mediabag' of

648− Just item -> return $ mediaPath item

649− Nothing -> throwError $ PandocSomeError $

650− src <> " not successfully inserted into MediaBag"

651− return $ Image attr lab (src', tit))

641+ case lookupMedia fp mediabag of

642+ Just _ -> return ()

643+ Nothing -> do

644+ (bs, mt) <- fetchItem src

645+ insertMedia fp mt (BL.fromStrict bs)

646+ return $ Image attr lab (src, tit))

652647 (\e ->

653648 case e of

654649 PandocResourceNotFound _ -> do

src/Text/Pandoc/MediaBag.hs+14−11

@@ -71,16 +71,21 @@ insertMedia :: FilePath -- ^ relative path and canonical name of resource

7171 -> MediaBag

7272 -> MediaBag

7373insertMedia fp mbMime contents (MediaBag mediamap) =

74− MediaBag (M.insert (canonicalize fp) mediaItem mediamap)

75− where mediaItem = MediaItem{ mediaPath = showDigest (sha1 contents) <>

76− "." <> ext

74+ MediaBag (M.insert fp' mediaItem mediamap)

75+ where mediaItem = MediaItem{ mediaPath = newpath

7776 , mediaContents = contents

7877 , mediaMimeType = mt }

78+ fp' = canonicalize fp

79+ newpath = if isRelative fp && ".." `notElem` splitPath fp

80+ then T.unpack fp'

81+ else showDigest (sha1 contents) <> "." <> ext

7982 fallback = case takeExtension fp of

8083 ".gz" -> getMimeTypeDef $ dropExtension fp

8184 _ -> getMimeTypeDef fp

8285 mt = fromMaybe fallback mbMime

83− ext = maybe (takeExtension fp) T.unpack $ extensionFromMimeType mt

86+ ext = case takeExtension fp of

87+ '.':e -> e

88+ _ -> maybe "" T.unpack $ extensionFromMimeType mt

8489

8590

8691-- | Lookup a media item in a 'MediaBag', returning mime type and contents.

@@ -92,13 +97,11 @@ lookupMedia fp (MediaBag mediamap) = M.lookup (canonicalize fp) mediamap

9297-- | Get a list of the file paths stored in a 'MediaBag', with

9398-- their corresponding mime types and the lengths in bytes of the contents.

9499mediaDirectory :: MediaBag -> [(FilePath, MimeType, Int)]

95−mediaDirectory (MediaBag mediamap) =

96− M.foldrWithKey (\fp item ->

97− ((T.unpack fp, mediaMimeType item,

98− fromIntegral (BL.length (mediaContents item))):)) [] mediamap

100+mediaDirectory mediabag =

101+ map (\(fp, mt, bs) -> (fp, mt, fromIntegral (BL.length bs)))

102+ (mediaItems mediabag)

99103

100104mediaItems :: MediaBag -> [(FilePath, MimeType, BL.ByteString)]

101105mediaItems (MediaBag mediamap) =

102− M.foldrWithKey (\fp item ->

103− ((T.unpack fp, mediaMimeType item, mediaContents item):))

104− [] mediamap

106+ map (\item -> (mediaPath item, mediaMimeType item, mediaContents item))

107+ (M.elems mediamap)