From f0f75f0f2795348fe3268ed217c22f629c8c9df90904bc8d47f2d57a04c0cd1a Mon Sep 17 00:00:00 2001
From: Peter Simons <peter.simons@suse.com>
Date: Thu, 21 Sep 2023 10:05:51 +0000
Subject: [PATCH] osc copypac from project:devel:languages:haskell:ghc-9.4.x
 package:ghc-pandoc revision:27, using keep-link

OBS-URL: https://build.opensuse.org/package/show/devel:languages:haskell/ghc-pandoc?expand=0&rev=17
---
 CVE-2023-38745.patch | 68 ++++++++++++++++++++++++++++++++++++++++++++
 ghc-pandoc.changes   |  7 +++++
 ghc-pandoc.spec      |  1 +
 3 files changed, 76 insertions(+)
 create mode 100644 CVE-2023-38745.patch

diff --git a/CVE-2023-38745.patch b/CVE-2023-38745.patch
new file mode 100644
index 0000000..4645c48
--- /dev/null
+++ b/CVE-2023-38745.patch
@@ -0,0 +1,68 @@
+From eddedbfc14916aa06fc01ff04b38aeb30ae2e625 Mon Sep 17 00:00:00 2001
+From: John MacFarlane <jgm@berkeley.edu>
+Date: Thu, 20 Jul 2023 09:26:38 -0700
+Subject: [PATCH] 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
+'..'.)
+---
+ src/Text/Pandoc/Class/IO.hs |  2 ++
+ src/Text/Pandoc/MediaBag.hs |  7 ++++---
+ test/Tests/MediaBag.hs      | 12 +++++++++++-
+ 3 files changed, 17 insertions(+), 4 deletions(-)
+
+Index: pandoc-3.1.3/src/Text/Pandoc/Class/IO.hs
+===================================================================
+--- pandoc-3.1.3.orig/src/Text/Pandoc/Class/IO.hs	2023-09-21 09:24:23.311539088 +0000
++++ pandoc-3.1.3/src/Text/Pandoc/Class/IO.hs	2023-09-21 09:27:24.005959930 +0000
+@@ -224,6 +224,8 @@ writeMedia :: (PandocMonad m, MonadIO m)
+            -> 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 </> fp
+   liftIOError (createDirectoryIfMissing True) (takeDirectory fullpath)
+   logIOError $ BL.writeFile fullpath bs
+Index: pandoc-3.1.3/src/Text/Pandoc/MediaBag.hs
+===================================================================
+--- pandoc-3.1.3.orig/src/Text/Pandoc/MediaBag.hs	2023-09-21 09:24:23.311539088 +0000
++++ pandoc-3.1.3/src/Text/Pandoc/MediaBag.hs	2023-09-21 09:27:24.006959920 +0000
+@@ -89,16 +89,17 @@ insertMedia fp mbMime contents (MediaBag
+                        && Windows.isRelative fp''
+                        && isNothing uri
+                        && not (".." `T.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
diff --git a/ghc-pandoc.changes b/ghc-pandoc.changes
index ac77616..8046422 100644
--- a/ghc-pandoc.changes
+++ b/ghc-pandoc.changes
@@ -1,3 +1,10 @@
+-------------------------------------------------------------------
+Thu Sep 21 09:22:22 UTC 2023 - Peter Simons <psimons@suse.com>
+
+- Apply "CVE-2023-38745.patch" to complete the fix of the arbitrary
+  file write issue discovered earlier. The previous patch did not
+  cover all attack vectors. [bsc#1213622, CVE-2023-38745]
+
 -------------------------------------------------------------------
 Fri Jul 14 18:45:26 UTC 2023 - Peter Simons <psimons@suse.com>
 
diff --git a/ghc-pandoc.spec b/ghc-pandoc.spec
index a9ad27d..44d6eef 100644
--- a/ghc-pandoc.spec
+++ b/ghc-pandoc.spec
@@ -27,6 +27,7 @@ License:        GPL-2.0-or-later
 URL:            https://hackage.haskell.org/package/%{pkg_name}
 Source0:        https://hackage.haskell.org/package/%{pkg_name}-%{version}/%{pkg_name}-%{version}.tar.gz
 Patch1:         CVE-2023-35936.patch
+Patch2:         CVE-2023-38745.patch
 BuildRequires:  ghc-Cabal-devel
 BuildRequires:  ghc-Glob-devel
 BuildRequires:  ghc-Glob-prof