xss-sanitize 0.2.2 → 0.2.3

raw patch · 2 files changed

+50/−10 lines, 2 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Text/HTML/SanitizeXSS.hs +49/−9
• xss-sanitize.cabal +1/−1

@@ -1,4 +1,8 @@-module Text.HTML.SanitizeXSS (sanitizeXSS) where+module Text.HTML.SanitizeXSS+    ( sanitize+    , sanitizeBalance+    , sanitizeXSS+    ) where  import Text.HTML.TagSoup @@ -9,20 +13,56 @@                      isAllowedInURI, escapeURIString, uriScheme ) import Codec.Binary.UTF8.String ( encodeString ) +import qualified Data.Map as Map+ -- | santize the html to prevent XSS attacks. See README.md <http://github.com/gregwebs/haskell-xss-sanitize> for more details+sanitize = sanitizeXSS++-- alias of sanitize function sanitizeXSS :: String -> String sanitizeXSS = renderTagsOptions renderOptions {     optMinimize = \x -> x `elem` ["br","img"] -- <img><img> converts to <img />, <a/> converts to <a></a>   } .  safeTags . parseTags++-- same as sanitizeXSS but makes sure there are no lone closing tags. See README.md <http://github.com/gregwebs/haskell-xss-sanitize> for more details+sanitizeBalance :: String -> String+sanitizeBalance = renderTagsOptions renderOptions {+    optMinimize = \x -> x `elem` ["br","img"] -- <img><img> converts to <img />, <a/> converts to <a></a>+  } . balance Map.empty . safeTags . parseTags++balance :: Map.Map String Int -> [Tag String] -> [Tag String]+balance m [] =+    concatMap go $ Map.toList m   where-    safeTags :: [Tag String] -> [Tag String]-    safeTags [] = []-    safeTags (t@(TagClose name):tags) | safeTagName name = t:(safeTags tags)-                                      | otherwise = safeTags tags-    safeTags (TagOpen name attributes:tags)-      | safeTagName name = TagOpen name (filter safeAttribute attributes) : safeTags tags-      | otherwise = safeTags tags-    safeTags (t:tags) = t:safeTags tags+    go (name, i)+        | noClosing name = []+        | otherwise = replicate i $ TagClose name+    noClosing = flip elem ["br", "img"]+balance m (t@(TagClose name):tags) =+    case Map.lookup name m of+        Nothing -> TagOpen name [] : TagClose name : balance m tags+        Just i ->+            let m' = if i == 1+                        then Map.delete name m+                        else Map.insert name (i - 1) m+             in t : balance m' tags+balance m (TagOpen name as : tags) =+    TagOpen name as : balance m' tags+  where+    m' = case Map.lookup name m of+            Nothing -> Map.insert name 1 m+            Just i -> Map.insert name (i + 1) m+balance m (t:ts) = t : balance m ts++safeTags :: [Tag String] -> [Tag String]+safeTags [] = []+safeTags (t@(TagClose name):tags)+    | safeTagName name = t : safeTags tags+    | otherwise = safeTags tags+safeTags (TagOpen name attributes:tags)+  | safeTagName name = TagOpen name (filter safeAttribute attributes) : safeTags tags+  | otherwise = safeTags tags+safeTags (t:tags) = t:safeTags tags  safeTagName :: String -> Bool safeTagName tagname = tagname `member` sanitaryTags

@@ -1,5 +1,5 @@ name:            xss-sanitize-version:         0.2.2+version:         0.2.3 license:         BSD3 license-file:    LICENSE author:          Greg Weber <greg@gregweber.info>