[cl-json-devel] Not interning object keys

[Red Daly]

I created this patch before I got your email.  What my usage is now the
following:

    (let ((json:*json-identifier-name-to-lisp* 'identity)
          (json:*json-symbolize-lisp-key* 'identity))
      (json:decode-json-from-string json))

The patch is attached:



I have not taken the time to read through how the accumulator works.  This
approach modifies the default behavior in a more fine-grained way.



On Thu, Jun 25, 2009 at 1:29 PM, Boris Smilga <boris.smilga at gmail.com>wrote:

> On 25 Jun 2009, at 22:27, Red Daly wrote:
>
>  CL-JSON does not allow the user to customize the means used to decode the
>> keys for object literals.  It may be important to avoid interning in a web
>> setting, for example, since interns of many unique symbols could potentially
>> use a lot of memory.  An attack could exploit this by submitting something
>> that is passed through cl-json that has many very large, unique symbols.
>>
>
> Indeed, thank you for pointing this out.
>
>  There used to be a way to get around this with the factory method
>> customization, but the current library does not include a means of changing
>> the decoding behavior for a key to avoid interning it.  [...]
>>
>
> It is the same thing in the new version, except that customization works in
> a somewhat different way.  Broadly speaking, you have to redefine the way a
> level of JSON Object structure is accumulated to form the corresponding Lisp
> structure.  E. g., in the following example new (KEY . VALUE) pairs are
> clipped onto the end of a list accumulator, to form an alist:


>
>  (defvar *accumulator* nil)
>  (defvar *accumulator-last* nil)
>
>  (defun init-accumulator ()
>    (setq *accumulator* (cons nil nil)
>          *accumulator-last* *accumulator*))
>
>  (defun collect-key (key)
>    (setq *accumulator-last*
>          (setf (cdr *accumulator-last*)
>                (cons (cons key nil) nil))))
>
>  (defun collect-value (value)
>    (setf (cdar *accumulator-last*) value))
>
>  (defun accumulator-get-value ()
>    (cdr *accumulator*))
>
>  (json:bind-custom-vars
>      (:beginning-of-object #'init-accumulator
>       :object-key #'collect-key
>       :object-value #'collect-value
>       :end-of-object #'accumulator-get-value
>       :object-scope '(*accumulator* *accumulator-last*))
>    (json:decode-json-from-string
>      "{\"foo\": [{\"bar\": \"xyzzy\"}, {\"baz\": true}],
>        \"quux\": 123}"))
>
>  => (("foo" (("bar" . "xyzzy")) (("baz" . T))) ("quux" . 123))


Thanks for an example of a custom accumulator modification.  Just out of
curiosity, have you seen the accumulator paradigm crop up in other contexts?

>
>
>  [...] Unless I am missing something, could this functionality be added?
>>
>
>
> No problem, but could you maybe provide a sample of phantasy code which
> showed how this kind of customization interface should look from the user's
> side?  With that, we'll be more able to meet your expectations.  (I cannot,
> of course, guarantee that your interface shall be reproduced 100% exactly,
> rather it'll serve as a guideline.)


It would be nice to have something like:

(let ((json:*json-symbolize-lisp-key* 'identity))
  ...)

This is still a little confusing unless you are familiar with the
*json-identifier-name-to-lisp* variable, in which case it makes a little
more sense.


>
>
> Yours,
>  - B. Smilga.
>
>

-Red


patch:
diff -rN old-cl-json/src/common.lisp new-cl-json/src/common.lisp
94a95,98
>
> (defvar *json-symbolize-lisp-key* 'json-intern
>   "Designator for a function which, during decoding, maps the
*json-identifier-name-to-lisp*
> -transformed key to the value it will have in the result object.")
\ No newline at end of file
diff -rN old-cl-json/src/decoder.lisp new-cl-json/src/decoder.lisp
474c474
<   (let ((key (json-intern (funcall *json-identifier-name-to-lisp* key))))
---
>   (let ((key (funcall *json-identifier-name-to-lisp* key)))
604,605c604,605
<              (string (json-intern
<                       (funcall *json-identifier-name-to-lisp* value)))
---
>              (string (funcall *json-symbolize-lisp-key*
>                   (funcall *json-identifier-name-to-lisp* value)))
609c609
<               collect (cons (json-intern key) value))))
---
>               collect (cons (funcall *json-symbolize-lisp-key* key)
value))))
diff -rN old-cl-json/src/package.lisp new-cl-json/src/package.lisp
16a17
>    #:*json-symbolize-lisp-key*
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <https://mailman.common-lisp.net/pipermail/cl-json-devel/attachments/20090625/5fda8e64/attachment.html>
-------------- next part --------------
A non-text attachment was scrubbed...
Name: cl-json-keycust-patch
Type: application/octet-stream
Size: 1039 bytes
Desc: not available
URL: <https://mailman.common-lisp.net/pipermail/cl-json-devel/attachments/20090625/5fda8e64/attachment.obj>