procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Fix json.el encoding of confusable object keys

Browse source 
* 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.
This commit is contained in:
Basil L. Contovounesios 2021-02-11 12:00:05 +00:00
parent 767608ef56
commit 908f251e19
2 changed files with 90 additions and 25 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

36
lisp/json.el
View file

@ -438,7 +438,8 @@ Initialized lazily by `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 @@ Initialized lazily by `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 @@ become JSON objects."
;; 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 @@ you will get the following structure returned:
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 @@ With prefix argument MINIMIZE, minimize it instead."
(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

79
test/lisp/json-tests.el
View file

@ -421,12 +421,21 @@ Point is moved to beginning of the buffer."
"\"\\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 @@ Point is moved to beginning of the buffer."
(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 @@ Point is moved to beginning of the buffer."
(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 @@ Point is moved to beginning of the buffer."
(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 @@ nil, ORIGINAL should stay unchanged by pretty-printing."
;; 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.