haskell/xss-sanitize
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Use custom safe tags also for continuation.

Browse Source
This commit is contained in:
Yitzchak Gale 2018-06-26 21:59:25 +03:00
parent cb252f660f
commit b1c8a1ceeb
1 changed files with 8 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
Text/HTML/SanitizeXSS.hs
View File

@ -34,7 +34,7 @@ import Network.URI ( parseURIReference, URI (..),
isAllowedInURI, escapeURIString, uriScheme ) isAllowedInURI, escapeURIString, uriScheme )
import Codec.Binary.UTF8.String ( encodeString ) 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@. -- | 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)) -> mySafeTags :: (Text -> Bool) -> ((Text, Text) -> Maybe (Text, Text)) ->
[Tag Text] -> [Tag Text] [Tag Text] -> [Tag Text]
mySafeTags _ _ [] = [] mySafeTags _ _ [] = []
mySafeTags safeName _ (t@(TagClose name):tags) mySafeTags safeName sanitizeAttr (t@(TagClose name):tags)
| safeName name = t : safeTags tags | safeName name = t : mySafeTags safeName sanitizeAttr tags
| otherwise = safeTags tags | otherwise = mySafeTags safeName sanitizeAttr tags
mySafeTags safeName sanitizeAttr (TagOpen name attributes:tags) mySafeTags safeName sanitizeAttr (TagOpen name attributes:tags)
| safeName name = TagOpen name | safeName name = TagOpen name (mapMaybe sanitizeAttr attributes) :
(catMaybes $ map sanitizeAttr attributes) : safeTags tags mySafeTags safeName sanitizeAttr tags
| otherwise = safeTags tags | otherwise = mySafeTags safeName sanitizeAttr tags
mySafeTags _ _ (t:tags) = t:safeTags tags mySafeTags n a (t:tags) = t : mySafeTags n a tags
safeTagName :: Text -> Bool safeTagName :: Text -> Bool
safeTagName tagname = tagname `member` sanitaryTags safeTagName tagname = tagname `member` sanitaryTags