Sat May 2 04:47:50 MSD 2009 Boris Smilga * Added section on CLOS decoder security to documentation. Sat May 2 04:49:41 MSD 2009 Boris Smilga * Optimized string decoding. 1) Through the use of string-stream accumulators. 2) By compiling escape char lookup as a CASE construction. Sat May 2 04:50:14 MSD 2009 Boris Smilga * Corrected compilation safeguards for SBCL in the JSON-NUMBER test. New patches: [Added section on CLOS decoder security to documentation. Boris Smilga **20090502004750] { hunk ./doc/cl-json.html 71 .example .output { margin-bottom:.25em; margin-top:0; font-family:monospace; font-size:smaller; color:#810 } + .example .cont { position:absolute; right:10%; color:#108 } .example .comment { position:absolute; left:50%; color:#888 } .rationale { font-size:smaller } hunk ./doc/cl-json.html 109
  1. The default encoder / decoder
  2. The CLOS decoder -
    3. + +
  3. Customizing the decoder
  4. Customizing the encoder
  5. Camel case translation
    6. hunk ./doc/cl-json.html 697

    -Run body in a dynamic environment where *class-registry* is a temporary local list. If :inherit is non-null, the local registry shall initially have the same content as the exterior *class-registry*, otherwise it shall be nil. +Run body in a dynamic environment where *class-registry* is a temporary local list. If :inherit is non-null, the local registry shall initially have the same content as the exterior *class-registry*, otherwise it shall be nil.

    hunk ./doc/cl-json.html 701 +

    Security considerations

    + +

    Make-object also allows to implement security restrictions in an environment where uncontrolled class instantiation may have undesirable side effects. Ordinarily, nothing prevents the CLOS decoder from processing an incoming datum like

    + +
    {"prototype": {"lispPackage": "worldDestruction",
+               "lispClass": "tickingBomb"},
+ "timeout": 10,
+ "setOffImmediatelyOnInstantiation": true}
    + +

    If a careless and/or malevolent remote party manages to sneak in such a request the calamitous results will not be late in coming. However, as the decoding of every input Object eventually involves a call to make-object, a safeguard may take the form simply of a method of that generic function:

    + +
    +
    +(define-condition json-security-violation (error)
+  ((bindings :reader json-security-violation-bindings :initarg :bindings)
+   (class :reader json-security-violation-class :initarg :class))
+  (:report
+   (lambda (sv stream)
+     (with-slots (bindings class) sv
+       (format stream "Incoming JSON Object ~S in the class ~S ~
+                       violates security restrictions."
+               (json:encode-json-to-string bindings)
+               class)))))
+
    +
    JSON-SECURITY-VIOLATION
    + +
    +(defmethod json:make-object :before
+    (bindings (class (eql world-destruction:ticking-bomb))
+     &optional superclasses)
+  (error 'json-security-violation :bindings bindings :class class))
+
    +
    #<STANDARD-METHOD JSON:MAKE-OBJECT …
+        :BEFORE (T (EQL WORLD-DESTRUCTION:TICKING-BOMB))>
    + +
    +(json:with-decoder-simple-clos-semantics 
+  (json:decode-json-from-string
+    "{\"prototype\": {\"lispPackage\": \"worldDestruction\",
+                      \"lispClass\": \"tickingBomb\"},
+      \"timeout\": 10,
+      \"setOffImmediatelyOnInstantiation\": true}"))
+
    +
    Error in JSON:MAKE-OBJECT: Incoming JSON Object …
+        "{\"timeout\":10,\"setOffImmediatelyOnInstantiation\":true}" …
+        in the class WORLD-DESTRUCTION:TICKING-BOMB …
+        violates security restrictions.
    +
    + +

    By using multiple methods with carefully adjusted specializers and qualifiers the user shall be able to create arbitrarily sophisticated security policies.

    + +

    Customizing the decoder

    More arbitrary changes to decoder semantics can be made via the customization API. It is an event-driven API not unlike SAX: certain variables can be set (or dynamically bound) to handler functions which are invoked, in sequence, as the parser encounters various syntactic elements of JSON on the input stream. JSON well-formedness is checked by the underlying parser, while the handlers are free to dispose of the (known clean) data in any way the user may find fit.

    hunk ./doc/cl-json.html 977 
    COUNT
    -(defun format-with-indent (control &rest args)
-  (format t "~&~0,1,V,V@A~?" level #\Tab "" control args))
+(defun format-with-indent (control &rest args)
+  (format t "~&~0,1,V,V@A~?" level #\Tab "" control args))
 
    FORMAT-WITH-INDENT
    hunk ./doc/cl-json.html 1147 
    -(defmacro simple-json-bind ((&rest vars) stream &body body)
+(defmacro simple-json-bind ((&rest vars) stream &body body)
   (let ((cur-dec (gensym))
         (key-handler
          `(lambda (json-string)
hunk ./doc/cl-json.html 1234
 
   
    
 
    
-Open a JSON Array, run body, then close the Array.  Inside the body, as-array-member or encode-array-member should be called to encode Members of the Array.
+Open a JSON Array, run body, then close the Array.  Inside the body, as-array-member or encode-array-member should be called to encode Members of the Array.
    hunk ./doc/cl-json.html 1247

    -Body should be a program which encodes exactly one JSON datum to stream. As-array-member ensures that the datum is properly formatted as a Member of an Array, i. e. separated by comma from any preceding or following Member. +Body should be a program which encodes exactly one JSON datum to stream. As-array-member ensures that the datum is properly formatted as a Member of an Array, i. e. separated by comma from any preceding or following Member.

    hunk ./doc/cl-json.html 1293

    -Open a JSON Object, run body, then close the Object. Inside the body, as-object-member or encode-object-member should be called to encode Members of the Object. +Open a JSON Object, run body, then close the Object. Inside the body, as-object-member or encode-object-member should be called to encode Members of the Object.

    hunk ./doc/cl-json.html 1306

    -Body should be a program which writes exactly one JSON datum to stream. As-object-member ensures that the datum is properly formatted as a Member of an Object, i. e. preceded by the (encoded) key and colon, and separated by comma from any preceding or following Member. +Body should be a program which writes exactly one JSON datum to stream. As-object-member ensures that the datum is properly formatted as a Member of an Object, i. e. preceded by the (encoded) key and colon, and separated by comma from any preceding or following Member.

    hunk ./doc/cl-json.html 1490

    Likewise, the underlying Lisp system can fail to handle floats which are not representable in the current *read-default-float-format* (e. g. 2.065e444 is non-representable even in the long-float format in most contemporary Lisps). If such a datum is encountered in JSON input, an arithmetic-error is signalled. CL-JSON provides three restarts to correct such cases:

    -
    bignumber-string &optional prefix
    +
    bignumber-string &optional prefix
    Instead of number, use a string which is the concatenation of prefix and the number token that caused the error. The default value for prefix is "BIGNUMBER:".
    rational-approximation
    Parse the number token into parts, read them as integers, and combine the integers using only rational operations. Use the resulting rational number in place of float. (E. g., 2.065e444 would be converted to the value of the expression (* (+ 2 (* 65 (expt 10 -3))) (expt 10 444)).)
    hunk ./doc/cl-json.html 1567 
    Armadillos have 28 teeth.
    Marsupial moles have 22 teeth in the lower jaw.
    Marsupial moles have as many lower incisors as dugongs.
    +
    NIL
    } [Optimized string decoding. Boris Smilga **20090502004941 1) Through the use of string-stream accumulators. 2) By compiling escape char lookup as a CASE construction. ] { hunk ./src/decoder.lisp 133 is encountered which is greater than the application's CHAR-CODE-LIMIT or for which CODE-CHAR returns NIL.")) +(defmacro escaped-char-dispatch (char &key code-handler default-handler) + "Compiles the escaped character alist to a (CASE ...) match expression." + `(case ,char + ,@(loop for (c . unescaped) in +json-lisp-escaped-chars+ + if (characterp unescaped) + collect (list c unescaped) + else if (consp unescaped) + collect + (destructuring-bind ((len rdx) &body body) code-handler + (destructuring-bind (len-v . rdx-v) unescaped + `(,c (let ((,len ,len-v) (,rdx ,rdx-v)) ,@body))))) + (t ,default-handler))) + (defun read-json-string-char (stream) "Read a JSON String char (or escape sequence) from the STREAM and return it. If an end of string (unescaped quote) is encountered, hunk ./src/decoder.lisp 155 (case c (#\" nil) ; End of string (#\\ (let ((c (read-char stream))) - (let ((unescaped (cdr (assoc c +json-lisp-escaped-chars+)))) - (typecase unescaped - (character unescaped) - (cons - (destructuring-bind (len . rdx) unescaped - (let ((code - (let ((repr (make-string len))) - (dotimes (i len) - (setf (aref repr i) (read-char stream))) - (handler-case (parse-integer repr :radix rdx) - (parse-error () - (json-syntax-error stream esc-error-fmt - (format nil "\\~C" c) - repr)))))) - (restart-case - (or (and (< code char-code-limit) - (code-char code)) - (error 'no-char-for-code :code code)) - (substitute-char (char) - :report "Substitute another char." - :interactive - (lambda () - (format *query-io* "Char: ") - (list (read-char *query-io*))) - char) - (pass-code () - :report "Pass the code to char handler." - code))))) - (t (if *use-strict-json-rules* - (json-syntax-error stream esc-error-fmt "\\" c) - c)))))) + (escaped-char-dispatch c + :code-handler + ((len rdx) + (let ((code + (let ((repr (make-string len))) + (dotimes (i len) + (setf (aref repr i) (read-char stream))) + (handler-case (parse-integer repr :radix rdx) + (parse-error () + (json-syntax-error stream esc-error-fmt + (format nil "\\~C" c) + repr)))))) + (restart-case + (or (and (< code char-code-limit) (code-char code)) + (error 'no-char-for-code :code code)) + (substitute-char (char) + :report "Substitute another char." + :interactive + (lambda () + (format *query-io* "Char: ") + (list (read-char *query-io*))) + char) + (pass-code () + :report "Pass the code to char handler." + code)))) + :default-handler + (if *use-strict-json-rules* + (json-syntax-error stream esc-error-fmt "\\" c) + c)))) (t c)))) hunk ./src/decoder.lisp 498 list." (cdr *accumulator*)) -#| Invalidated. - -(defun init-vector-accumulator () - "Initialize a vector accumulator." - (setq *accumulator* - (make-array 32 :adjustable t :fill-pointer 0))) +(defun init-string-stream-accumulator () + "Initialize a string-stream accumulator." + (setq *accumulator* (make-string-output-stream))) hunk ./src/decoder.lisp 502 -(defun vector-accumulator-add (element) - "Add ELEMENT to the end of the vector accumulator." - (vector-push-extend element *accumulator* (fill-pointer *accumulator*)) +(defun string-stream-accumulator-add (char) + "Add CHAR to the end of the string-stream accumulator." + (write-char char *accumulator*) *accumulator*) hunk ./src/decoder.lisp 507 -(defun vector-accumulator-get-sequence () - "Return all values accumulated so far in a vector accumulator as -*JSON-ARRAY-TYPE*." - (coerce *accumulator* *json-array-type*)) - -(defun vector-accumulator-get-string () - "Return all values accumulated so far in a vector accumulator as a -string." - (coerce *accumulator* 'string)) - -|# +(defun string-stream-accumulator-get () + "Return all characters accumulated so far in a string-stream +accumulator and close the stream." + (prog1 (get-output-stream-string *accumulator*) + (close *accumulator*))) (defun set-decoder-simple-list-semantics () "Set the decoder semantics to the following: hunk ./src/decoder.lisp 533 :object-key #'accumulator-add-key :object-value #'accumulator-add-value :end-of-object #'accumulator-get - :beginning-of-string #'init-accumulator - :string-char #'accumulator-add - :end-of-string #'accumulator-get-string + :beginning-of-string #'init-string-stream-accumulator + :string-char #'string-stream-accumulator-add + :end-of-string #'string-stream-accumulator-get :aggregate-scope (union *aggregate-scope-variables* '(*accumulator* *accumulator-last*)) :internal-decoder #'decode-json)) hunk ./src/decoder.lisp 655 :object-key #'accumulator-add-key-or-set-prototype :object-value #'accumulator-add-value-or-set-prototype :end-of-object #'accumulator-get-object - :beginning-of-string #'init-accumulator - :string-char #'accumulator-add - :end-of-string #'accumulator-get-string + :beginning-of-string #'init-string-stream-accumulator + :string-char #'string-stream-accumulator-add + :end-of-string #'string-stream-accumulator-get :aggregate-scope (union *aggregate-scope-variables* '(*accumulator* *accumulator-last*)) :object-scope (union *object-scope-variables* } [Corrected compilation safeguards for SBCL in the JSON-NUMBER test. Boris Smilga **20090502005014] { hunk ./t/testdecoder.lisp 211 (is (= (decode-json-from-string "3e4") 3e4)) (let ((*read-default-float-format* 'double-float)) (is (= (decode-json-from-string "2e40") 2d40))) - #-(or older-sbcl cmu) + #-(and sbcl darwin) (is (equalp (with-fp-overflow-handler (invoke-restart 'bignumber-string "BIG:") (decode-json-from-string "2e444")) hunk ./t/testdecoder.lisp 216 "BIG:2e444")) - #-(or older-sbcl cmu) + #-(and sbcl darwin) (is (= (with-fp-overflow-handler (invoke-restart 'rational-approximation) (decode-json-from-string "2e444")) hunk ./t/testdecoder.lisp 221 (* 2 (expt 10 444)))) - ;; In some older versions of SBCL, - ;; constructing the float from parts by explicit operations - ;; yields #.SB-EXT:SINGLE-FLOAT-POSITIVE-INFINITY. - #+(or older-sbcl cmu) + ;; In SBCL on Darwin, constructing the float from parts by explicit + ;; operations yields #.SB-EXT:SINGLE-FLOAT-POSITIVE-INFINITY. + #+(and sbcl darwin) (is (= (decode-json-from-string "2e444") (* 2.0 (expt 10.0 444))))) } Context: [test json-number remove sbcl special case Henrik Hjelte **20090427193326 Ignore-this: c8e57b25ba18170804d15ce174dde08d Now it works on sbcl 1.0.27.9 ] [Discarded vector accumulators in favour of list accumulators. Boris Smilga **20090420000832 The former do not improve performance as I was hoping, if anything, they harm it. ] [TAG 0.4-bundle Henrik Hjelte **20090414092417 Ignore-this: f9a65f0d3c8666061c8de4ed5c153b6e ] [Added new documentation in doc/cl-json.html. Boris Smilga **20090406003011] [Edited docstrings and changed some names to make for a more reasonable documentation. Boris Smilga **20090321213714] [Fixes for bugs detected by testing in CMUCL and ECL. Boris Smilga **20090313194905] [Workaround for the Clozure idiosyncrasy that the patch Thu Feb 26 15:22:25 MSK 2009 Henrik Hjelte used to solve. Boris Smilga **20090313194131] [Resolved conflict with patch Thu Feb 26 15:22:25 MSK 2009 Henrik Hjelte . Boris Smilga **20090313172519] [Removed symboltojs.lisp, as the functionality of SYMBOL-TO-JS is subsumed by LISP-TO-CAMEL-CASE. Fixed conflicts which the patches of Dec. 8, 2008 were causing with more recent ones. Boris Smilga **20090223203232] [Improvements and clarifications of code in light of the new documentation. Boris Smilga **20090223193516 * Improved error handling: several ostensibly exceptional situations which were previously handled inconsistently (or not handled at all) are now reified as condition types and restarts, among them new ones: UNENCODABLE-VALUE-ERROR, SUBSTITUTE-PRINTED-REPRESENTATION, BIGNUMBER-STRING, RATIONAL-APPROXIMATION, PLACEHOLDER. * Added function DECODE-JSON-FROM-SOURCE. * Encoding and decoding operations shall henceforth have their own default streams, *JSON-OUTPUT* and *JSON-INPUT*. * It is now permissible to use strings as prototypes. (String prototype is interpreted as the name of the class, interned in the current *JSON-SYMBOLS-PACKAGE*.) * Fixed some bugs (and sources of compiler warnings). * Fixed some documentation strings, argument naming and passing conventions, and return values. * Fixed some copyright notices. * Improved implementation of JSON-BIND. * Put CLOS semantics under conditional compilation guards. * Advanced the version number to 0.4.0. ] [Updated tests to go with the recent modifications (customizable decoder / encoder etc.) Boris Smilga **20090124221835] [Fixed bugs introduced by recent additions and detected by our tests. Boris Smilga **20090124181936] [Restored handling of floats which are too big to be read. Boris Smilga **20090124181930 The new implementation replaces fall-back function handler with restarts (returning prefixed string, rational approximation, or user-supplied placeholder) which seems more proper in this context. ] [Modified the way objects are decoded to CLOS objects in the absence of prototypes. Boris Smilga **20090122113959 Originally, an anonymous singleton class was created for each unprototyped object received by the decoder. It turned out that this approach can lead to strong degradation of performance. E. g., OpenMCL employs an optimization technique which includes caching methods of generic function based on the classes of their arguments. If classes proliferate beyond measure, the effect of caching is the opposite of intended. The new approach is to keep a table of classes (mapping from lists of classes such as prototyped lispSuperclasses to anonymous fluid classes). For every received unprototyped object we either create a new entry or, if a class with exactly the same list of superclasses is already in the table, update it to include the new slots. Anyway, a typical remote party (such as a web app) can be expected to have only a few different object configurations. The code is now much cleaner and includes a rounded-up interface to fluid classes. A lot of docstrings has been added as well. ] [Made *JSON-ARRAY-TYPE* a custom variable and assigned specific values for the two simple semantics. Boris Smilga **20090122102158] [Updated export list of the package JSON. Boris Smilga **20090122091309] [Re-implemented JSON-BIND (to illustrate dynamic customization). Boris Smilga **20090121174922] [Various modifications, mostly concerning the encoder. Boris Smilga **20090121153449 * No prototype shall henceforth be output by the encoder. The prototype won't be interesting for a remote party in most cases. If it is, the local party is free to provide explicit prototype slots in its objects. * Added lots of docstrings. * Fixed bug: escaped string char was not being printed after backslash. ] [Various modifications, mostly concerning the decoder. Boris Smilga **20090121145627 * Added function PEEK-JSON-TOKEN and rewrote DECODE-JSON-ARRAY to eliminate abstraction leak (token and category as arguments to *INTERNAL-DECODER* functions). * Added macros BIND-CUSTOM-VARS, CUSTOM-DECODER, CURRENT-DECODER, WITH-CUSTOM-DECODER-LEVEL. * Modularized structure-scope variable lists into object-, array-, string- and common aggregate-scope lists. * Added lots of docstrings. * Fixed (potential) bugs: internal decoder was not being set by semantics setters; array type was not being set to LIST in the prototype decoder. ] [Added customization parameter *INTERNAL-DECODER*. Boris Smilga **20081212211209 This makes for a more intuitive way of controlling the decoding of nested structures. ] [Fixed: adding prototype to designated slot had been left out of the customized decoder. Boris Smilga **20081207184042] [Various modifications, mostly concerning the encoder. Boris Smilga **20081207180809 * Case translation (in both directions) shall be customizable using the variables *JSON-IDENTIFIER-NAME-TO-LISP* and *LISP-IDENTIFIER-NAME-TO-JSON*. * Boolean encoder shall use the same parameter as the corresponding decoder (+JSON-LISP-SYMBOL-TOKENS+). * String character encoder shall use for the unicode escape sequence (\uXXXX) the spec in the parameter +JSON-LISP-ESCAPED-CHARS+, just as it is done by the corresponding decoder. The spec shall contain the width and radix of the coding sequence. * The STREAM argument to ENCODE-JSON shall be optional, defaulting to *STANDARD-OUTPUT* (symmetrically to DECODE-JSON). * [NB] Encoding has been completely re-implemented using the streaming API from YASON. * Plists shall have "lispClass":"list" in the prototype. * Fixed bug in JSON-INTERN: INTERN could be fallaciously passed NIL as its PACKAGE argument. ] [Moved the customizable decoder (special-vars flavour) over to the main branch. Boris Smilga **20081204190202] [Added copyright notices and LICENSE. Boris Smilga **20081204184800] [Moved conversion between Lisp and camel case to separate file. Boris Smilga **20081203150914] [TAG Pre-0.4-bundle Henrik Hjelte **20090414085958 Ignore-this: 91e69af5b92fef3c3298463937b9fb72 ] Patch bundle hash: fecdd6576933e2e180b0375b785c2c2dcf9cda0f