Add tests for fillMediaBag/extractMedia.

Author: jgm

pandoc.cabal

@@ -767,13 +767,15 @@ test-suite test-pandoc
                   tasty-hunit       >= 0.9     && < 0.11,
                   tasty-quickcheck  >= 0.8     && < 0.11,
                   text              >= 1.1.1.0 && < 2.1,
+                  temporary         >= 1.1     && < 1.4,
                   time              >= 1.5     && < 1.14,
                   xml               >= 1.3.12  && < 1.4,
                   zip-archive       >= 0.4.3   && < 0.5
   other-modules:  Tests.Old
                   Tests.Command
                   Tests.Helpers
                   Tests.Shared
+                  Tests.MediaBag
                   Tests.Readers.LaTeX
                   Tests.Readers.HTML
                   Tests.Readers.JATS

test/Tests/MediaBag.hs

@@ -0,0 +1,40 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Tests.MediaBag (tests) where
+
+import Test.Tasty
+import Test.Tasty.HUnit
+-- import Tests.Helpers
+import Text.Pandoc.Class.IO (extractMedia)
+import Text.Pandoc.Class (fillMediaBag, runIOorExplode)
+import System.IO.Temp (withTempDirectory)
+import System.FilePath
+import Text.Pandoc.Builder as B
+import System.Directory (doesFileExist, copyFile, setCurrentDirectory, getCurrentDirectory)
+
+tests :: [TestTree]
+tests = [
+  testCase "test fillMediaBag & extractMedia" $
+      withTempDirectory "." "extractMediaTest" $ \tmpdir -> do
+        olddir <- getCurrentDirectory
+        setCurrentDirectory tmpdir
+        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/gif;base64,R0lGODlhAQABAIAAAAAAAP///yH5BAEAAAAALAAAAAABAAEAAAIBRAA7" "" mempty)
+        runIOorExplode $ do
+          fillMediaBag d
+          extractMedia "foo" d
+        exists1 <- doesFileExist ("foo" </> "moon.jpg")
+        assertBool "file in directory extract with original name" exists1
+        exists2 <- doesFileExist ("foo" </> "f9d88c3dbe18f6a7f5670e994a947d51216cdf0e.jpg")
+        assertBool "file above directory extracted with hashed name" exists2
+        exists3 <- doesFileExist ("foo" </> "2a0eaa89f43fada3e6c577beea4f2f8f53ab6a1d.lua")
+        exists4 <- doesFileExist "a.lua"
+        assertBool "data uri with malicious payload does not get written to arbitrary location"
+          (exists3 && not exists4)
+        exists5 <- doesFileExist ("foo" </> "d5fceb6532643d0d84ffe09c40c481ecdf59e15a.gif")
+        assertBool "data uri with gif is properly decoded" exists5
+        setCurrentDirectory olddir
+  ]

test/test-pandoc.hs

@@ -50,13 +50,15 @@ import qualified Tests.Writers.RST
 import qualified Tests.Writers.AnnotatedTable
 import qualified Tests.Writers.TEI
 import qualified Tests.Writers.Markua
+import qualified Tests.MediaBag
 import Text.Pandoc.Shared (inDirectory)
 
 tests :: FilePath -> TestTree
 tests pandocPath = testGroup "pandoc tests"
         [ Tests.Command.tests
         , testGroup "Old" (Tests.Old.tests pandocPath)
         , testGroup "Shared" Tests.Shared.tests
+        , testGroup "MediaBag" Tests.MediaBag.tests
         , testGroup "Writers"
           [ testGroup "Native" Tests.Writers.Native.tests
           , testGroup "ConTeXt" Tests.Writers.ConTeXt.tests