diff --git a/src/Text/HTML/SanitizeXSS.hs b/src/Text/HTML/SanitizeXSS.hs
index 5eee7db..72b5f00 100644
--- a/src/Text/HTML/SanitizeXSS.hs
+++ b/src/Text/HTML/SanitizeXSS.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE OverloadedStrings, TupleSections #-}
-- | Sanatize HTML to prevent XSS attacks.
--
-- See README.md for more details.
@@ -26,7 +26,7 @@ import Text.HTML.SanitizeXSS.Css
import Text.HTML.TagSoup
import Data.Set (Set(), member, notMember, (\\), fromList, fromAscList)
-import Data.Char ( toLower )
+import Data.Char (toLower, isSpace)
import Data.Text (Text)
import qualified Data.Text as T
@@ -36,6 +36,12 @@ import Codec.Binary.UTF8.String ( encodeString )
import Data.Maybe (mapMaybe)
+import Data.Attoparsec.Text
+
+import Control.Applicative (many)
+import Data.Foldable (asum)
+import Control.Monad (guard)
+
-- | Sanitize HTML to prevent XSS attacks. This is equivalent to @filterTags safeTags@.
sanitize :: Text -> Text
@@ -120,8 +126,27 @@ sanitizeAttribute :: (Text, Text) -> Maybe (Text, Text)
sanitizeAttribute ("style", value) =
let css = sanitizeCSS value
in if T.null css then Nothing else Just ("style", css)
-sanitizeAttribute attr | safeAttribute attr = Just attr
- | otherwise = Nothing
+sanitizeAttribute attr
+ | safeAttribute attr = Just attr
+sanitizeAttribute attr@(name, value)
+ | name `member` fromList svg_attr_val_allows_ref
+ , Right () <- parseOnly (unsafeSVGRef <* endOfInput) value
+ = Nothing
+ | name `member` fromList svg_attr_val_allows_ref
+ = Just attr
+sanitizeAttribute _ = Nothing
+
+unsafeSVGRef :: Parser ()
+unsafeSVGRef = do
+ skipMany space
+ string "url"
+ skipMany space
+ char '('
+ skipMany space
+ satisfy $ \x -> x /= '#' && not (isSpace x)
+ skipMany $ notChar ')'
+ char ')'
+ return ()
-- | Returns @True@ if the specified URI is not a potential security risk.
diff --git a/test/main.hs b/test/main.hs
index 9b8eabb..dd5a833 100644
--- a/test/main.hs
+++ b/test/main.hs
@@ -109,3 +109,15 @@ main = hspec $ do
sanitizedC custattr custattr
it "filters non-custom attributes" $ do
sanitizedC "" ""
+
+ describe "svg escaping" $ do
+ it "does not filter simple values" $ do
+ let svg = ""
+ sanitized svg svg
+ it "filters urls" $
+ sanitized "" ""
+ it "does not filter fragment urls" $ do
+ let svg = ""
+ sanitized svg svg
+ it "unescapes urls" $
+ sanitized "" ""