71eac37 · typeable/pandoc

git.iko.soy/typeable/pandoc

Fixed treatment of unicode characters in URIs.

* Added stringToURI to Shared. This is used in the HTML writer for all URIs. It properly URI-encodes high characters (> 127), leaving everything else (including symbols and spaces) the same. * Modified unsanitaryURI to allow UTF8 characters in a URI. (First, we convert the URI to URI-encoded octets, then we pass through parseURIReference.) This resolves gitit Issue #99. Previously '[abc](http://gitit.net/测试)' would not be rendered as a link when --sanitize was selected.

commit71eac37ac555b41325c334f662facc5308f43b64 authorJohn MacFarlane <jgm@berkeley.edu> dateMon 22 Mar 2010, 19:29 (17 years ago) parent7689cac

3 files changed+38−14

compare with master

unifiedsplit

src/Text/Pandoc/Readers/HTML.hs+1−1 src/Text/Pandoc/Shared.hs+17−1 src/Text/Pandoc/Writers/HTML.hs+20−12

src/Text/Pandoc/Readers/HTML.hs+1−1

@@ -182,7 +182,7 @@ unsanitaryURI u =

182182 "ldaps:", "magnet:", "mms:", "msnim:", "notes:", "rsync:",

183183 "secondlife:", "skype:", "ssh:", "sftp:", "smb:", "sms:",

184184 "snews:", "webcal:", "ymsgr:"]

185− in case parseURIReference u of

185+ in case parseURIReference (stringToURI u) of

186186 Just p -> (map toLower $ uriScheme p) `notElem` safeURISchemes

187187 Nothing -> True

188188

src/Text/Pandoc/Shared.hs+17−1

@@ -43,6 +43,7 @@ module Text.Pandoc.Shared (

4343 stripFirstAndLast,

4444 camelCaseToHyphenated,

4545 toRomanNumeral,

46+ stringToURI,

4647 wrapped,

4748 wrapIfNeeded,

4849 wrappedTeX,

@@ -114,7 +115,7 @@ import Text.ParserCombinators.Parsec

114115import Text.PrettyPrint.HughesPJ ( Doc, fsep, ($$), (<>), empty, isEmpty, text, nest )

115116import qualified Text.PrettyPrint.HughesPJ as PP

116117import Text.Pandoc.CharacterReferences ( characterReference )

117−import Data.Char ( toLower, toUpper, ord, isLower, isUpper, isAlpha,

118+import Data.Char ( toLower, toUpper, ord, chr, isLower, isUpper, isAlpha,

118119 isPunctuation )

119120import Data.List ( find, isPrefixOf, intercalate )

120121import Network.URI ( parseURI, URI (..), isAllowedInURI )

@@ -130,7 +131,12 @@ import System.IO.UTF8

130131import Data.Generics

131132import qualified Control.Monad.State as S

132133import Control.Monad (join)

134+import Data.ByteString (unpack)

135+import Data.Word (Word8)

136+import Data.ByteString.UTF8 (fromString)

137+import Text.Printf (printf)

133138import Paths_pandoc (getDataFileName)

139+

134140--

135141-- List processing

136142--

@@ -228,6 +234,16 @@ toRomanNumeral x =

228234 _ | x >= 1 -> "I" ++ toRomanNumeral (x - 1)

229235 _ -> ""

230236

237+-- | Escape unicode characters in a URI. This means converting

238+-- them to UTF-8, then URI-encoding the octets. We leave everything

239+-- else the same, assuming that the user has already escaped

240+-- special characters like & and %.

241+stringToURI :: String -> String

242+stringToURI = concatMap encodeOctet . unpack . fromString

243+ where encodeOctet :: Word8 -> String

244+ encodeOctet x | x > 127 = printf "%%%2x" x

245+ encodeOctet x = [chr (fromIntegral x)]

246+

231247-- | Wrap inlines to line length.

232248wrapped :: Monad m => ([Inline] -> m Doc) -> [Inline] -> m Doc

233249wrapped listWriter sect = (mapM listWriter $ splitBy Space sect) >>=

src/Text/Pandoc/Writers/HTML.hs+20−12

@@ -67,6 +67,14 @@ renderFragment opts = if writerWrapText opts

6767stringToHtml :: String -> Html

6868stringToHtml = primHtml . escapeStringForXML

6969

70+-- Note: href and src, unmodified, incorrectly escape high

71+-- characters in URIs using entities. So we use these replacements:

72+href' :: String -> HtmlAttr

73+href' = href . stringToURI

74+

75+src' :: String -> HtmlAttr

76+src' = src . stringToURI

77+

7078-- | Convert Pandoc document to Html string.

7179writeHtmlString :: WriterOptions -> Pandoc -> String

7280writeHtmlString opts d =

@@ -112,13 +120,13 @@ pandocToHtml opts (Pandoc (Meta title' authors' date') blocks) = do

112120 then case writerHTMLMathMethod opts of

113121 LaTeXMathML (Just url) ->

114122 script !

115− [src url, thetype "text/javascript"] $ noHtml

123+ [src' url, thetype "text/javascript"] $ noHtml

116124 MathML (Just url) ->

117125 script !

118− [src url, thetype "text/javascript"] $ noHtml

126+ [src' url, thetype "text/javascript"] $ noHtml

119127 JsMath (Just url) ->

120128 script !

121− [src url, thetype "text/javascript"] $ noHtml

129+ [src' url, thetype "text/javascript"] $ noHtml

122130 _ -> case lookup "mathml-script" (writerVariables opts) of

123131 Just s ->

124132 script ! [thetype "text/javascript"] <<

@@ -188,7 +196,7 @@ elementToListItem opts (Sec _ num id' headerText subsecs) = do

188196 let subList = if null subHeads

189197 then noHtml

190198 else unordList subHeads

191− return $ Just $ (anchor ! [href ("#" ++ writerIdentifierPrefix opts ++ id')] $ txt) +++ subList

199+ return $ Just $ (anchor ! [href' ("#" ++ writerIdentifierPrefix opts ++ id')] $ txt) +++ subList

192200

193201-- | Convert an Element to Html.

194202elementToHtml :: WriterOptions -> Element -> State WriterState Html

@@ -222,7 +230,7 @@ parseMailto _ = Nothing

222230-- | Obfuscate a "mailto:" link.

223231obfuscateLink :: WriterOptions -> String -> String -> Html

224232obfuscateLink opts txt s | writerEmailObfuscation opts == NoObfuscation =

225− anchor ! [href s] << txt

233+ anchor ! [href' s] << txt

226234obfuscateLink opts txt s =

227235 let meth = writerEmailObfuscation opts

228236 s' = map toLower s

@@ -249,7 +257,7 @@ obfuscateLink opts txt s =

249257 linkText ++ "+'<\\/'+'a'+'>');\n// -->\n")) +++

250258 noscript (primHtml $ obfuscateString altText)

251259 _ -> error $ "Unknown obfuscation method: " ++ show meth

252− _ -> anchor ! [href s] $ stringToHtml txt -- malformed email

260+ _ -> anchor ! [href' s] $ stringToHtml txt -- malformed email

253261

254262-- | Obfuscate character as entity.

255263obfuscateChar :: Char -> String

@@ -312,7 +320,7 @@ blockToHtml opts (Header level lst) = do

312320 stringToHtml " " +++ contents

313321 else contents

314322 let contents'' = if writerTableOfContents opts

315− then anchor ! [href $ "#" ++ writerIdentifierPrefix opts ++ "TOC"] $ contents'

323+ then anchor ! [href' $ "#" ++ writerIdentifierPrefix opts ++ "TOC"] $ contents'

316324 else contents'

317325 return $ case level of

318326 1 -> h1 contents''

@@ -452,7 +460,7 @@ inlineToHtml opts inline =

452460 then thespan ! [theclass "math"] $ primHtml str

453461 else thediv ! [theclass "math"] $ primHtml str

454462 MimeTeX url ->

455− return $ image ! [src (url ++ "?" ++ str),

463+ return $ image ! [src' (url ++ "?" ++ str),

456464 alt str, title str]

457465 GladTeX ->

458466 return $ primHtml $ "<EQ>" ++ str ++ "</EQ>"

@@ -484,13 +492,13 @@ inlineToHtml opts inline =

484492 return $ obfuscateLink opts (show linkText) s

485493 (Link txt (s,tit)) -> do

486494 linkText <- inlineListToHtml opts txt

487− return $ anchor ! ([href s] ++

495+ return $ anchor ! ([href' s] ++

488496 if null tit then [] else [title tit]) $

489497 linkText

490498 (Image txt (s,tit)) -> do

491499 alternate <- inlineListToHtml opts txt

492500 let alternate' = renderFragment opts alternate

493− let attributes = [src s] ++

501+ let attributes = [src' s] ++

494502 (if null tit

495503 then []

496504 else [title tit]) ++

@@ -508,7 +516,7 @@ inlineToHtml opts inline =

508516 -- push contents onto front of notes

509517 put $ st {stNotes = (htmlContents:notes)}

510518 return $ sup <<

511− anchor ! [href ("#" ++ writerIdentifierPrefix opts ++ "fn" ++ ref),

519+ anchor ! [href' ("#" ++ writerIdentifierPrefix opts ++ "fn" ++ ref),

512520 theclass "footnoteRef",

513521 prefixedId opts ("fnref" ++ ref)] << ref

514522 (Cite _ il) -> inlineListToHtml opts il

@@ -517,7 +525,7 @@ blockListToNote :: WriterOptions -> String -> [Block] -> State WriterState Html

517525blockListToNote opts ref blocks =

518526 -- If last block is Para or Plain, include the backlink at the end of

519527 -- that block. Otherwise, insert a new Plain block with the backlink.

520− let backlink = [HtmlInline $ " <a href=\"#" ++ writerIdentifierPrefix opts ++ "fnref" ++ ref ++

528+ let backlink = [HtmlInline $ " <a href=\"#" ++ stringToURI (writerIdentifierPrefix opts ++ "fnref" ++ ref) ++

521529 "\" class=\"footnoteBackLink\"" ++

522530 " title=\"Jump back to footnote " ++ ref ++ "\">↩</a>"]

523531 blocks' = if null blocks