[bknr-cvs] hans changed trunk/thirdparty/hunchentoot/util.lisp

[BKNR Commits]

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*))