Revision: 3785 Author: hans URL: http://bknr.net/trac/changeset/3785
support non-standard %u notation in URL-DECODE
U trunk/thirdparty/hunchentoot/util.lisp
Modified: trunk/thirdparty/hunchentoot/util.lisp =================================================================== --- trunk/thirdparty/hunchentoot/util.lisp 2008-09-03 16:50:27 UTC (rev 3784) +++ trunk/thirdparty/hunchentoot/util.lisp 2008-09-04 09:24:47 UTC (rev 3785) @@ -229,32 +229,57 @@ ((#") (write-string "\"" out)) (otherwise (write-char char out)))))))
+(defmacro upgrade-vector (vector new-type &key converter (new-length `(array-total-size ,vector))) + `(setf ,vector (loop + with new-vector = (make-array ,new-length + :element-type ,new-type + :fill-pointer (length vector)) + for i from 0 below (length ,vector) + do (setf (aref new-vector i) ,(if converter + `(funcall ,converter (aref ,vector i)) + `(aref ,vector i))) + finally (return new-vector)))) + (defun url-decode (string &optional (external-format *hunchentoot-default-external-format*)) "Decodes a URL-encoded STRING which is assumed to be encoded using the external format EXTERNAL-FORMAT." - (let ((vector (make-array (length string) - :element-type 'octet - :fill-pointer 0))) - (loop with percent-p and buff - for char of-type character across string - for i from 0 - when buff do - (vector-push (parse-integer string - :start (1- i) - :end (1+ i) - :radix 16) - vector) - (setq buff nil) - else when percent-p - do (setq buff t - percent-p nil) - else when (char= char #%) - do (setq percent-p t) - else do (vector-push (char-code (case char - ((#+) #\Space) - (otherwise char))) - vector)) - (octets-to-string vector :external-format external-format))) + (loop + with vector = (make-array (length string) :element-type 'octet :fill-pointer 0) + with i = 0 + with unicode + for char = (aref string i) + do (labels ((decode-hex (length) + (prog1 + (parse-integer string :start i :end (+ i length) :radix 16) + (incf i length))) + (push-integer (integer) + (vector-push integer vector)) + (peek () + (aref string i)) + (advance () + (setf char (peek)) + (incf i))) + (cond + ((char= #% char) + (advance) + (cond + ((char= #\u (peek)) + (unless unicode + (setf unicode t) + (upgrade-vector vector '(integer 0 65535))) + (advance) + (push-integer (decode-hex 4))) + (t + (push-integer (decode-hex 2))))) + (t + (push-integer (char-code (case char + ((#+) #\Space) + (otherwise char)))) + (advance)))) + while (< i (length string)) + finally (return (if unicode + (upgrade-vector vector 'character :converter #'code-char) + (octets-to-string vector :external-format external-format)))))
(defun form-url-encoded-list-to-alist (form-url-encoded-list &optional (external-format *hunchentoot-default-external-format*))