ba5b426 · typeable/pandoc

git.iko.soy/typeable/pandoc

Org reader: ensure image sources are proper links

Image sources as those in plain images, image links, or figures, must be proper URIs or relative file paths to be recognized as images. This restriction is now enforced for all image sources. This also fixes the reader's usage of uncleaned image sources, leading to `file:` prefixes not being deleted from figure images (e.g. `[[file:image.jpg]]` leading to a broken image `<img src="file:image.jpg"/>) Thanks to @bsag for noticing this bug.

commitba5b426ded8b01a290da27aac9d3bb9a7a26de8c authorAlbert Krewinkel <albert@zeitkraut.de> dateTue 9 Aug 2016, 20:27 (10 years ago) parent0fbb676

4 files changed+62−48

compare with master

unifiedsplit

src/Text/Pandoc/Readers/Org/Blocks.hs+22−12 src/Text/Pandoc/Readers/Org/Inlines.hs+8−25 src/Text/Pandoc/Readers/Org/Shared.hs+23−2 tests/Tests/Readers/Org.hs+9−9

src/Text/Pandoc/Readers/Org/Blocks.hs+22−12

@@ -39,8 +39,8 @@ import Text.Pandoc.Readers.Org.Inlines

3939import Text.Pandoc.Readers.Org.ParserState

4040import Text.Pandoc.Readers.Org.Parsing

4141import Text.Pandoc.Readers.Org.Shared

42− ( isImageFilename, rundocBlockClass, toRundocAttrib

43− , translateLang )

42+ ( cleanLinkString, isImageFilename, rundocBlockClass

43+ , toRundocAttrib, translateLang )

4444

4545import qualified Text.Pandoc.Builder as B

4646import Text.Pandoc.Builder ( Inlines, Blocks )

@@ -571,23 +571,33 @@ figure :: OrgParser (F Blocks)

571571figure = try $ do

572572 figAttrs <- blockAttributes

573573 src <- skipSpaces *> selfTarget <* skipSpaces <* newline

574− guard . not . isNothing . blockAttrCaption $ figAttrs

575− guard (isImageFilename src)

576− let figName = fromMaybe mempty $ blockAttrName figAttrs

577− let figLabel = fromMaybe mempty $ blockAttrLabel figAttrs

578− let figCaption = fromMaybe mempty $ blockAttrCaption figAttrs

579− let figKeyVals = blockAttrKeyValues figAttrs

580− let attr = (figLabel, mempty, figKeyVals)

581− return $ (B.para . B.imageWith attr src (withFigPrefix figName) <$> figCaption)

574+ case cleanLinkString src of

575+ Nothing -> mzero

576+ Just imgSrc -> do

577+ guard (not . isNothing . blockAttrCaption $ figAttrs)

578+ guard (isImageFilename imgSrc)

579+ return $ figureBlock figAttrs imgSrc

582580 where

581+ selfTarget :: OrgParser String

582+ selfTarget = try $ char '[' *> linkTarget <* char ']'

583+

584+ figureBlock :: BlockAttributes -> String -> (F Blocks)

585+ figureBlock figAttrs imgSrc =

586+ let

587+ figName = fromMaybe mempty $ blockAttrName figAttrs

588+ figLabel = fromMaybe mempty $ blockAttrLabel figAttrs

589+ figCaption = fromMaybe mempty $ blockAttrCaption figAttrs

590+ figKeyVals = blockAttrKeyValues figAttrs

591+ attr = (figLabel, mempty, figKeyVals)

592+ in

593+ B.para . B.imageWith attr imgSrc (withFigPrefix figName) <$> figCaption

594+

583595 withFigPrefix :: String -> String

584596 withFigPrefix cs =

585597 if "fig:" `isPrefixOf` cs

586598 then cs

587599 else "fig:" ++ cs

588600

589− selfTarget :: OrgParser String

590− selfTarget = try $ char '[' *> linkTarget <* char ']'

591601

592602--

593603-- Examples

src/Text/Pandoc/Readers/Org/Inlines.hs+8−25

@@ -37,8 +37,8 @@ import Text.Pandoc.Readers.Org.BlockStarts

3737import Text.Pandoc.Readers.Org.ParserState

3838import Text.Pandoc.Readers.Org.Parsing

3939import Text.Pandoc.Readers.Org.Shared

40− ( isImageFilename, rundocBlockClass, toRundocAttrib

41− , translateLang )

40+ ( cleanLinkString, isImageFilename, rundocBlockClass

41+ , toRundocAttrib, translateLang )

4242

4343import qualified Text.Pandoc.Builder as B

4444import Text.Pandoc.Builder ( Inlines )

@@ -52,7 +52,7 @@ import qualified Text.TeXMath.Readers.MathML.EntityMap as MathMLEntityMap

5252import Prelude hiding (sequence)

5353import Control.Monad ( guard, mplus, mzero, when, void )

5454import Data.Char ( isAlphaNum, isSpace )

55−import Data.List ( intersperse, isPrefixOf )

55+import Data.List ( intersperse )

5656import Data.Maybe ( fromMaybe )

5757import qualified Data.Map as M

5858import Data.Traversable (sequence)

@@ -435,9 +435,11 @@ explicitOrImageLink = try $ do

435435 char ']'

436436 return $ do

437437 src <- srcF

438− if isImageFilename title

439− then pure $ B.link src "" $ B.image title mempty mempty

440− else linkToInlinesF src =<< title'

438+ case cleanLinkString title of

439+ Just imgSrc | isImageFilename imgSrc ->

440+ pure $ B.link src "" $ B.image imgSrc mempty mempty

441+ _ ->

442+ linkToInlinesF src =<< title'

441443

442444selflinkOrImage :: OrgParser (F Inlines)

443445selflinkOrImage = try $ do

@@ -482,25 +484,6 @@ linkToInlinesF linkStr =

482484 else pure . B.link cleanedLink ""

483485 Nothing -> internalLink linkStr -- other internal link

484486

485−-- | Cleanup and canonicalize a string describing a link. Return @Nothing@ if

486−-- the string does not appear to be a link.

487−cleanLinkString :: String -> Maybe String

488−cleanLinkString s =

489− case s of

490− '/':_ -> Just $ "file://" ++ s -- absolute path

491− '.':'/':_ -> Just s -- relative path

492− '.':'.':'/':_ -> Just s -- relative path

493− -- Relative path or URL (file schema)

494− 'f':'i':'l':'e':':':s' -> Just $ if ("//" `isPrefixOf` s') then s else s'

495− _ | isUrl s -> Just s -- URL

496− _ -> Nothing

497− where

498− isUrl :: String -> Bool

499− isUrl cs =

500− let (scheme, path) = break (== ':') cs

501− in all (\c -> isAlphaNum c || c `elem` (".-"::String)) scheme

502− && not (null path)

503−

504487internalLink :: String -> Inlines -> F Inlines

505488internalLink link title = do

506489 anchorB <- (link `elem`) <$> asksF orgStateAnchorIds

src/Text/Pandoc/Readers/Org/Shared.hs+23−2

@@ -27,13 +27,15 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA

2727Utility functions used in other Pandoc Org modules.

2828-}

2929module Text.Pandoc.Readers.Org.Shared

30− ( isImageFilename

30+ ( cleanLinkString

31+ , isImageFilename

3132 , rundocBlockClass

3233 , toRundocAttrib

3334 , translateLang

3435 ) where

3536

3637import Control.Arrow ( first )

38+import Data.Char ( isAlphaNum )

3739import Data.List ( isPrefixOf, isSuffixOf )

3840

3941

@@ -41,12 +43,31 @@ import Data.List ( isPrefixOf, isSuffixOf )

4143isImageFilename :: String -> Bool

4244isImageFilename filename =

4345 any (\x -> ('.':x) `isSuffixOf` filename) imageExtensions &&

44− (any (\x -> (x++":") `isPrefixOf` filename) protocols ||

46+ (any (\x -> (x ++ "://") `isPrefixOf` filename) protocols ||

4547 ':' `notElem` filename)

4648 where

4749 imageExtensions = [ "jpeg" , "jpg" , "png" , "gif" , "svg" ]

4850 protocols = [ "file", "http", "https" ]

4951

52+-- | Cleanup and canonicalize a string describing a link. Return @Nothing@ if

53+-- the string does not appear to be a link.

54+cleanLinkString :: String -> Maybe String

55+cleanLinkString s =

56+ case s of

57+ '/':_ -> Just $ "file://" ++ s -- absolute path

58+ '.':'/':_ -> Just s -- relative path

59+ '.':'.':'/':_ -> Just s -- relative path

60+ -- Relative path or URL (file schema)

61+ 'f':'i':'l':'e':':':s' -> Just $ if ("//" `isPrefixOf` s') then s else s'

62+ _ | isUrl s -> Just s -- URL

63+ _ -> Nothing

64+ where

65+ isUrl :: String -> Bool

66+ isUrl cs =

67+ let (scheme, path) = break (== ':') cs

68+ in all (\c -> isAlphaNum c || c `elem` (".-"::String)) scheme

69+ && not (null path)

70+

5071-- | Prefix used for Rundoc classes and arguments.

5172rundocPrefix :: String

5273rundocPrefix = "rundoc-"

tests/Tests/Readers/Org.hs+9−9

@@ -219,12 +219,12 @@ tests =

219219 (para $ link "" "" "New Link")

220220

221221 , "Image link" =:

222− "[[sunset.png][dusk.svg]]" =?>

222+ "[[sunset.png][file:dusk.svg]]" =?>

223223 (para $ link "sunset.png" "" (image "dusk.svg" "" ""))

224224

225225 , "Image link with non-image target" =:

226− "[[http://example.com][logo.png]]" =?>

227− (para $ link "http://example.com" "" (image "logo.png" "" ""))

226+ "[[http://example.com][./logo.png]]" =?>

227+ (para $ link "http://example.com" "" (image "./logo.png" "" ""))

228228

229229 , "Plain link" =:

230230 "Posts on http://zeitlens.com/ can be funny at times." =?>

@@ -810,29 +810,29 @@ tests =

810810 [ "Figure" =:

811811 unlines [ "#+caption: A very courageous man."

812812 , "#+name: goodguy"

813− , "[[edward.jpg]]"

813+ , "[[file:edward.jpg]]"

814814 ] =?>

815815 para (image "edward.jpg" "fig:goodguy" "A very courageous man.")

816816

817817 , "Figure with no name" =:

818818 unlines [ "#+caption: I've been through the desert on this"

819− , "[[horse.png]]"

819+ , "[[file:horse.png]]"

820820 ] =?>

821821 para (image "horse.png" "fig:" "I've been through the desert on this")

822822

823823 , "Figure with `fig:` prefix in name" =:

824824 unlines [ "#+caption: Used as a metapher in evolutionary biology."

825825 , "#+name: fig:redqueen"

826− , "[[the-red-queen.jpg]]"

826+ , "[[./the-red-queen.jpg]]"

827827 ] =?>

828− para (image "the-red-queen.jpg" "fig:redqueen"

828+ para (image "./the-red-queen.jpg" "fig:redqueen"

829829 "Used as a metapher in evolutionary biology.")

830830

831831 , "Figure with HTML attributes" =:

832832 unlines [ "#+CAPTION: mah brain just explodid"

833833 , "#+NAME: lambdacat"

834834 , "#+ATTR_HTML: :style color: blue :role button"

835− , "[[lambdacat.jpg]]"

835+ , "[[file:lambdacat.jpg]]"

836836 ] =?>

837837 let kv = [("style", "color: blue"), ("role", "button")]

838838 name = "fig:lambdacat"

@@ -842,7 +842,7 @@ tests =

842842 , "Labelled figure" =:

843843 unlines [ "#+CAPTION: My figure"

844844 , "#+LABEL: fig:myfig"

845− , "[[blub.png]]"

845+ , "[[file:blub.png]]"

846846 ] =?>

847847 let attr = ("fig:myfig", mempty, mempty)

848848 in para (imageWith attr "blub.png" "fig:" "My figure")