From bf52badec67c77c8a475f22fa7ad6d0741b75828 Mon Sep 17 00:00:00 2001 From: John MacFarlane Date: Thu, 10 Sep 2026 01:56:39 +0000 Subject: [PATCH] Text.Pandoc.MediaBag: prevent mediaPath collisions between keys. The friendly mediaPath was derived by percent-unescaping the key, so distinct keys like "a%20b.png" and "a b.png" produced the same mediaPath ("a b.png") and silently clobbered each other on extraction (and inside docx/epub archives). Now the original name is only kept if the key contains no percent sign, so mediaPath equals the key and distinct keys yield distinct paths; anything percent-encoded gets a content-hash name. Hashed names can only coincide for identical contents, which is harmless. Co-Authored-By: Claude --- src/Text/Pandoc/MediaBag.hs | 6 +++++- test/Tests/MediaBag.hs | 10 ++++++++++ 2 files changed, 15 insertions(+), 1 deletion(-) diff --git a/src/Text/Pandoc/MediaBag.hs b/src/Text/Pandoc/MediaBag.hs index b2fcd0f01..3d7d8f520 100644 --- a/src/Text/Pandoc/MediaBag.hs +++ b/src/Text/Pandoc/MediaBag.hs @@ -106,11 +106,15 @@ insertMedia fp mbMime contents (MediaBag mediamap) fp'' = unEscapeString $ T.unpack fp' uri = parseURI fp hashpath = show (hashlazy contents :: Digest SHA1) <> ext + -- We only keep the original name if the key contains no + -- percent-encoding, i.e., unescaping is the identity; otherwise + -- distinct keys (e.g. "a%20b.png" and "a b.png") could unescape + -- to the same mediaPath and clobber each other on extraction. newpath = if Posix.isRelative fp'' && Windows.isRelative fp'' && isNothing uri && not containsParentRef - && '%' `notElem` fp'' + && not (T.any (== '%') fp') then fp'' else hashpath -- Check for a ".." path component (treating both / and \ as diff --git a/test/Tests/MediaBag.hs b/test/Tests/MediaBag.hs index be8834f6f..cb38bc7ff 100644 --- a/test/Tests/MediaBag.hs +++ b/test/Tests/MediaBag.hs @@ -33,6 +33,16 @@ tests = [ (mediaPath <$> lookupMedia "sub/lalune.png" bag) @?= Just "sub/lalune.png" (mediaPath <$> lookupMedia "img/../sub/lalune.png" bag) @?= Just "sub/lalune.png", + testCase "no mediaPath collisions between escaped and literal keys" $ do + -- "a%20b.png" used to unescape to the same mediaPath as the + -- literal "a b.png", so one clobbered the other on extraction: + let bag = insertMedia "a%20b.png" Nothing "contents1" $ + insertMedia "a b.png" Nothing "contents2" mempty + case (lookupMedia "a%20b.png" bag, lookupMedia "a b.png" bag) of + (Just i1, Just i2) -> assertBool + "escaped and literal keys share a mediaPath" + (mediaPath i1 /= mediaPath i2) + _ -> assertFailure "items not found in media bag", testCase "test fillMediaBag & extractMedia" $ withTempDirectory "." "extractMediaTest" $ \tmpdir -> do -- Use absolute paths so the test does not need to change