diff --git a/src/Text/XmlHtml/Common.hs b/src/Text/XmlHtml/Common.hs
--- a/src/Text/XmlHtml/Common.hs
+++ b/src/Text/XmlHtml/Common.hs
@@ -8,7 +8,7 @@
import Blaze.ByteString.Builder
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Builder as B
-import Data.Char (isAscii, isLatin1)
+import Data.Char (chr, isAscii, isLatin1)
import qualified Data.HashMap.Strict as M
import qualified Data.HashSet as S
import qualified Data.Map as Map
@@ -21,6 +21,8 @@
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Encoding as TL
+import Text.Parsec.Text (Parser)
+
import Text.XmlHtml.HTML.Meta (reversePredefinedRefs,
explicitAttributes)
@@ -306,3 +308,11 @@
. TL.toStrict
. TL.decodeUtf8
. B.toLazyByteString
+
+------------------------------------------------------------------------------
+-- Parse a character from its character code, failing if invalid.
+safeChr :: Int -> Parser Char
+safeChr c =
+ if c > 1114111
+ then fail ("Invalid character code: " ++ show c)
+ else return (chr c)
diff --git a/src/Text/XmlHtml/HTML/Parse.hs b/src/Text/XmlHtml/HTML/Parse.hs
--- a/src/Text/XmlHtml/HTML/Parse.hs
+++ b/src/Text/XmlHtml/HTML/Parse.hs
@@ -344,8 +344,7 @@
decCharRef = do
ds <- some digit
_ <- P.char ';'
- let c = chr $ foldl' (\a b -> 10 * a + b) 0 ds
- return c
+ safeChr $ foldl' (\a b -> 10 * a + b) 0 ds
where
digit = do
d <- P.satisfy (\c -> c >= '0' && c <= '9')
@@ -354,8 +353,7 @@
_ <- P.char 'x' <|> P.char 'X'
ds <- some digit
_ <- P.char ';'
- let c = chr $ foldl' (\a b -> 16 * a + b) 0 ds
- return c
+ safeChr $ foldl' (\a b -> 16 * a + b) 0 ds
where
digit = num <|> upper <|> lower
num = do
diff --git a/src/Text/XmlHtml/XML/Parse.hs b/src/Text/XmlHtml/XML/Parse.hs
--- a/src/Text/XmlHtml/XML/Parse.hs
+++ b/src/Text/XmlHtml/XML/Parse.hs
@@ -506,7 +506,7 @@
_ <- text "&#"
ds <- some digit
_ <- P.char ';'
- let c = chr $ foldl' (\a b -> 10 * a + b) 0 ds
+ c <- safeChr $ foldl' (\a b -> 10 * a + b) 0 ds
when (not (isValidChar c)) $ fail $
"Reference is not a valid character"
return $ T.singleton c
@@ -518,7 +518,7 @@
_ <- text "&#x"
ds <- some digit
_ <- P.char ';'
- let c = chr $ foldl' (\a b -> 16 * a + b) 0 ds
+ c <- safeChr $ foldl' (\a b -> 16 * a + b) 0 ds
when (not (isValidChar c)) $ fail $
"Reference is not a valid character"
return $ T.singleton c
diff --git a/test/src/Text/XmlHtml/TestCommon.hs b/test/src/Text/XmlHtml/TestCommon.hs
--- a/test/src/Text/XmlHtml/TestCommon.hs
+++ b/test/src/Text/XmlHtml/TestCommon.hs
@@ -41,3 +41,7 @@
isLeft :: Either a b -> Bool
isLeft = either (const True) (const False)
+------------------------------------------------------------------------------
+isRight :: Either a b -> Bool
+isRight = not . isLeft
+
diff --git a/test/src/Text/XmlHtml/Tests.hs b/test/src/Text/XmlHtml/Tests.hs
--- a/test/src/Text/XmlHtml/Tests.hs
+++ b/test/src/Text/XmlHtml/Tests.hs
@@ -251,6 +251,7 @@
testIt "badDoctype3HTML " badDoctype3HTML
testIt "badDoctype4HTML " badDoctype4HTML
testIt "badDoctype5HTML " badDoctype5HTML
+ testIt "outOfBoundsChr " outOfBoundsChr
emptyDocumentHTML :: Bool
emptyDocumentHTML = parseHTML "" ""
@@ -324,6 +325,8 @@
badDoctype5HTML = isLeft $ parseHTML "" ("")
+outOfBoundsChr :: Bool
+outOfBoundsChr = isRight $ parseHTML "" "�
"
------------------------------------------------------------------------------
-- HTML Quirks Parsing Tests -------------------------------------------------
diff --git a/xmlhtml.cabal b/xmlhtml.cabal
--- a/xmlhtml.cabal
+++ b/xmlhtml.cabal
@@ -1,6 +1,6 @@
cabal-version: 2.2
Name: xmlhtml
-Version: 0.2.5.3
+Version: 0.2.5.4
Synopsis: XML parser and renderer with HTML 5 quirks mode
Description: Contains renderers and parsers for both XML and HTML 5
document fragments, which share data structures so that
@@ -34,8 +34,8 @@
GHC == 8.8.4
GHC == 8.10.7
GHC == 9.0.2
- GHC == 9.2.4
- GHC == 9.4.2
+ GHC == 9.2.5
+ GHC == 9.4.4
Extra-source-files:
.ghci,
@@ -816,7 +816,7 @@
default-language: Haskell2010
build-depends:
- , base >= 4.5 && < 4.18
+ , base >= 4.5 && < 5
Library
import: universal