diff --git a/src/Text/HTML/SanitizeXSS.hs b/src/Text/HTML/SanitizeXSS.hs index 72b5f00..b8b3ac2 100644 --- a/src/Text/HTML/SanitizeXSS.hs +++ b/src/Text/HTML/SanitizeXSS.hs @@ -66,18 +66,18 @@ balanceTags = balance [] -- 'safeTags' or 'safeTagsCustom'. filterTags :: ([Tag Text] -> [Tag Text]) -> Text -> Text filterTags f = renderTagsOptions renderOptions { - optMinimize = \x -> x `member` voidElems -- converts to , converts to + optMinimize = \x -> T.toLower x `member` voidElems -- converts to , converts to } . f . canonicalizeTags . parseTags voidElems :: Set T.Text -voidElems = fromAscList $ T.words $ T.pack "area base br col command embed hr img input keygen link meta param source track wbr" +voidElems = fromAscList . map T.toLower . T.words $ T.pack "area base br col command embed hr img input keygen link meta param source track wbr" balance :: [Text] -- ^ unclosed tags -> [Tag Text] -> [Tag Text] -balance unclosed [] = map TagClose $ filter (`notMember` voidElems) unclosed +balance unclosed [] = map TagClose $ filter (flip notMember voidElems . T.toLower) unclosed balance (x:xs) tags'@(TagClose name:tags) | x == name = TagClose name : balance xs tags - | x `member` voidElems = balance xs tags' + | T.toLower x `member` voidElems = balance xs tags' | otherwise = TagOpen name [] : TagClose name : balance (x:xs) tags balance unclosed (TagOpen name as : tags) = TagOpen name as : balance (name : unclosed) tags @@ -115,11 +115,11 @@ safeTagsCustom safeName sanitizeAttr (TagOpen name attributes:tags) safeTagsCustom n a (t:tags) = t : safeTagsCustom n a tags safeTagName :: Text -> Bool -safeTagName tagname = tagname `member` sanitaryTags +safeTagName tagname = T.toLower tagname `member` sanitaryTags safeAttribute :: (Text, Text) -> Bool -safeAttribute (name, value) = name `member` sanitaryAttributes && - (name `notMember` uri_attributes || sanitaryURI value) +safeAttribute (name, value) = T.toLower name `member` sanitaryAttributes && + (T.toLower name `notMember` uri_attributes || sanitaryURI value) -- | low-level API if you have your own HTML parser. Used by safeTags. sanitizeAttribute :: (Text, Text) -> Maybe (Text, Text) @@ -129,17 +129,17 @@ sanitizeAttribute ("style", value) = sanitizeAttribute attr | safeAttribute attr = Just attr sanitizeAttribute attr@(name, value) - | name `member` fromList svg_attr_val_allows_ref + | T.toLower name `member` fromList svg_attr_val_allows_ref , Right () <- parseOnly (unsafeSVGRef <* endOfInput) value = Nothing - | name `member` fromList svg_attr_val_allows_ref + | T.toLower name `member` fromList svg_attr_val_allows_ref = Just attr sanitizeAttribute _ = Nothing unsafeSVGRef :: Parser () unsafeSVGRef = do skipMany space - string "url" + asciiCI "url" skipMany space char '(' skipMany space @@ -175,13 +175,13 @@ sanitaryAttributes = fromList (allowed_html_uri_attributes ++ acceptable_attribu \\ (fromList svg_attr_val_allows_ref) -- extra unescaping not implemented allowed_html_uri_attributes :: [Text] -allowed_html_uri_attributes = ["href", "src", "cite", "action", "longdesc"] +allowed_html_uri_attributes = map T.toLower ["href", "src", "cite", "action", "longdesc"] uri_attributes :: Set Text -uri_attributes = fromList $ allowed_html_uri_attributes ++ ["xlink:href", "xml:base"] +uri_attributes = fromList $ allowed_html_uri_attributes ++ map T.toLower ["xlink:href", "xml:base"] acceptable_elements :: [Text] -acceptable_elements = ["a", "abbr", "acronym", "address", "area", +acceptable_elements = map T.toLower ["a", "abbr", "acronym", "address", "area", "article", "aside", "audio", "b", "big", "blockquote", "br", "button", "canvas", "caption", "center", "cite", "code", "col", "colgroup", "command", "datagrid", "datalist", "dd", "del", "details", "dfn", @@ -196,7 +196,7 @@ acceptable_elements = ["a", "abbr", "acronym", "address", "area", "u", "ul", "var", "video"] mathml_elements :: [Text] -mathml_elements = ["maction", "math", "merror", "mfrac", "mi", +mathml_elements = map T.toLower ["maction", "math", "merror", "mfrac", "mi", "mmultiscripts", "mn", "mo", "mover", "mpadded", "mphantom", "mprescripts", "mroot", "mrow", "mspace", "msqrt", "mstyle", "msub", "msubsup", "msup", "mtable", "mtd", "mtext", "mtr", "munder", @@ -204,7 +204,7 @@ mathml_elements = ["maction", "math", "merror", "mfrac", "mi", -- this should include altGlyph I think svg_elements :: [Text] -svg_elements = ["a", "animate", "animateColor", "animateMotion", +svg_elements = map T.toLower ["a", "animate", "animateColor", "animateMotion", "animateTransform", "clipPath", "circle", "defs", "desc", "ellipse", "font-face", "font-face-name", "font-face-src", "g", "glyph", "hkern", "linearGradient", "line", "marker", "metadata", "missing-glyph", @@ -212,7 +212,7 @@ svg_elements = ["a", "animate", "animateColor", "animateMotion", "set", "stop", "svg", "switch", "text", "title", "tspan", "use"] acceptable_attributes :: [Text] -acceptable_attributes = ["abbr", "accept", "accept-charset", "accesskey", +acceptable_attributes = map T.toLower ["abbr", "accept", "accept-charset", "accesskey", "align", "alt", "autocomplete", "autofocus", "axis", "background", "balance", "bgcolor", "bgproperties", "border", "bordercolor", "bordercolordark", "bordercolorlight", "bottompadding", @@ -240,13 +240,13 @@ acceptable_attributes = ["abbr", "accept", "accept-charset", "accesskey", "width", "wrap", "xml:lang"] acceptable_protocols :: [String] -acceptable_protocols = [ "ed2k", "ftp", "http", "https", "irc", +acceptable_protocols = map (map toLower) [ "ed2k", "ftp", "http", "https", "irc", "mailto", "news", "gopher", "nntp", "telnet", "webcal", "xmpp", "callto", "feed", "urn", "aim", "rsync", "tag", "ssh", "sftp", "rtsp", "afs" ] mathml_attributes :: [Text] -mathml_attributes = ["actiontype", "align", "columnalign", "columnalign", +mathml_attributes = map T.toLower ["actiontype", "align", "columnalign", "columnalign", "columnalign", "columnlines", "columnspacing", "columnspan", "depth", "display", "displaystyle", "equalcolumns", "equalrows", "fence", "fontstyle", "fontweight", "frame", "height", "linethickness", "lspace", @@ -257,7 +257,7 @@ mathml_attributes = ["actiontype", "align", "columnalign", "columnalign", "xlink:type", "xmlns", "xmlns:xlink"] svg_attributes :: [Text] -svg_attributes = ["accent-height", "accumulate", "additive", "alphabetic", +svg_attributes = map T.toLower ["accent-height", "accumulate", "additive", "alphabetic", "arabic-form", "ascent", "attributeName", "attributeType", "baseProfile", "bbox", "begin", "by", "calcMode", "cap-height", "class", "clip-path", "color", "color-rendering", "content", "cx", @@ -288,12 +288,12 @@ svg_attributes = ["accent-height", "accumulate", "additive", "alphabetic", -- the values for these need to be escaped svg_attr_val_allows_ref :: [Text] -svg_attr_val_allows_ref = ["clip-path", "color-profile", "cursor", "fill", +svg_attr_val_allows_ref = map T.toLower ["clip-path", "color-profile", "cursor", "fill", "filter", "marker", "marker-start", "marker-mid", "marker-end", "mask", "stroke"] svg_allow_local_href :: [Text] -svg_allow_local_href = ["altGlyph", "animate", "animateColor", +svg_allow_local_href = map T.toLower ["altGlyph", "animate", "animateColor", "animateMotion", "animateTransform", "cursor", "feImage", "filter", "linearGradient", "pattern", "radialGradient", "textpath", "tref", "set", "use"]