diff --git a/package.yaml b/package.yaml index ca9542f..0c03ea0 100644 --- a/package.yaml +++ b/package.yaml @@ -1,5 +1,5 @@ name: xss-sanitize -version: 0.3.5.7 +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 e2599b2..5eee7db 100644 --- a/src/Text/HTML/SanitizeXSS.hs +++ b/src/Text/HTML/SanitizeXSS.hs @@ -12,6 +12,7 @@ module Text.HTML.SanitizeXSS -- * Custom filtering , filterTags , safeTags + , safeTagsCustom , balanceTags -- * Utilities @@ -33,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@. @@ -53,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 @@ -74,17 +77,36 @@ 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 [] = [] -safeTags (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 - | otherwise = safeTags tags -safeTags (t:tags) = t:safeTags tags +safeTags = safeTagsCustom safeTagName sanitizeAttribute + +-- | 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.6 +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) + | 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) : + 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 40b9af5..9b8eabb 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 $ safeTagsCustom 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 "

" "

"