From 87645443b5c6dffea928a19c50aded605a28279c Mon Sep 17 00:00:00 2001
From: Mark Oteiza <mvoteiza@udel.edu>
Date: Thu, 17 Aug 2017 20:00:52 -0400
Subject: [PATCH] Treat control characters in JSON strings as invalid

* lisp/json.el (json-peek): Reduce to following-char.
(json-pop, json-read): Zero (null char) means end of file.
(json-read-escaped-char): Delimit URL properly.
(json-read-string): Signal error for ASCII control characters.
* test/lisp/json-tests.el (test-json-peek): Check for zero instead of
:json-eof symbol.
(test-json-read-string): New test for control characters in JSON
strings.
---
 lisp/json.el            | 20 +++++++++++---------
 test/lisp/json-tests.el |  4 +++-
 2 files changed, 14 insertions(+), 10 deletions(-)

diff --git a/lisp/json.el b/lisp/json.el
index 627e65efa45..64486258ccf 100644
--- a/lisp/json.el
+++ b/lisp/json.el
@@ -193,12 +193,12 @@ Unlike `reverse', this keeps the property-value pairs intact."
 
 (defsubst json-peek ()
   "Return the character at point."
-  (or (char-after (point)) :json-eof))
+  (following-char))
 
 (defsubst json-pop ()
   "Advance past the character at point, returning it."
   (let ((char (json-peek)))
-    (if (eq char :json-eof)
+    (if (zerop char)
         (signal 'json-end-of-file nil)
       (json-advance)
       char)))
@@ -380,7 +380,7 @@ representation will be parsed correctly."
      (special (cdr special))
      ((not (eq char ?u)) char)
      ;; Special-case UTF-16 surrogate pairs,
-     ;; cf. https://tools.ietf.org/html/rfc7159#section-7.  Note that
+     ;; cf. <https://tools.ietf.org/html/rfc7159#section-7>.  Note that
      ;; this clause overlaps with the next one and therefore has to
      ;; come first.
      ((looking-at
@@ -406,6 +406,8 @@ representation will be parsed correctly."
   (let ((characters '())
         (char (json-peek)))
     (while (not (= char ?\"))
+      (when (< char 32)
+        (signal 'json-string-format (list (prin1-char char))))
       (push (if (= char ?\\)
                 (json-read-escaped-char)
               (json-pop))
@@ -686,12 +688,12 @@ become JSON objects."
 Advances point just past JSON object."
   (json-skip-whitespace)
   (let ((char (json-peek)))
-    (if (not (eq char :json-eof))
-        (let ((record (cdr (assq char json-readtable))))
-          (if (functionp (car record))
-              (apply (car record) (cdr record))
-            (signal 'json-readtable-error record)))
-      (signal 'json-end-of-file nil))))
+    (if (zerop char)
+        (signal 'json-end-of-file nil)
+      (let ((record (cdr (assq char json-readtable))))
+        (if (functionp (car record))
+            (apply (car record) (cdr record))
+          (signal 'json-readtable-error record))))))
 
 ;; Syntactic sugar for the reader
 
diff --git a/test/lisp/json-tests.el b/test/lisp/json-tests.el
index c6bd295d667..1d13ccf074f 100644
--- a/test/lisp/json-tests.el
+++ b/test/lisp/json-tests.el
@@ -75,7 +75,7 @@ Point is moved to beginning of the buffer."
 
 (ert-deftest test-json-peek ()
   (json-tests--with-temp-buffer ""
-    (should (eq (json-peek) :json-eof)))
+    (should (zerop (json-peek))))
   (json-tests--with-temp-buffer "{ \"a\": 1 }"
     (should (equal (json-peek) ?{))))
 
@@ -164,6 +164,8 @@ Point is moved to beginning of the buffer."
     (should (equal (json-read-escaped-char) ?\"))))
 
 (ert-deftest test-json-read-string ()
+  (json-tests--with-temp-buffer "\"formfeed\f\""
+    (should-error (json-read-string) :type 'json-string-format))
   (json-tests--with-temp-buffer "\"foo \\\"bar\\\"\""
     (should (equal (json-read-string) "foo \"bar\"")))
   (json-tests--with-temp-buffer "\"abcαβγ\""
-- 
2.11.4.GIT