Permalink
Browse files

Fix issue #81: Escape < and > characters in JSON strings to prevent X…

…SS attacks
  • Loading branch information...
1 parent bf7245a commit fa2ff40c85f4d90673f276fd9dafa8e2e0f9e2e9 @basvandijk committed Jul 4, 2012
Showing with 12 additions and 2 deletions.
  1. +12 −2 Data/Aeson/Encode.hs
View
@@ -62,15 +62,25 @@ string :: T.Text -> Builder
string s = {-# SCC "string" #-} singleton '"' <> quote s <> singleton '"'
where
quote q = case T.uncons t of
- Nothing -> fromText h
+ Nothing -> fromText h
Just (!c,t') -> fromText h <> escape c <> quote t'
where (h,t) = {-# SCC "break" #-} T.break isEscape q
- isEscape c = c == '\"' || c == '\\' || c < '\x20'
+ isEscape c = c == '\"' ||
+ c == '\\' ||
+ c == '<' ||
+ c == '>' ||
+ c < '\x20'
escape '\"' = "\\\""
escape '\\' = "\\\\"
escape '\n' = "\\n"
escape '\r' = "\\r"
escape '\t' = "\\t"
+
+ -- The following prevents untrusted JSON strings containing </script> or -->
+ -- from causing an XSS vulnerability:
+ escape '<' = "\\u003c"
+ escape '>' = "\\u003e"
+
escape c
| c < '\x20' = fromString $ "\\u" ++ replicate (4 - length h) '0' ++ h
| otherwise = singleton c

0 comments on commit fa2ff40

Please sign in to comment.