bug#42545: 28.0.50; json-pretty-print cant't handle json having "t" as a key

bug#42545: 28.0.50; json-pretty-print cant't handle json having "t" as a key

[Marcelo Muñoz]

[-- Attachment #1: Type: text/plain, Size: 773 bytes --]

Try to apply json-pretty-print to follow json:

{"t": 1, "key":2}

fail with the message:  json-pretty-print: Bad JSON object key: t

Some research point me the problem is in the function json-encode-key,
its  implementation is:

(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))


The follow change seems to  solve the problem, but I haven't had time
understand it in depth:

(defun json-encode-key (object)
   "Return s string representation of a key"
   (json-encode-string (symbol-name object)))

[-- Attachment #2: Type: text/html, Size: 980 bytes --]

bug#42545: 28.0.50; json-pretty-print cant't handle json having "t" as a key

[Basil L. Contovounesios]

retitle 42545 json-encode-key can't handle boolean values
found 42545 24.5
quit

Marcelo Muñoz <ma.munoz.araya@gmail.com> writes:

> Try to apply json-pretty-print to follow json:
>
> {"t": 1, "key":2}
>
> fail with the message:  json-pretty-print: Bad JSON object key: t

Here are some simpler repros:

(json-encode '((nil . 0)))
(json-encode '((t . 0)))
(json-encode-key nil)
(json-encode-key t)

All of these fail with json-key-format since at least as far back as
Emacs 24.5.

> Some research point me the problem is in the function json-encode-key,
> its  implementation is:
>
> (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))
>
> The follow change seems to  solve the problem, but I haven't had time
> understand it in depth:
>
> (defun json-encode-key (object)
>    "Return s string representation of a key"
>    (json-encode-string (symbol-name object)))

This can't be TRT, because OBJECT is not always a symbol.

See also https://debbugs.gnu.org/24252#26 for some precedent in
rewriting json-encode-key without relying on json-encode.

I'm AFK until start of August, but I'll try to have a better look at
this when I get the chance if no-one beats me to it.

Thanks,

-- 
Basil

bug#42545: 28.0.50; json-pretty-print cant't handle json having "t" as a key

[Basil L. Contovounesios]

[-- Attachment #1: Type: text/plain, Size: 2766 bytes --]

"Basil L. Contovounesios" <contovob@tcd.ie> writes:

> Marcelo Muñoz <ma.munoz.araya@gmail.com> writes:
>
>> Try to apply json-pretty-print to follow json:
>>
>> {"t": 1, "key":2}
>>
>> fail with the message:  json-pretty-print: Bad JSON object key: t
>
> Here are some simpler repros:
>
> (json-encode '((nil . 0)))
> (json-encode '((t . 0)))
> (json-encode-key nil)
> (json-encode-key t)
>
> All of these fail with json-key-format since at least as far back as
> Emacs 24.5.

[...]

> See also https://debbugs.gnu.org/24252#26 for some precedent in
> rewriting json-encode-key without relying on json-encode.
>
> I'm AFK until start of August, but I'll try to have a better look at
> this when I get the chance if no-one beats me to it.

Sorry, finally got around to this.  The attached patch should fix this
issue while also speeding up encoding in a backward compatible way.
Using the same benchmark as https://bugs.gnu.org/40693#89 I get the
following:

  encode canada.json
  old
  (1.409496598 96 0.7710352720000002)
  (1.406660968 96 0.7707586369999997)
  (1.406515696 96 0.7698804519999998)
  (1.4098724120000001 96 0.7712946)
  new
  (1.452364951 96 0.7682001569999999)
  (1.451790854 96 0.7712237389999999)
  (1.452158289 96 0.7710199420000006)
  (1.4520665160000001 96 0.7707500029999999)

This shows that the two extra cases of funcall+cond in json-encode
slightly slow down encoding of large numbers of numbers, but I doubt
it's significant enough.  If it is, we can probably just tweak the
dispatch order in json-encode.

  encode citm_catalog.json
  old
  (2.7812737399999996 272 2.1942181940000003)
  (2.77954628 272 2.1904517840000004)
  (2.779567506 272 2.1901039010000005)
  (2.778913438 272 2.189370834)
  new
  (0.7056556740000001 68 0.55314481)
  (0.704577043 68 0.5515927839999994)
  (0.702683784 68 0.5491281600000004)
  (0.703850623 68 0.5503691039999996)

  encode twitter.json
  old
  (1.427292653 148 1.1098771399999983)
  (1.428440774 148 1.109535473000001)
  (1.4265714 148 1.1097104909999977)
  (1.426152699 148 1.110347719)
  new
  (0.365952034 40 0.29652698499999985)
  (0.366947621 40 0.29772050399999905)
  (0.36731820000000004 40 0.29776995099999937)
  (0.366228327 40 0.29696426200000126)

These show that examples with more realistic objects are encoded far
faster.

Decoding performance is not affected.

This change fixes some errors in json.el and brings it a tiny bit closer
to json.c in handling confusable keys, but doesn't go all the way, for
backward compatibility.  For example, json-encode and json-serialize
still disagree on ((:t . 1)), (("t" . 1)), (t 1), ("t" 1), hash tables
with non-string keys, etc.

WDYT?

-- 
Basil


[-- Attachment #2: 0001-Fix-json.el-encoding-of-confusable-object-keys.patch --]
[-- Type: text/x-diff, Size: 11054 bytes --]

From 911fa28836888fc1d5c9f16fda6ebbb188bfbac5 Mon Sep 17 00:00:00 2001
From: "Basil L. Contovounesios" <contovob@tcd.ie>
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

bug#42545: 28.0.50; json-pretty-print cant't handle json having "t" as a key

[Basil L. Contovounesios]

tags 42545 fixed
close 42545 28.1
quit

"Basil L. Contovounesios" <contovob@tcd.ie> writes:

> The attached patch should fix this issue while also speeding up
> encoding in a backward compatible way.

I've now pushed it to master, and am therefore closing this report.

Fix json.el encoding of confusable object keys
908f251e19 2021-02-21 12:53:45 +0000
https://git.savannah.gnu.org/cgit/emacs.git/commit/?id=908f251e19dc64c75000f87bc6db4e9a8852d1ad

Thanks,

-- 
Basil

bug#42545: 28.0.50; json-pretty-print cant't handle json having "t" as a key

[Dmitry Gutov]

Hi Basil,

On 21.02.2021 15:01, Basil L. Contovounesios wrote:
>> The attached patch should fix this issue while also speeding up
>> encoding in a backward compatible way.
> I've now pushed it to master, and am therefore closing this report.

Looking good, thank you!

bug#42545: 28.0.50; json-pretty-print cant't handle json having "t" as a key

[Basil L. Contovounesios]

Hi Dmitry,

Dmitry Gutov <dgutov@yandex.ru> writes:

> On 21.02.2021 15:01, Basil L. Contovounesios wrote:
>>> The attached patch should fix this issue while also speeding up
>>> encoding in a backward compatible way.
>> I've now pushed it to master, and am therefore closing this report.
>
> Looking good, thank you!

Thanks, you're welcome!  But I'm not yet done speeding up json.el
encoding backward compatibly, so stay tuned ;).

-- 
Basil

bug#42545: 28.0.50; json-pretty-print cant't handle json having "t" as a key

[Dmitry Gutov]

On 23.02.2021 03:41, Basil L. Contovounesios wrote:
> Thanks, you're welcome!  But I'm not yet done speeding up json.el
> encoding backward compatibly, so stay tuned;).

I'm more partial to faster decoding myself ;-). but correctness 
improvements are welcome either way!