From 911fa28836888fc1d5c9f16fda6ebbb188bfbac5 Mon Sep 17 00:00:00 2001 From: "Basil L. Contovounesios" Date: Thu, 11 Feb 2021 12:00:05 +0000 Subject: [PATCH] Fix json.el encoding of confusable object keys * lisp/json.el (json-encode-string): Clarify commentary. (json--encode-stringlike): New function that covers a subset of json-encode. (json-encode-key): Use it for more efficient encoding and validation, and to avoid mishandling confusable keys like boolean symbols (bug#42545). (json-encode-array): Make it clearer that argument can be a list. (json-encode): Reuse json-encode-keyword and json--encode-stringlike for a subset of the dispatch logic. (json-pretty-print): Ensure confusable keys like ":a" survive a decoding/encoding roundtrip (bug#24252, bug#45032). * test/lisp/json-tests.el (test-json-encode-string) (test-json-encode-hash-table, test-json-encode-alist) (test-json-encode-plist, test-json-pretty-print-object): Test encoding of confusable keys. --- lisp/json.el | 36 ++++++++++--------- test/lisp/json-tests.el | 79 ++++++++++++++++++++++++++++++++++++----- 2 files changed, 90 insertions(+), 25 deletions(-) diff --git a/lisp/json.el b/lisp/json.el index 1f1f608eab..f20123fcfb 100644 --- a/lisp/json.el +++ b/lisp/json.el @@ -438,7 +438,8 @@ json-encode-string ;; This seems to afford decent performance gains. (setq-local inhibit-modification-hooks t) (setq json--string-buffer (current-buffer)))) - (insert ?\" (substring-no-properties string)) ; see bug#43549 + ;; Strip `read-only' property (bug#43549). + (insert ?\" (substring-no-properties string)) (goto-char (1+ (point-min))) (while (re-search-forward (rx json--escape) nil 'move) (let ((char (preceding-char))) @@ -452,14 +453,20 @@ json-encode-string ;; Empty buffer for next invocation. (delete-and-extract-region (point-min) (point-max))))) +(defun json--encode-stringlike (object) + "Return OBJECT encoded as a JSON string, or nil if not possible." + (cond ((stringp object) (json-encode-string object)) + ((keywordp object) (json-encode-string + (substring (symbol-name object) 1))) + ((symbolp object) (json-encode-string (symbol-name object))))) + (defun json-encode-key (object) "Return a JSON representation of OBJECT. If the resulting JSON object isn't a valid JSON object key, this signals `json-key-format'." - (let ((encoded (json-encode object))) - (unless (stringp (json-read-from-string encoded)) - (signal 'json-key-format (list object))) - encoded)) + ;; Encoding must be a JSON string. + (or (json--encode-stringlike object) + (signal 'json-key-format (list object)))) ;;; Objects @@ -652,11 +659,10 @@ json-read-array ;; Array encoding (defun json-encode-array (array) - "Return a JSON representation of ARRAY." + "Return a JSON representation of ARRAY. +ARRAY can also be a list." (if (and json-encoding-pretty-print - (if (listp array) - array - (> (length array) 0))) + (not (length= array 0))) (concat "[" (json--with-indentation @@ -737,15 +743,9 @@ json-encode OBJECT should have a structure like one returned by `json-read'. If an error is detected during encoding, an error based on `json-error' is signaled." - (cond ((eq object t) (json-encode-keyword object)) - ((eq object json-null) (json-encode-keyword object)) - ((eq object json-false) (json-encode-keyword object)) - ((stringp object) (json-encode-string object)) - ((keywordp object) (json-encode-string - (substring (symbol-name object) 1))) + (cond ((json-encode-keyword object)) ((listp object) (json-encode-list object)) - ((symbolp object) (json-encode-string - (symbol-name object))) + ((json--encode-stringlike object)) ((numberp object) (json-encode-number object)) ((arrayp object) (json-encode-array object)) ((hash-table-p object) (json-encode-hash-table object)) @@ -774,6 +774,8 @@ json-pretty-print (json-null :json-null) ;; Ensure that ordering is maintained. (json-object-type 'alist) + ;; Ensure that keys survive roundtrip (bug#24252, bug#42545). + (json-key-type 'string) (orig-buf (current-buffer)) error) ;; Strategy: Repeatedly `json-read' from the original buffer and diff --git a/test/lisp/json-tests.el b/test/lisp/json-tests.el index 11b61d8b47..9886dc0d45 100644 --- a/test/lisp/json-tests.el +++ b/test/lisp/json-tests.el @@ -421,12 +421,21 @@ test-json-encode-string "\"\\nasdфыв\\u001f\u007ffgh\\t\""))) (ert-deftest test-json-encode-key () - (should (equal (json-encode-key "") "\"\"")) (should (equal (json-encode-key '##) "\"\"")) (should (equal (json-encode-key :) "\"\"")) - (should (equal (json-encode-key "foo") "\"foo\"")) - (should (equal (json-encode-key 'foo) "\"foo\"")) - (should (equal (json-encode-key :foo) "\"foo\"")) + (should (equal (json-encode-key "") "\"\"")) + (should (equal (json-encode-key 'a) "\"a\"")) + (should (equal (json-encode-key :a) "\"a\"")) + (should (equal (json-encode-key "a") "\"a\"")) + (should (equal (json-encode-key t) "\"t\"")) + (should (equal (json-encode-key :t) "\"t\"")) + (should (equal (json-encode-key "t") "\"t\"")) + (should (equal (json-encode-key nil) "\"nil\"")) + (should (equal (json-encode-key :nil) "\"nil\"")) + (should (equal (json-encode-key "nil") "\"nil\"")) + (should (equal (json-encode-key ":a") "\":a\"")) + (should (equal (json-encode-key ":t") "\":t\"")) + (should (equal (json-encode-key ":nil") "\":nil\"")) (should (equal (should-error (json-encode-key 5)) '(json-key-format 5))) (should (equal (should-error (json-encode-key ["foo"])) @@ -572,6 +581,39 @@ test-json-encode-hash-table (should (equal (json-encode-hash-table #s(hash-table)) "{}")) (should (equal (json-encode-hash-table #s(hash-table data (a 1))) "{\"a\":1}")) + (should (equal (json-encode-hash-table #s(hash-table data (t 1))) + "{\"t\":1}")) + (should (equal (json-encode-hash-table #s(hash-table data (nil 1))) + "{\"nil\":1}")) + (should (equal (json-encode-hash-table #s(hash-table data (:a 1))) + "{\"a\":1}")) + (should (equal (json-encode-hash-table #s(hash-table data (:t 1))) + "{\"t\":1}")) + (should (equal (json-encode-hash-table #s(hash-table data (:nil 1))) + "{\"nil\":1}")) + (should (equal (json-encode-hash-table + #s(hash-table test equal data ("a" 1))) + "{\"a\":1}")) + (should (equal (json-encode-hash-table + #s(hash-table test equal data ("t" 1))) + "{\"t\":1}")) + (should (equal (json-encode-hash-table + #s(hash-table test equal data ("nil" 1))) + "{\"nil\":1}")) + (should (equal (json-encode-hash-table + #s(hash-table test equal data (":a" 1))) + "{\":a\":1}")) + (should (equal (json-encode-hash-table + #s(hash-table test equal data (":t" 1))) + "{\":t\":1}")) + (should (equal (json-encode-hash-table + #s(hash-table test equal data (":nil" 1))) + "{\":nil\":1}")) + (should (member (json-encode-hash-table #s(hash-table data (t 2 :nil 1))) + '("{\"nil\":1,\"t\":2}" "{\"t\":2,\"nil\":1}"))) + (should (member (json-encode-hash-table + #s(hash-table test equal data (:t 2 ":t" 1))) + '("{\":t\":1,\"t\":2}" "{\"t\":2,\":t\":1}"))) (should (member (json-encode-hash-table #s(hash-table data (b 2 a 1))) '("{\"a\":1,\"b\":2}" "{\"b\":2,\"a\":1}"))) (should (member (json-encode-hash-table #s(hash-table data (c 3 b 2 a 1))) @@ -638,7 +680,16 @@ test-json-encode-alist (let ((json-encoding-object-sort-predicate nil) (json-encoding-pretty-print nil)) (should (equal (json-encode-alist ()) "{}")) - (should (equal (json-encode-alist '((a . 1))) "{\"a\":1}")) + (should (equal (json-encode-alist '((a . 1) (t . 2) (nil . 3))) + "{\"a\":1,\"t\":2,\"nil\":3}")) + (should (equal (json-encode-alist '((:a . 1) (:t . 2) (:nil . 3))) + "{\"a\":1,\"t\":2,\"nil\":3}")) + (should (equal (json-encode-alist '(("a" . 1) ("t" . 2) ("nil" . 3))) + "{\"a\":1,\"t\":2,\"nil\":3}")) + (should (equal (json-encode-alist '((":a" . 1) (":t" . 2) (":nil" . 3))) + "{\":a\":1,\":t\":2,\":nil\":3}")) + (should (equal (json-encode-alist '((t . 1) (:nil . 2) (":nil" . 3))) + "{\"t\":1,\"nil\":2,\":nil\":3}")) (should (equal (json-encode-alist '((b . 2) (a . 1))) "{\"b\":2,\"a\":1}")) (should (equal (json-encode-alist '((c . 3) (b . 2) (a . 1))) "{\"c\":3,\"b\":2,\"a\":1}")))) @@ -687,8 +738,14 @@ test-json-encode-plist (should (equal (json-encode-plist ()) "{}")) (should (equal (json-encode-plist '(:a 1)) "{\"a\":1}")) (should (equal (json-encode-plist '(:b 2 :a 1)) "{\"b\":2,\"a\":1}")) - (should (equal (json-encode-plist '(:c 3 :b 2 :a 1)) - "{\"c\":3,\"b\":2,\"a\":1}")))) + (should (equal (json-encode-plist '(":d" 4 "c" 3 b 2 :a 1)) + "{\":d\":4,\"c\":3,\"b\":2,\"a\":1}")) + (should (equal (json-encode-plist '(nil 2 t 1)) + "{\"nil\":2,\"t\":1}")) + (should (equal (json-encode-plist '(:nil 2 :t 1)) + "{\"nil\":2,\"t\":1}")) + (should (equal (json-encode-plist '(":nil" 4 "nil" 3 ":t" 2 "t" 1)) + "{\":nil\":4,\"nil\":3,\":t\":2,\"t\":1}")))) (ert-deftest test-json-encode-plist-pretty () (let ((json-encoding-object-sort-predicate nil) @@ -950,7 +1007,13 @@ test-json-pretty-print-object ;; Nested array. (json-tests-equal-pretty-print "{\"key\":[1,2]}" - "{\n \"key\": [\n 1,\n 2\n ]\n}")) + "{\n \"key\": [\n 1,\n 2\n ]\n}") + ;; Confusable keys (bug#24252, bug#42545). + (json-tests-equal-pretty-print + (concat "{\"t\":1,\"nil\":2,\":t\":3,\":nil\":4," + "\"null\":5,\":json-null\":6,\":json-false\":7}") + (concat "{\n \"t\": 1,\n \"nil\": 2,\n \":t\": 3,\n \":nil\": 4," + "\n \"null\": 5,\n \":json-null\": 6,\n \":json-false\": 7\n}"))) (ert-deftest test-json-pretty-print-array () ;; Empty. -- 2.30.0