From 0e78c6d56c68c5bc4105cd4e1d24da473247f743 Mon Sep 17 00:00:00 2001
From: Viktor Kronvall <viktor.kronvall@gmail.com>
Date: Mon, 16 Nov 2020 22:48:13 +0900
Subject: [PATCH] Escape JSON to avoid parsing the content as HTML

By crafting a malicious string it was quite easy to escape the HTML
attribute that contained the JSON report data.

This commit aims to mitigate the breakage of the reports when report
names contain unexpected characters. The JSON data is moved to a
<script> tag and the content is escaped by replacing significant HTML
characters with their corresponding JSON escape sequences. The '<'
character is replaced with the sequence "\u003c", '&' is replaced with
"\u0026" and so on.
---
 Criterion/Report.hs    | 49 +++++++++++++++++++++++++++++++-----------
 templates/criterion.js |  4 ++--
 templates/default.tpl  |  5 +++--
 3 files changed, 41 insertions(+), 17 deletions(-)

diff --git a/Criterion/Report.hs b/Criterion/Report.hs
index 833bca78..e3ee9201 100644
--- a/Criterion/Report.hs
+++ b/Criterion/Report.hs
@@ -32,12 +32,13 @@ module Criterion.Report
     ) where
 
 import Control.Exception (Exception, IOException, throwIO)
-import Control.Monad (mplus, unless)
+import Control.Monad (mplus)
 import Control.Monad.IO.Class (MonadIO(liftIO))
 import Control.Monad.Reader (ask)
 import Criterion.Monad (Criterion)
 import Criterion.Types
 import Data.Aeson (ToJSON (..), Value(..), object, (.=), Value)
+import Data.Aeson.Text (encodeToLazyText)
 import Data.Data (Data, Typeable)
 import Data.Foldable (forM_)
 import GHC.Generics (Generic)
@@ -46,8 +47,8 @@ import Statistics.Function (minMax)
 import System.Directory (doesFileExist)
 import System.FilePath ((</>), (<.>), isPathSeparator)
 import System.IO (hPutStrLn, stderr)
-import Text.Microstache (Key (..), MustacheWarning (..), Node (..), Template (..),
-                         compileMustacheText, displayMustacheWarning, renderMustacheW)
+import Text.Microstache (Key (..), Node (..), Template (..),
+                compileMustacheText, displayMustacheWarning, renderMustacheW)
 import Prelude ()
 import Prelude.Compat
 import qualified Control.Exception as E
@@ -103,6 +104,34 @@ report reports = do
     tpl <- loadTemplate [td,"."] template
     TL.writeFile name =<< formatReport reports tpl
 
+-- | Escape JSON string aimed to be embedded in an HTML <script> tag.  Notably
+-- < and > are replaced with their unicode escape sequences such that closing
+-- the <script> tag from within the JSON data is disallowed, i.e, the character
+-- sequence "</" is made impossible.
+--
+-- Moreover, single quotes are escaped such that embedding JSON into HTML
+-- attributes quoted with single quotes is safe, & is escaped to avoid HTML
+-- character references (&<code>;) and + is escaped to avoid UTF-7 attacks
+-- (should only affect old versions of IE).
+--
+-- The following characters are replaced with their unicode escape sequnces
+-- (\uXXXX) <, >, &, +, \0, \n, \r, ' (single quote), /, \, \x2028 (line
+-- separator) and \x2029 (paragraph separator)
+escapeJSON :: Char -> TL.Text
+escapeJSON '<'      = "\\u003c" -- ban closing of the script tag by making </ impossible
+escapeJSON '>'      = "\\u003e" -- encode tags with unicode escape sequences
+escapeJSON '\x2028' = "\\u2028" -- line separator
+escapeJSON '\x2029' = "\\u2029" -- paragraph separator
+escapeJSON '&'      = "\\u0026" -- avoid HTML entities
+escapeJSON '+'      = "\\u002b" -- + can be used in UTF-7 escape sequences
+escapeJSON '\0'     = "\\u0000" -- make null characters explicit
+escapeJSON '\n'     = "\\u000a" -- for good measure also escape newlines
+escapeJSON '\r'     = "\\u000d" -- , carriage returns
+escapeJSON '\''     = "\\u0027" -- , single quotes
+escapeJSON '/'      = "\\u002f" -- , slashes
+escapeJSON '\\'     = "\\u005c" -- , and backslashes
+escapeJSON c        = TL.singleton c
+
 -- | Format a series of 'Report' values using the given Mustache template.
 formatReport :: [Report]
              -> TL.Text    -- ^ Mustache template.
@@ -121,7 +150,7 @@ formatReport reports templateName = do
     template <- includeTemplate (includeFile [templates]) template0
 
     let context = object
-            [ "json"                .= reports
+            [ "json"                .= reportsJSON reports
             , "js-criterion"        .= criterionJS
             , "js-chart"            .= chartJS
             , "criterion-css"       .= criterionCSS
@@ -131,18 +160,12 @@ formatReport reports templateName = do
     -- If there were any issues during mustache template rendering, make sure
     -- to inform the user. See #127.
     forM_ warnings $ \warning -> do
-      -- The one thing we choose not to warn about is substituting in the `json`
-      -- key. The reason is that `json` is used in:
-      --
-      --   var reports = {{{json}}};
-      --
-      -- So `json` represents a raw JavaScript array. This is a bit skeevy by
-      -- mustache conventions, but redesigning the template to avoid this
-      -- warning would be more work than just substituting the array directly.
-      unless (warning == MustacheDirectlyRenderedValue (Key ["json"])) $
         criterionWarning $ displayMustacheWarning warning
     return formatted
   where
+    reportsJSON :: [Report] -> T.Text
+    reportsJSON = TL.toStrict . TL.concatMap escapeJSON . encodeToLazyText
+
     chartFileContents :: IO T.Text
 #if defined(EMBED)
     chartFileContents        = pure $ TE.decodeUtf8 chartContents
diff --git a/templates/criterion.js b/templates/criterion.js
index b127edee..5c714210 100644
--- a/templates/criterion.js
+++ b/templates/criterion.js
@@ -843,8 +843,8 @@
     ]);
   }
   document.addEventListener('DOMContentLoaded', function() {
-    var reportData = JSON.parse(document.getElementById('report-data')
-      .getAttribute('data-report-json'))
+    var rawJSON = document.getElementById('report-data').text;
+    var reportData = JSON.parse(rawJSON)
       .map(function(report) {
         report.groups = report.reportName.split('/');
         return report;
diff --git a/templates/default.tpl b/templates/default.tpl
index 8cd6ec62..d46c4652 100644
--- a/templates/default.tpl
+++ b/templates/default.tpl
@@ -10,6 +10,9 @@
   <style>
     {{{criterion-css}}}
   </style>
+  <script type="application/json" id="report-data">
+    {{{json}}}
+  </script>
   <meta name="viewport" content="width=device-width, initial-scale=1">
 </head>
 <body>
@@ -32,8 +35,6 @@
     </div>
     <aside id="overview-chart"></aside>
     <main id="reports"></main>
-
-    <div id="report-data" data-report-json='{{{json}}}'></div>
   </div>
 
   <aside id="controls-explanation" class="explanation no-print">