Skip to content

Commit 3d5e415

Browse files
iarenazaiarenaza
committed
[Fix: #3786] Sort dictionaries by key in nrepl-bencode
CIDER doesn't adhere to Bencode spec which requires dictionary keys to be sorted alphabetically. This hasn't been a problem so far because the bencode reader on nREPL side doesn't validate the order of keys. Still, it will be rigorous to produce correct values according to the selected format.
1 parent d6a875b commit 3d5e415

6 files changed

+159
-22
lines changed

Diff for: ‎CHANGELOG.md

+1
Original file line numberDiff line numberDiff line change
@@ -33,6 +33,7 @@
3333
### Bugs fixed
3434

3535
- [#3784](https://github.com/clojure-emacs/cider/issues/3784): Inspector: make point less erratic when navigating between inspector screens.
36+
- [#3786](https://github.com/clojure-emacs/cider/issues/3786): Sort dictionaries by key in nrepl-bencode
3637

3738
### Bugs fixed
3839

Diff for: ‎nrepl-client.el

+18-1
Original file line numberDiff line numberDiff line change
@@ -423,13 +423,30 @@ decoded message or nil if the strings were completely decoded."
423423
(erase-buffer)
424424
(cons string-q response-q))))
425425

426+
(defun nrepl--bencode-dict (dict)
427+
"Encode DICT with bencode.
428+
According to the Bittorrent protocol specification[1], when bencoding
429+
dictionaries, keys must be strings and appear in sorted order (sorted as
430+
raw strings, not alphanumerics).
431+
432+
[1] https://www.bittorrent.org/beps/bep_0003.html#bencoding"
433+
(let* ((sorted-keys (sort (nrepl-dict-keys dict)
434+
(lambda (a b)
435+
(string< a b))))
436+
(sorted-dict (nrepl-dict)))
437+
(dolist (k sorted-keys sorted-dict)
438+
(nrepl-dict-put sorted-dict
439+
k
440+
(nrepl-dict-get dict k)))
441+
(mapconcat #'nrepl-bencode (cdr sorted-dict) "")))
442+
426443
(defun nrepl-bencode (object)
427444
"Encode OBJECT with bencode.
428445
Integers, lists and nrepl-dicts are treated according to bencode
429446
specification. Everything else is encoded as string."
430447
(cond
431448
((integerp object) (format "i%de" object))
432-
((nrepl-dict-p object) (format "d%se" (mapconcat #'nrepl-bencode (cdr object) "")))
449+
((nrepl-dict-p object) (format "d%se" (nrepl--bencode-dict object)))
433450
((listp object) (format "l%se" (mapconcat #'nrepl-bencode object "")))
434451
(t (format "%s:%s" (string-bytes object) object))))
435452

Diff for: ‎nrepl-dict.el

+3-1
Original file line numberDiff line numberDiff line change
@@ -37,7 +37,9 @@
3737

3838
(defun nrepl-dict (&rest key-vals)
3939
"Create nREPL dict from KEY-VALS."
40-
(cons 'dict key-vals))
40+
(if (cl-evenp (length key-vals))
41+
(cons 'dict key-vals)
42+
(error "An even number of KEY-VALS is needed to build a dict object")))
4143

4244
(defun nrepl-dict-from-hash (hash)
4345
"Create nREPL dict from HASH."

Diff for: ‎test/nrepl-bencode-tests.el

+41-3
Original file line numberDiff line numberDiff line change
@@ -327,10 +327,48 @@ If object is incomplete, return a decoded path."
327327
"int" 1
328328
"int-list" (1 2 3 4 5)
329329
"string" "f30dbd69-7095-40c1-8e98-7873ae71a07f"
330-
"dict" (dict "k1" 1 "k2" 2 "k3" "333333")
330+
"unordered-dict" (dict "k3" "333333" "k2" 2 "k1" 1)
331331
"status" ("eval-error")))
332-
(expect (car (nrepl-bdecode-string (nrepl-bencode obj)))
333-
:to-equal obj))))
332+
;; Bencoded dicts may change the order of the keys of original
333+
;; dict, as bencoding a dict MUST encode the keys in sorted
334+
;; order. We need to compare objects taking this into account.
335+
(expect (bencodable-obj-equal?
336+
obj
337+
(car (nrepl-bdecode-string (nrepl-bencode obj))))
338+
:to-be t))))
339+
340+
(describe "nrepl--bencode"
341+
(it "encodes strings"
342+
(expect (nrepl-bencode "spam") :to-equal "4:spam")
343+
(expect (nrepl-bencode "") :to-equal "0:")
344+
;; Assuming we use UTF-8 encoded strings, which
345+
;; Clojure/Clojurescript do.
346+
(expect (nrepl-bencode "Божидар") :to-equal "14:Божидар"))
347+
348+
(it "encodes integers"
349+
(expect (nrepl-bencode 3) :to-equal "i3e")
350+
(expect (nrepl-bencode -3) :to-equal "i-3e"))
351+
352+
(it "encodes lists"
353+
(expect (nrepl-bencode '("spam" "eggs"))
354+
:to-equal "l4:spam4:eggse")
355+
(expect (nrepl-bencode '("spam" ("eggs" "salt")))
356+
:to-equal "l4:spaml4:eggs4:saltee")
357+
(expect (nrepl-bencode '(1 2 3 (4 5 (6)) 7 8))
358+
:to-equal "li1ei2ei3eli4ei5eli6eeei7ei8ee"))
359+
360+
(it "encodes dicts"
361+
(expect (nrepl-bencode '(dict "spam" "eggs" "cow" "moo"))
362+
:to-equal "d3:cow3:moo4:spam4:eggse")
363+
(expect (nrepl-bencode '(dict "spam" "eggs"
364+
"cow" (dict "foo" "foobar" "bar" "baz")))
365+
:to-equal "d3:cowd3:bar3:baz3:foo6:foobare4:spam4:eggse"))
366+
367+
(it "handles nils"
368+
(expect (nrepl-bencode '("" nil (dict "" nil)))
369+
:to-equal "l0:led0:leee")
370+
(expect (nrepl-bencode '("" nil (dict "cow" nil "" 6)))
371+
:to-equal "l0:led0:i6e3:cowleee")))
334372

335373
;; benchmarks
336374

Diff for: ‎test/nrepl-server-mock.el

+52-17
Original file line numberDiff line numberDiff line change
@@ -33,38 +33,73 @@
3333
(require 'queue)
3434
(require 'cl)
3535

36+
(defun nrepl-server-mock--get-keys (dict keys)
37+
"Get the values for KEYS from nrepl-dict DICT.
38+
Get them as a list, so they can be easily consumed by
39+
`cl-destructuring-bind`."
40+
(mapcar (lambda (k) (nrepl-dict-get dict k)) keys))
41+
3642
(defun nrepl-server-mock-filter (proc output)
3743
"Handle the nREPL message found in OUTPUT sent by the client PROC.
3844
Minimal implementation, just enough for fulfilling clients' testing
39-
requirements."
45+
requirements.
46+
47+
Additional complexity is added by the fact that bencoded dictionaries
48+
must have their keys in sorted order. But we don't want to have to
49+
remember to write them down as such in the test values here (because
50+
there is ample room for mistakes that are harder to debug)."
4051
;; (mock/log! ":mock.filter/output %s :msg %s" proc output)
4152

4253
(condition-case error-details
4354
(let* ((msg (queue-dequeue (cdr (nrepl-bdecode output))))
4455
(_ (mock/log! ":mock.filter/msg :in %S" msg))
56+
;; Message id and session are needed for all request
57+
;; messages and responses. Get them once here.
58+
(msg-id (nrepl-dict-get msg "id"))
59+
(msg-session (nrepl-dict-get msg "session"))
4560
(response (pcase msg
46-
(`(dict "op" "clone"
47-
"client-name" "CIDER"
48-
"client-version" ,cider-version
49-
"id" ,id)
50-
`(dict "id" ,id
61+
((pred (lambda (msg)
62+
(let ((keys '("client-version")))
63+
(cl-destructuring-bind (client-version) (nrepl-server-mock--get-keys msg keys)
64+
(bencodable-obj-equal? msg
65+
`(dict "op" "clone"
66+
"client-name" "CIDER"
67+
"client-version" ,client-version
68+
"id" ,msg-id))))))
69+
`(dict "id" ,msg-id
5170
"session" "a-session"
5271
"status" ("done")
5372
"new-session" "a-new-session"))
5473

55-
(`(dict "op" "describe" "session" ,session "id" ,id)
56-
`(dict "id" ,id "session" ,session "status"
57-
("done")))
74+
((pred (bencodable-obj-equal? `(dict "op" "describe"
75+
"id" ,msg-id
76+
"session" ,msg-session)))
77+
`(dict "id" ,msg-id
78+
"session" ,msg-session
79+
"status" ("done")))
80+
5881
;; Eval op can include other fields in addition to the
5982
;; code, we only need the signature and the session and
60-
;; id fields at the end.
61-
(`(dict "op" "eval" "code" ,_code . ,rest)
62-
(cl-destructuring-bind (_ session _ id) (seq-drop rest (- (seq-length rest) 4))
63-
`(dict "id" ,id "session" ,session "status"
64-
("done"))))
65-
(`(dict "op" "close" "session" ,session "id" ,id)
66-
`(dict "id" ,id "session" ,session "status"
67-
("done"))))))
83+
;; id fields.
84+
((pred (lambda (msg)
85+
(let ((keys '("op")))
86+
(cl-destructuring-bind (op) (nrepl-server-mock--get-keys msg keys)
87+
(bencodable-obj-equal? `(dict "op" ,op
88+
"id" ,msg-id
89+
"session" ,msg-session)
90+
`(dict "op" "eval"
91+
"id" ,msg-id
92+
"session" ,msg-session))))))
93+
`(dict "id" ,msg-id
94+
"session" ,msg-session
95+
"status" ("done")))
96+
97+
((pred (bencodable-obj-equal? `(dict "op" "close"
98+
"id" ,msg-id
99+
"session" ,msg-session)))
100+
`(dict "id" ,msg-id
101+
"session" ,msg-session
102+
"status" ("done"))))))
68103

69104
(mock/log! ":mock.filter/msg :out %S" response)
70105
(if (not response)

Diff for: ‎test/utils/nrepl-tests-utils.el

+44
Original file line numberDiff line numberDiff line change
@@ -113,6 +113,50 @@ calling process."
113113
(message ":nrepl-mock-server-process-started...")))))
114114
server-process))
115115

116+
(defun bencodable-obj-equal? (obj1 obj2)
117+
"Compare bencodable objects OBJ1 and OBJ2 for equality.
118+
They are considered equal if they have the same content. Dicts are
119+
considered equal if they have the same key-value pairs, even if the keys
120+
appear in different order."
121+
(cond
122+
((nrepl-dict-p obj1)
123+
(if (not (nrepl-dict-p obj2))
124+
nil
125+
(let ((obj1-keys (sort (nrepl-dict-keys obj1)
126+
(lambda (a b)
127+
(string< a b))))
128+
(obj2-keys (sort (nrepl-dict-keys obj2)
129+
(lambda (a b)
130+
(string< a b)))))
131+
(if (not (equal obj1-keys obj2-keys))
132+
nil
133+
(seq-every-p #'identity
134+
(mapcar (lambda (key)
135+
(bencodable-obj-equal?
136+
(nrepl-dict-get obj1 key)
137+
(nrepl-dict-get obj2 key)))
138+
obj1-keys))))))
139+
((listp obj1)
140+
(if (not (and (listp obj2)
141+
(= (length obj1)
142+
(length obj2))))
143+
nil
144+
(seq-every-p #'identity
145+
(cl-mapcar (lambda (obj1 obj2)
146+
(bencodable-obj-equal? obj1 obj2))
147+
obj1
148+
obj2))))
149+
((integerp obj1)
150+
(if (not (integerp obj2))
151+
nil
152+
(= obj1 obj2)))
153+
((stringp obj1)
154+
(if (not (stringp obj2))
155+
nil
156+
(string= obj1 obj2)))
157+
;; Any other kind of value is not a bencodable value.
158+
nil))
159+
116160
(provide 'nrepl-tests-utils)
117161

118162
;;; nrepl-tests-utils.el ends here

0 commit comments

Comments
 (0)