1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
|
From 5e381e3878b5da87ee7542f7e51c3c1a7fd84b89 Mon Sep 17 00:00:00 2001
From: John MacFarlane <jgm@berkeley.edu>
Date: Tue, 20 Jun 2023 13:50:13 -0700
Subject: [PATCH] Fix a security vulnerability in MediaBag and
T.P.Class.IO.writeMedia.
This vulnerability, discovered by Entroy C, allows users to write
arbitrary files to any location by feeding pandoc a specially crafted
URL in an image element. The vulnerability is serious for anyone
using pandoc to process untrusted input. The vulnerability does
not affect pandoc when run with the `--sandbox` flag.
---
src/Text/Pandoc/Class/IO.hs | 14 +++++++-------
src/Text/Pandoc/MediaBag.hs | 28 ++++++++++++++++------------
2 files changed, 23 insertions(+), 19 deletions(-)
Index: pandoc-3.1.3/src/Text/Pandoc/Class/IO.hs
===================================================================
--- pandoc-3.1.3.orig/src/Text/Pandoc/Class/IO.hs 2001-09-09 01:46:40.000000000 +0000
+++ pandoc-3.1.3/src/Text/Pandoc/Class/IO.hs 2023-07-14 18:39:12.169005026 +0000
@@ -50,7 +50,7 @@ import Network.HTTP.Client.Internal (add
import Network.HTTP.Client.TLS (mkManagerSettings)
import Network.HTTP.Types.Header ( hContentType )
import Network.Socket (withSocketsDo)
-import Network.URI (unEscapeString)
+import Network.URI (URI(..), parseURI)
import System.Directory (createDirectoryIfMissing)
import System.Environment (getEnv)
import System.FilePath ((</>), takeDirectory, normalise)
@@ -122,11 +122,11 @@ newUniqueHash = hashUnique <$> liftIO Da
openURL :: (PandocMonad m, MonadIO m) => Text -> m (B.ByteString, Maybe MimeType)
openURL u
- | Just u'' <- T.stripPrefix "data:" u = do
- let mime = T.takeWhile (/=',') u''
- let contents = UTF8.fromString $
- unEscapeString $ T.unpack $ T.drop 1 $ T.dropWhile (/=',') u''
- return (decodeBase64Lenient contents, Just mime)
+ | Just (URI{ uriScheme = "data:",
+ uriPath = upath }) <- parseURI (T.unpack u) = do
+ let (mime, rest) = break (== '.') upath
+ let contents = UTF8.fromString $ drop 1 rest
+ return (decodeBase64Lenient contents, Just (T.pack mime))
| otherwise = do
let toReqHeader (n, v) = (CI.mk (UTF8.fromText n), UTF8.fromText v)
customHeaders <- map toReqHeader <$> getsCommonState stRequestHeaders
@@ -224,7 +224,7 @@ writeMedia :: (PandocMonad m, MonadIO m)
-> m ()
writeMedia dir (fp, _mt, bs) = do
-- we normalize to get proper path separators for the platform
- let fullpath = normalise $ dir </> unEscapeString fp
+ 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 2001-09-09 01:46:40.000000000 +0000
+++ pandoc-3.1.3/src/Text/Pandoc/MediaBag.hs 2023-07-14 18:39:12.170005139 +0000
@@ -28,6 +28,7 @@ import Data.Data (Data)
import qualified Data.Map as M
import Data.Maybe (fromMaybe, isNothing)
import Data.Typeable (Typeable)
+import Network.URI (unEscapeString)
import System.FilePath
import qualified System.FilePath.Posix as Posix
import qualified System.FilePath.Windows as Windows
@@ -35,7 +36,7 @@ import Text.Pandoc.MIME (MimeType, getMi
import Data.Text (Text)
import qualified Data.Text as T
import Data.Digest.Pure.SHA (sha1, showDigest)
-import Network.URI (URI (..), parseURI)
+import Network.URI (URI (..), parseURI, isURI)
data MediaItem =
MediaItem
@@ -54,9 +55,12 @@ newtype MediaBag = MediaBag (M.Map Text
instance Show MediaBag where
show bag = "MediaBag " ++ show (mediaDirectory bag)
--- | We represent paths with /, in normalized form.
+-- | We represent paths with /, in normalized form. Percent-encoding
+-- is resolved.
canonicalize :: FilePath -> Text
-canonicalize = T.replace "\\" "/" . T.pack . normalise
+canonicalize fp
+ | isURI fp = T.pack fp
+ | otherwise = T.replace "\\" "/" . T.pack . normalise . unEscapeString $ fp
-- | Delete a media item from a 'MediaBag', or do nothing if no item corresponds
-- to the given path.
@@ -79,23 +83,23 @@ insertMedia fp mbMime contents (MediaBag
, mediaContents = contents
, mediaMimeType = mt }
fp' = canonicalize fp
+ fp'' = T.unpack fp'
uri = parseURI fp
- newpath = if Posix.isRelative fp
- && Windows.isRelative fp
+ newpath = if Posix.isRelative fp''
+ && Windows.isRelative fp''
&& isNothing uri
- && ".." `notElem` splitDirectories fp
- then T.unpack fp'
+ && not (".." `T.isInfixOf` fp')
+ then fp''
else showDigest (sha1 contents) <> "." <> ext
- fallback = case takeExtension fp of
- ".gz" -> getMimeTypeDef $ dropExtension fp
- _ -> getMimeTypeDef fp
+ fallback = case takeExtension fp'' of
+ ".gz" -> getMimeTypeDef $ dropExtension fp''
+ _ -> getMimeTypeDef fp''
mt = fromMaybe fallback mbMime
- path = maybe fp uriPath uri
+ path = maybe fp'' (unEscapeString . uriPath) uri
ext = case takeExtension path of
'.':e -> e
_ -> maybe "" T.unpack $ extensionFromMimeType mt
-
-- | Lookup a media item in a 'MediaBag', returning mime type and contents.
lookupMedia :: FilePath
-> MediaBag
|
