Escape JSON to avoid parsing the content as HTML

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

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;

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">