From 10e28ef750f0c7e6bc0dfb7aabaaad8edf059e3c Mon Sep 17 00:00:00 2001
From: John MacFarlane <jgm@berkeley.edu>
Date: Fri, 17 Apr 2015 22:55:39 -0700
Subject: More principled fix for #1820.

If the tag parses as a comment, we check to see if the
input starts with `<!--`. If not, it's bogus comment mode
and we fail htmlTag.

Includes test case.  Closes #1820.
---
 src/Text/Pandoc/Readers/HTML.hs | 12 +++++++-----
 1 file changed, 7 insertions(+), 5 deletions(-)

(limited to 'src/Text/Pandoc')

diff --git a/src/Text/Pandoc/Readers/HTML.hs b/src/Text/Pandoc/Readers/HTML.hs
index 52358e51e..9eeab620b 100644
--- a/src/Text/Pandoc/Readers/HTML.hs
+++ b/src/Text/Pandoc/Readers/HTML.hs
@@ -51,7 +51,7 @@ import Text.Pandoc.Options (ReaderOptions(readerParseRaw, readerTrace)
 import Text.Pandoc.Parsing hiding ((<|>))
 import Text.Pandoc.Walk
 import Data.Maybe ( fromMaybe, isJust)
-import Data.List ( intercalate, isInfixOf )
+import Data.List ( intercalate, isInfixOf, isPrefixOf )
 import Data.Char ( isDigit )
 import Control.Monad ( liftM, guard, when, mzero, void, unless )
 import Control.Arrow ((***))
@@ -887,16 +887,18 @@ htmlTag :: Monad m
         => (Tag String -> Bool)
         -> ParserT [Char] st m (Tag String, String)
 htmlTag f = try $ do
-  lookAhead $ char '<' >> ((oneOf "/!?" >> nonspaceChar) <|> letter)
-  (next : _) <- getInput >>= return . canonicalizeTags . parseTags
+  lookAhead (char '<')
+  inp <- getInput
+  let (next : _) = canonicalizeTags $ parseTags inp
   guard $ f next
-  -- advance the parser
   case next of
-       TagComment s -> do
+       TagComment s
+         | "<!--" `isPrefixOf` inp -> do
           count (length s + 4) anyChar
           skipMany (satisfy (/='>'))
           char '>'
           return (next, "<!--" ++ s ++ "-->")
+         | otherwise -> fail "bogus comment mode, HTML5 parse error"
        _            -> do
           rendered <- manyTill anyChar (char '>')
           return (next, rendered ++ ">")
-- 
cgit v1.2.3