aboutsummaryrefslogtreecommitdiff
path: root/src/Text/Pandoc/MediaBag.hs
diff options
context:
space:
mode:
authorJohn MacFarlane <jgm@berkeley.edu>2021-06-18 12:06:20 -0700
committerJohn MacFarlane <jgm@berkeley.edu>2021-06-18 13:19:24 -0700
commit3fb5499dd638dae7156fba63ba5c1522bed5e46d (patch)
tree725d984325f9921101d7fbf8823992d322b93355 /src/Text/Pandoc/MediaBag.hs
parent961268446c551e43b43cd3dffaf0f3c6be4dfa6f (diff)
downloadpandoc-3fb5499dd638dae7156fba63ba5c1522bed5e46d.tar.gz
insertMediaBag: ensure we get sane mediaPath for URLs.
Long URLs cannot be treated as mediaPaths, but System.FilePath's `isRelative` often returns True for them. So we add a check for an absolute URL. We also ensure that extensions are derived only from the path portion of URLs (previously a following query was being included). Closes #7391.
Diffstat (limited to 'src/Text/Pandoc/MediaBag.hs')
-rw-r--r--src/Text/Pandoc/MediaBag.hs15
1 files changed, 10 insertions, 5 deletions
diff --git a/src/Text/Pandoc/MediaBag.hs b/src/Text/Pandoc/MediaBag.hs
index 06fba5632..098e484ee 100644
--- a/src/Text/Pandoc/MediaBag.hs
+++ b/src/Text/Pandoc/MediaBag.hs
@@ -26,13 +26,14 @@ module Text.Pandoc.MediaBag (
import qualified Data.ByteString.Lazy as BL
import Data.Data (Data)
import qualified Data.Map as M
-import Data.Maybe (fromMaybe)
+import Data.Maybe (fromMaybe, isNothing)
import Data.Typeable (Typeable)
import System.FilePath
import Text.Pandoc.MIME (MimeType, getMimeTypeDef, extensionFromMimeType)
import Data.Text (Text)
import qualified Data.Text as T
import Data.Digest.Pure.SHA (sha1, showDigest)
+import Network.URI (URI (..), parseURI)
data MediaItem =
MediaItem
@@ -76,16 +77,20 @@ insertMedia fp mbMime contents (MediaBag mediamap) =
, mediaContents = contents
, mediaMimeType = mt }
fp' = canonicalize fp
- newpath = if isRelative fp && ".." `notElem` splitPath fp
+ uri = parseURI fp
+ newpath = if isRelative fp
+ && isNothing uri
+ && ".." `notElem` splitPath fp
then T.unpack fp'
else showDigest (sha1 contents) <> "." <> ext
fallback = case takeExtension fp of
".gz" -> getMimeTypeDef $ dropExtension fp
_ -> getMimeTypeDef fp
mt = fromMaybe fallback mbMime
- ext = case takeExtension fp of
- '.':e -> e
- _ -> maybe "" T.unpack $ extensionFromMimeType mt
+ path = maybe fp 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.