[cl-json-devel] Not interning object keys

Henrik Hjelte henrik at evahjelte.com
Mon Aug 10 13:51:05 UTC 2009


On Tue, Jun 30, 2009 at 5:41 PM, Red Daly<reddaly at gmail.com> wrote:
> On Fri, Jun 26, 2009 at 3:20 PM, Boris Smilga <boris.smilga at gmail.com>
> wrote:
>>
>> Just a minor cavil: does not *STRING-TO-KEY* (or maybe
>> *IDENTIFIER-NAME-TO-KEY*) seem like a better name for this variable?
>
> I would prefer *IDENTIFIER-NAME-TO-KEY* since it gives more context about
> what the function is used for.  *STRING-TO-KEY* is confusing since it's
> unclear where the "string" is coming from.

I have now applied this (with one slight difference) and added a
testcase. Also I have made a function safe-json-intern
that I think should be safe from attacks. I pasted the testcases below.

Thanks!
-Henrik

(test custom-identifier-name-to-key
  "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. See the
safe-symbols-parsing function here for a cure."
  (with-decoder-simple-list-semantics
      (flet ((safe-symbols-parsing (name)
               (or (find-symbol name *json-symbols-package*)
                   (error "unknown symbols not allowed"))))
        (let ((good-symbols "{\"car\":1,\"cdr\":2}")
              (bad-symbols "{\"could-be\":1,\"a-denial-of-service-attack\":2}")
              (*json-symbols-package* (find-package :cl))
              (*identifier-name-to-key* #'safe-symbols-parsing))
          (is (equal '((car . 1) (cdr . 2))
                     (decode-json-from-string good-symbols)))
          (signals error (decode-json-from-string bad-symbols))))))

(test safe-json-intern
  (with-decoder-simple-list-semantics
      (let ((good-symbols "{\"car\":1,\"cdr\":2}")
            (bad-symbols "{\"could-be\":1,\"a-denial-of-service-attack\":2}")
            (*json-symbols-package* (find-package :cl))
            (*identifier-name-to-key* #'safe-json-intern))
        (is (equal '((car . 1) (cdr . 2))
                   (decode-json-from-string good-symbols)))
        (signals unknown-symbol-error (decode-json-from-string bad-symbols)))))




More information about the cl-json-devel mailing list