CVE-2023-38745: Insufficient Information (NVD-CWE-noinfo)
value: Pandoc before 3.1.6 allows arbitrary file write: this can be triggered by providing a crafted image element in the input when generating files via the --extract-media option or outputting to PDF format. This allows an attacker to create or overwrite arbitrary files, depending on the privileges of the process running Pandoc. It only affects systems that pass untrusted user input to Pandoc and allow Pandoc to be used to produce a PDF or with the --extract-media option. NOTE: this issue exists because of an incomplete fix for CVE-2023-35936 (failure to properly account for double encoded path names).
CWE description: There is insufficient information about the issue to classify it; details are unkown or unspecified.
CVSS v3 base score: 6.3
Published: 2023-07-25T04:15Z
Repository: https://github.com/jgm/pandoc
Language: Other
Files changed: src/Text/Pandoc/Class/IO.hs, src/Text/Pandoc/MediaBag.hs, test/Tests/MediaBag.hs
Commit date: 2023-07-20 11:51:28 -0700
Commit message: Fix new variant of the vulnerability in CVE-2023-35936.

Guilhem Moulin noticed that the fix to CVE-2023-35936 was incomplete.
An attacker could get around it by double-encoding the malicious
extension to create or override arbitrary files.

    $ echo '![](data://image/png;base64,cHJpbnQgImhlbGxvIgo=;.lua+%252f%252e%252e%252f%252e%252e%252fb%252elua)' >b.md
    $ .cabal/bin/pandoc b.md --extract-media=bar
    <p><img
    src="bar/2a0eaa89f43fada3e6c577beea4f2f8f53ab6a1d.lua+%2f%2e%2e%2f%2e%2e%2fb%2elua" /></p>
    $ cat b.lua
    print "hello"
    $ find bar
    bar/
    bar/2a0eaa89f43fada3e6c577beea4f2f8f53ab6a1d.lua+

This commit adds a test case for this more complex attack and fixes
the vulnerability.  (The fix is quite simple: if the URL-unescaped
filename or extension contains a '%', we just use the sha1 hash of the
contents as the canonical name, just as we do if the filename contains
'..'.)

Diff: diff --git a/src/Text/Pandoc/Class/IO.hs b/src/Text/Pandoc/Class/IO.hs
index 86ed83c89..2ae3b5cee 100644
--- a/src/Text/Pandoc/Class/IO.hs
+++ b/src/Text/Pandoc/Class/IO.hs
@@ -222,10 +222,12 @@ writeMedia :: (PandocMonad m, MonadIO m)
            => FilePath
            -> (FilePath, MimeType, BL.ByteString)
            -> m ()
 writeMedia dir (fp, _mt, bs) = do
   -- we normalize to get proper path separators for the platform
+  -- we unescape URI encoding, but given how insertMedia
+  -- is written, we shouldn't have any % in a canonical media name...
   let fullpath = normalise $ dir </> unEscapeString fp
   liftIOError (createDirectoryIfMissing True) (takeDirectory fullpath)
   report $ Extracting (T.pack fullpath)
   logIOError $ BL.writeFile fullpath bs
 
diff --git a/src/Text/Pandoc/MediaBag.hs b/src/Text/Pandoc/MediaBag.hs
index bb75f4591..18a40a6dc 100644
--- a/src/Text/Pandoc/MediaBag.hs
+++ b/src/Text/Pandoc/MediaBag.hs
@@ -88,20 +88,21 @@ insertMedia fp mbMime contents (MediaBag mediamap) =
         uri = parseURI fp
         newpath = if Posix.isRelative fp''
                        && Windows.isRelative fp''
                        && isNothing uri
                        && not (".." `isInfixOf` fp'')
+                       && '%' `notElem` fp''
                      then fp''
-                     else showDigest (sha1 contents) <> "." <> ext
+                     else showDigest (sha1 contents) <> ext
         fallback = case takeExtension fp'' of
                         ".gz" -> getMimeTypeDef $ dropExtension fp''
                         _     -> getMimeTypeDef fp''
         mt = fromMaybe fallback mbMime
         path = maybe fp'' (unEscapeString . uriPath) uri
         ext = case takeExtension path of
-                '.':e -> e
-                _ -> maybe "" T.unpack $ extensionFromMimeType mt
+                '.':e | '%' `notElem` e -> '.':e
+                _ -> maybe "" (\x -> '.':T.unpack x) $ extensionFromMimeType mt
 
 -- | Lookup a media item in a 'MediaBag', returning mime type and contents.
 lookupMedia :: FilePath
             -> MediaBag
             -> Maybe MediaItem
diff --git a/test/Tests/MediaBag.hs b/test/Tests/MediaBag.hs
index 65b6716d9..4cb4ab807 100644
--- a/test/Tests/MediaBag.hs
+++ b/test/Tests/MediaBag.hs
@@ -18,11 +18,11 @@ tests = [
       withTempDirectory "." "extractMediaTest" $ \tmpdir -> inDirectory tmpdir $ do
         copyFile "../../test/lalune.jpg" "moon.jpg"
         let d = B.doc $
                   B.para (B.image "../../test/lalune.jpg" "" mempty) <>
                   B.para (B.image "moon.jpg" "" mempty) <>
-                  B.para (B.image "data://image/png;base64,cHJpbnQgImhlbGxvIgo=;.lua+%2f%2e%2e%2f%2e%2e%2fa%2elua" "" mempty) <>
+                  B.para (B.image "data:image/png;base64,cHJpbnQgImhlbGxvIgo=;.lua+%2f%2e%2e%2f%2e%2e%2fa%2elua" "" mempty) <>
                   B.para (B.image "data:image/gif;base64,R0lGODlhAQABAIAAAAAAAP///yH5BAEAAAAALAAAAAABAAEAAAIBRAA7" "" mempty)
         runIOorExplode $ do
           fillMediaBag d
           extractMedia "foo" d
         exists1 <- doesFileExist ("foo" </> "moon.jpg")
@@ -33,6 +33,16 @@ tests = [
         exists4 <- doesFileExist "a.lua"
         assertBool "data uri with malicious payload gets written outside of destination dir"
           (exists3 && not exists4)
         exists5 <- doesFileExist ("foo" </> "d5fceb6532643d0d84ffe09c40c481ecdf59e15a.gif")
         assertBool "data uri with gif is not properly decoded" exists5
+        -- double-encoded version:
+        let e = B.doc $
+                  B.para (B.image "data:image/png;base64,cHJpbnQgInB3bmVkIgo=;.lua+%252f%252e%252e%252f%252e%252e%252fb%252elua" "" mempty)
+        runIOorExplode $ do
+          fillMediaBag e
+          extractMedia "bar" e
+        exists6 <- doesFileExist ("bar" </> "772ceca21a2751863ec46cb23db0e7fc35b9cff8.png")
+        exists7 <- doesFileExist "b.lua"
+        assertBool "data uri with double-encoded malicious payload gets written outside of destination dir"
+          (exists6 && not exists7)
   ]

Vulnerable code:                      else showDigest (sha1 contents) <> "." <> ext
                '.':e -> e
                _ -> maybe "" T.unpack $ extensionFromMimeType mt
                  B.para (B.image "data://image/png;base64,cHJpbnQgImhlbGxvIgo=;.lua+%2f%2e%2e%2f%2e%2e%2fa%2elua" "" mempty) <>
Fixed code:   -- we unescape URI encoding, but given how insertMedia
  -- is written, we shouldn't have any % in a canonical media name...
                       && '%' `notElem` fp''
                     else showDigest (sha1 contents) <> ext
                '.':e | '%' `notElem` e -> '.':e
                _ -> maybe "" (\x -> '.':T.unpack x) $ extensionFromMimeType mt
                  B.para (B.image "data:image/png;base64,cHJpbnQgImhlbGxvIgo=;.lua+%2f%2e%2e%2f%2e%2e%2fa%2elua" "" mempty) <>
        -- double-encoded version:
        let e = B.doc $
                  B.para (B.image "data:image/png;base64,cHJpbnQgInB3bmVkIgo=;.lua+%252f%252e%252e%252f%252e%252e%252fb%252elua" "" mempty)
        runIOorExplode $ do
          fillMediaBag e
          extractMedia "bar" e
        exists6 <- doesFileExist ("bar" </> "772ceca21a2751863ec46cb23db0e7fc35b9cff8.png")
        exists7 <- doesFileExist "b.lua"
        assertBool "data uri with double-encoded malicious payload gets written outside of destination dir"
          (exists6 && not exists7)