* proper comment escaping

2 files changed, 10 insertions, 2 deletions

diff --git a/src/Blog.hs b/src/Blog.hs
index 534803baa426..5914052f932e 100644
--- a/src/Blog.hs
+++ b/src/Blog.hs
@@ -116,7 +116,7 @@ renderComments comments lang = sequence_ $ map showComment comments
         showComment :: Comment -> Html
         showComment (Comment{..}) = H.li $ do
             H.i $ toHtml $ T.append cauthor ": "
-            toHtml ctext
+            preEscapedText ctext
             H.p ! A.class_ "tt" $ toHtml $ timeString cdate
         timeString t = formatTime defaultTimeLocale (cTimeFormat lang) t
 
diff --git a/src/Main.hs b/src/Main.hs
index fe111f76668a..8adef253a591 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -120,10 +120,18 @@ addComment acid lang eId = do
   nCtext <- lookText' "ctext"
   nComment <- Comment <$> pure now
                       <*> lookText' "cname"
-                      <*> pure (entryEscape nCtext)
+                      <*> pure (commentEscape nCtext)
   update' acid (AddComment eId nComment)
   seeOther ("/" ++ show lang ++ "/" ++ show eId) (toResponse())
 
+commentEscape :: Text -> Text
+commentEscape = newlineEscape . ltEscape . gtEscape . ampEscape
+    where
+        newlineEscape = T.replace "\n" "<br>"
+        ampEscape = T.replace "&" "&amp;"
+        ltEscape = T.replace "<" "&lt;"
+        gtEscape = T.replace ">" "&gt;"
+
 {- ADMIN stuff -} 
 
 postEntry :: AcidState Blog -> ServerPart Response