From bbd7af410d2575727fb4f84bf7218b695ff47f3d Mon Sep 17 00:00:00 2001 From: Yitzchak Gale Date: Tue, 26 Jun 2018 19:12:02 +0300 Subject: [PATCH 1/8] Allow customized whitelists. --- Text/HTML/SanitizeXSS.hs | 23 +++++++++++++++++------ 1 file changed, 17 insertions(+), 6 deletions(-) diff --git a/Text/HTML/SanitizeXSS.hs b/Text/HTML/SanitizeXSS.hs index e2599b2..b80b851 100644 --- a/Text/HTML/SanitizeXSS.hs +++ b/Text/HTML/SanitizeXSS.hs @@ -12,6 +12,7 @@ module Text.HTML.SanitizeXSS -- * Custom filtering , filterTags , safeTags + , mySafeTags , balanceTags -- * Utilities @@ -76,15 +77,25 @@ balance unclosed (t:ts) = t : balance unclosed ts -- | Filters out any usafe tags and attributes. Use with filterTags to create a custom filter. safeTags :: [Tag Text] -> [Tag Text] -safeTags [] = [] -safeTags (t@(TagClose name):tags) +safeTags = mySafeTags safeTagName sanitizeAttribute + +-- | Filters out unsafe tags and attributes like 'safeTags', but uses +-- custom functions for determining which tags and attributes are +-- safe. This allows you to add or remove specific tags or attributes +-- on the white list, or to use your own white list. +-- @mySafeTags safeTagName sanitizeAttribute@ is equivalent to +-- 'safeTags'. +mySafeTags :: (Text -> Bool) -> ((Text, Text) -> Maybe (Text, Text)) -> + [Tag Text] -> [Tag Text] +mySafeTags _ _ [] = [] +mySafeTags _ _ (t@(TagClose name):tags) | safeTagName name = t : safeTags tags | otherwise = safeTags tags -safeTags (TagOpen name attributes:tags) - | safeTagName name = TagOpen name - (catMaybes $ map sanitizeAttribute attributes) : safeTags tags +mySafeTags safeName sanitizeAttr (TagOpen name attributes:tags) + | safeName name = TagOpen name + (catMaybes $ map sanitizeAttr attributes) : safeTags tags | otherwise = safeTags tags -safeTags (t:tags) = t:safeTags tags +mySafeTags _ _ (t:tags) = t:safeTags tags safeTagName :: Text -> Bool safeTagName tagname = tagname `member` sanitaryTags From cb252f660f3276d89a3ffa74254768bdd27b217b Mon Sep 17 00:00:00 2001 From: Yitzchak Gale Date: Tue, 26 Jun 2018 20:37:56 +0300 Subject: [PATCH 2/8] Use custom safe tags also for close tags. --- Text/HTML/SanitizeXSS.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/Text/HTML/SanitizeXSS.hs b/Text/HTML/SanitizeXSS.hs index b80b851..4d4d446 100644 --- a/Text/HTML/SanitizeXSS.hs +++ b/Text/HTML/SanitizeXSS.hs @@ -88,8 +88,8 @@ safeTags = mySafeTags safeTagName sanitizeAttribute mySafeTags :: (Text -> Bool) -> ((Text, Text) -> Maybe (Text, Text)) -> [Tag Text] -> [Tag Text] mySafeTags _ _ [] = [] -mySafeTags _ _ (t@(TagClose name):tags) - | safeTagName name = t : safeTags tags +mySafeTags safeName _ (t@(TagClose name):tags) + | safeName name = t : safeTags tags | otherwise = safeTags tags mySafeTags safeName sanitizeAttr (TagOpen name attributes:tags) | safeName name = TagOpen name From b1c8a1ceeb9f95182f345d9af2cd22b5b6ddae5c Mon Sep 17 00:00:00 2001 From: Yitzchak Gale Date: Tue, 26 Jun 2018 21:59:25 +0300 Subject: [PATCH 3/8] Use custom safe tags also for continuation. --- Text/HTML/SanitizeXSS.hs | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/Text/HTML/SanitizeXSS.hs b/Text/HTML/SanitizeXSS.hs index 4d4d446..8d5e445 100644 --- a/Text/HTML/SanitizeXSS.hs +++ b/Text/HTML/SanitizeXSS.hs @@ -34,7 +34,7 @@ import Network.URI ( parseURIReference, URI (..), isAllowedInURI, escapeURIString, uriScheme ) import Codec.Binary.UTF8.String ( encodeString ) -import Data.Maybe (catMaybes) +import Data.Maybe (mapMaybe) -- | Sanitize HTML to prevent XSS attacks. This is equivalent to @filterTags safeTags@. @@ -88,14 +88,14 @@ safeTags = mySafeTags safeTagName sanitizeAttribute mySafeTags :: (Text -> Bool) -> ((Text, Text) -> Maybe (Text, Text)) -> [Tag Text] -> [Tag Text] mySafeTags _ _ [] = [] -mySafeTags safeName _ (t@(TagClose name):tags) - | safeName name = t : safeTags tags - | otherwise = safeTags tags +mySafeTags safeName sanitizeAttr (t@(TagClose name):tags) + | safeName name = t : mySafeTags safeName sanitizeAttr tags + | otherwise = mySafeTags safeName sanitizeAttr tags mySafeTags safeName sanitizeAttr (TagOpen name attributes:tags) - | safeName name = TagOpen name - (catMaybes $ map sanitizeAttr attributes) : safeTags tags - | otherwise = safeTags tags -mySafeTags _ _ (t:tags) = t:safeTags tags + | safeName name = TagOpen name (mapMaybe sanitizeAttr attributes) : + mySafeTags safeName sanitizeAttr tags + | otherwise = mySafeTags safeName sanitizeAttr tags +mySafeTags n a (t:tags) = t : mySafeTags n a tags safeTagName :: Text -> Bool safeTagName tagname = tagname `member` sanitaryTags From 101690ff7bd6992039eac9f3e7ea72b93aff41f8 Mon Sep 17 00:00:00 2001 From: Yitzchak Gale Date: Tue, 26 Jun 2018 22:27:51 +0300 Subject: [PATCH 4/8] Tests for customized white list. --- test/main.hs | 24 +++++++++++++++++++++++- 1 file changed, 23 insertions(+), 1 deletion(-) diff --git a/test/main.hs b/test/main.hs index 40b9af5..eb0bf56 100644 --- a/test/main.hs +++ b/test/main.hs @@ -11,9 +11,19 @@ test f actual expected = do let result = f actual result @?= expected -sanitized :: Text -> Text -> Expectation +sanitized, sanitizedB, sanitizedC :: Text -> Text -> Expectation sanitized = test sanitize sanitizedB = test sanitizeBalance +sanitizedC = test sanitizeCustom + +sanitizeCustom :: Text -> Text +sanitizeCustom = filterTags $ mySafeTags mySafeName mySanitizeAttr + where + mySafeName t = t `elem` myTags || safeTagName t + mySanitizeAttr (key, val) | key `elem` myAttrs = Just (key, val) + mySanitizeAttr x = sanitizeAttribute x + myTags = ["custtag"] + myAttrs = ["custattr"] main :: IO () main = hspec $ do @@ -87,3 +97,15 @@ main = hspec $ do sanitizedB "" "" it "interleaved" $ sanitizedB "helloworld" "helloworld" + + describe "customized white list" $ do + it "does not filter custom tags" $ do + let custtag = "

" + sanitizedC custtag custtag + it "filters non-custom tags" $ do + sanitizedC "

" "

" + it "does not filter custom attributes" $ do + let custattr = "

" + sanitizedC custattr custattr + it "filters non-custom attributes" $ do + sanitizedC "

" "

" From 8f453e3dd5c16991cf7b648bbd2dd2e2c1289c5c Mon Sep 17 00:00:00 2001 From: Yitzchak Gale Date: Sun, 1 Jul 2018 12:59:58 +0300 Subject: [PATCH 5/8] Change name to safeTagsCustom, minor bump version to 0.3.5.8. --- Text/HTML/SanitizeXSS.hs | 26 ++++++++++++++------------ test/main.hs | 2 +- xss-sanitize.cabal | 2 +- 3 files changed, 16 insertions(+), 14 deletions(-) diff --git a/Text/HTML/SanitizeXSS.hs b/Text/HTML/SanitizeXSS.hs index 8d5e445..3602c44 100644 --- a/Text/HTML/SanitizeXSS.hs +++ b/Text/HTML/SanitizeXSS.hs @@ -12,7 +12,7 @@ module Text.HTML.SanitizeXSS -- * Custom filtering , filterTags , safeTags - , mySafeTags + , safeTagsCustom , balanceTags -- * Utilities @@ -77,25 +77,27 @@ balance unclosed (t:ts) = t : balance unclosed ts -- | Filters out any usafe tags and attributes. Use with filterTags to create a custom filter. safeTags :: [Tag Text] -> [Tag Text] -safeTags = mySafeTags safeTagName sanitizeAttribute +safeTags = safeTagsCustom safeTagName sanitizeAttribute -- | Filters out unsafe tags and attributes like 'safeTags', but uses -- custom functions for determining which tags and attributes are -- safe. This allows you to add or remove specific tags or attributes -- on the white list, or to use your own white list. --- @mySafeTags safeTagName sanitizeAttribute@ is equivalent to +-- @safeTagsCustom safeTagName sanitizeAttribute@ is equivalent to -- 'safeTags'. -mySafeTags :: (Text -> Bool) -> ((Text, Text) -> Maybe (Text, Text)) -> +-- +-- @since 0.3.5.8 +safeTagsCustom :: (Text -> Bool) -> ((Text, Text) -> Maybe (Text, Text)) -> [Tag Text] -> [Tag Text] -mySafeTags _ _ [] = [] -mySafeTags safeName sanitizeAttr (t@(TagClose name):tags) - | safeName name = t : mySafeTags safeName sanitizeAttr tags - | otherwise = mySafeTags safeName sanitizeAttr tags -mySafeTags safeName sanitizeAttr (TagOpen name attributes:tags) +safeTagsCustom _ _ [] = [] +safeTagsCustom safeName sanitizeAttr (t@(TagClose name):tags) + | safeName name = t : safeTagsCustom safeName sanitizeAttr tags + | otherwise = safeTagsCustom safeName sanitizeAttr tags +safeTagsCustom safeName sanitizeAttr (TagOpen name attributes:tags) | safeName name = TagOpen name (mapMaybe sanitizeAttr attributes) : - mySafeTags safeName sanitizeAttr tags - | otherwise = mySafeTags safeName sanitizeAttr tags -mySafeTags n a (t:tags) = t : mySafeTags n a tags + safeTagsCustom safeName sanitizeAttr tags + | otherwise = safeTagsCustom safeName sanitizeAttr tags +safeTagsCustom n a (t:tags) = t : safeTagsCustom n a tags safeTagName :: Text -> Bool safeTagName tagname = tagname `member` sanitaryTags diff --git a/test/main.hs b/test/main.hs index eb0bf56..9b8eabb 100644 --- a/test/main.hs +++ b/test/main.hs @@ -17,7 +17,7 @@ sanitizedB = test sanitizeBalance sanitizedC = test sanitizeCustom sanitizeCustom :: Text -> Text -sanitizeCustom = filterTags $ mySafeTags mySafeName mySanitizeAttr +sanitizeCustom = filterTags $ safeTagsCustom mySafeName mySanitizeAttr where mySafeName t = t `elem` myTags || safeTagName t mySanitizeAttr (key, val) | key `elem` myAttrs = Just (key, val) diff --git a/xss-sanitize.cabal b/xss-sanitize.cabal index 4769546..c4651f6 100644 --- a/xss-sanitize.cabal +++ b/xss-sanitize.cabal @@ -1,5 +1,5 @@ name: xss-sanitize -version: 0.3.5.7 +version: 0.3.5.8 license: BSD2 license-file: LICENSE author: Greg Weber From ea3047902aca467b60abbd971e880d64b09d5170 Mon Sep 17 00:00:00 2001 From: Yitzchak Gale Date: Sun, 1 Jul 2018 14:40:50 +0300 Subject: [PATCH 6/8] Improve haddocks. --- src/Text/HTML/SanitizeXSS.hs | 26 ++++++++++++++++++-------- 1 file changed, 18 insertions(+), 8 deletions(-) diff --git a/src/Text/HTML/SanitizeXSS.hs b/src/Text/HTML/SanitizeXSS.hs index 3602c44..abcc13c 100644 --- a/src/Text/HTML/SanitizeXSS.hs +++ b/src/Text/HTML/SanitizeXSS.hs @@ -54,8 +54,10 @@ sanitizeBalance = filterTags (balanceTags . safeTags) balanceTags :: [Tag Text] -> [Tag Text] balanceTags = balance [] --- | Parse the given text to a list of tags, apply the given filtering function, and render back to HTML. --- You can insert your own custom filtering but make sure you compose your filtering function with 'safeTags'! +-- | Parse the given text to a list of tags, apply the given filtering +-- function, and render back to HTML. You can insert your own custom +-- filtering, but make sure you compose your filtering function with +-- 'safeTags' or 'safeTagsCustom'. filterTags :: ([Tag Text] -> [Tag Text]) -> Text -> Text filterTags f = renderTagsOptions renderOptions { optMinimize = \x -> x `member` voidElems -- converts to , converts to @@ -75,19 +77,27 @@ balance unclosed (TagOpen name as : tags) = TagOpen name as : balance (name : unclosed) tags balance unclosed (t:ts) = t : balance unclosed ts --- | Filters out any usafe tags and attributes. Use with filterTags to create a custom filter. +-- | Filters out unsafe tags and sanitizes attributes. Use with +-- filterTags to create a custom filter. safeTags :: [Tag Text] -> [Tag Text] safeTags = safeTagsCustom safeTagName sanitizeAttribute --- | Filters out unsafe tags and attributes like 'safeTags', but uses --- custom functions for determining which tags and attributes are --- safe. This allows you to add or remove specific tags or attributes --- on the white list, or to use your own white list. +-- | Filters out unsafe tags and sanitizes attributes, like +-- 'safeTags', but uses custom functions for determining which tags +-- are safe and for sanitizing attributes. This allows you to add or +-- remove specific tags or attributes on the white list, or to use +-- your own white list. +-- -- @safeTagsCustom safeTagName sanitizeAttribute@ is equivalent to -- 'safeTags'. -- -- @since 0.3.5.8 -safeTagsCustom :: (Text -> Bool) -> ((Text, Text) -> Maybe (Text, Text)) -> +safeTagsCustom :: + (Text -> Bool) -- ^ Select safe tags, like + -- 'safeTagName' + -> ((Text, Text) -> Maybe (Text, Text)) -- ^ Sanitize attributes, + -- like 'sanitizeAttribute' + -> [Tag Text] -> [Tag Text] safeTagsCustom _ _ [] = [] safeTagsCustom safeName sanitizeAttr (t@(TagClose name):tags) From 787b7f060fdc08c5157214ca27b8a92e40ba2478 Mon Sep 17 00:00:00 2001 From: Yitzchak Gale Date: Sun, 1 Jul 2018 14:54:41 +0300 Subject: [PATCH 7/8] Improve function layout. --- src/Text/HTML/SanitizeXSS.hs | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/src/Text/HTML/SanitizeXSS.hs b/src/Text/HTML/SanitizeXSS.hs index abcc13c..f7ea173 100644 --- a/src/Text/HTML/SanitizeXSS.hs +++ b/src/Text/HTML/SanitizeXSS.hs @@ -97,8 +97,7 @@ safeTagsCustom :: -- 'safeTagName' -> ((Text, Text) -> Maybe (Text, Text)) -- ^ Sanitize attributes, -- like 'sanitizeAttribute' - -> - [Tag Text] -> [Tag Text] + -> [Tag Text] -> [Tag Text] safeTagsCustom _ _ [] = [] safeTagsCustom safeName sanitizeAttr (t@(TagClose name):tags) | safeName name = t : safeTagsCustom safeName sanitizeAttr tags From 86d83508f24b9eebed44201946dc9be25ec98a40 Mon Sep 17 00:00:00 2001 From: Yitzchak Gale Date: Sun, 1 Jul 2018 19:51:02 +0300 Subject: [PATCH 8/8] Version bump to 0.3.6. --- package.yaml | 2 +- src/Text/HTML/SanitizeXSS.hs | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/package.yaml b/package.yaml index aa3f202..0c03ea0 100644 --- a/package.yaml +++ b/package.yaml @@ -1,5 +1,5 @@ name: xss-sanitize -version: 0.3.5.8 +version: 0.3.6 synopsis: sanitize untrusted HTML to prevent XSS attacks description: run untrusted HTML through Text.HTML.SanitizeXSS.sanitizeXSS to prevent XSS attacks. see README.md for diff --git a/src/Text/HTML/SanitizeXSS.hs b/src/Text/HTML/SanitizeXSS.hs index f7ea173..5eee7db 100644 --- a/src/Text/HTML/SanitizeXSS.hs +++ b/src/Text/HTML/SanitizeXSS.hs @@ -91,7 +91,7 @@ safeTags = safeTagsCustom safeTagName sanitizeAttribute -- @safeTagsCustom safeTagName sanitizeAttribute@ is equivalent to -- 'safeTags'. -- --- @since 0.3.5.8 +-- @since 0.3.6 safeTagsCustom :: (Text -> Bool) -- ^ Select safe tags, like -- 'safeTagName'