Author: hhubner Date: 2006-10-22 12:45:33 -0400 (Sun, 22 Oct 2006) New Revision: 2027
Modified: branches/xml-class-rework/bknr/src/bknr.asd branches/xml-class-rework/bknr/src/web/tags.lisp branches/xml-class-rework/bknr/src/web/web-utils.lisp Log: Convert incoming paramter values to utf-8. Do not create base href tag in generated html
Modified: branches/xml-class-rework/bknr/src/bknr.asd =================================================================== --- branches/xml-class-rework/bknr/src/bknr.asd 2006-10-22 16:43:35 UTC (rev 2026) +++ branches/xml-class-rework/bknr/src/bknr.asd 2006-10-22 16:45:33 UTC (rev 2027) @@ -35,6 +35,7 @@ :bknr-datastore :bknr-data-impex :kmrcl + :iconv #+(not allegro) :acl-compat)
Modified: branches/xml-class-rework/bknr/src/web/tags.lisp =================================================================== --- branches/xml-class-rework/bknr/src/web/tags.lisp 2006-10-22 16:43:35 UTC (rev 2026) +++ branches/xml-class-rework/bknr/src/web/tags.lisp 2006-10-22 16:45:33 UTC (rev 2027) @@ -183,7 +183,7 @@ <link rel="stylesheet" href="/static/css/dynastyle_01.css" .... " (html - ((:base :href (website-base-href *website*))) + #+(or) ((:base :href (website-base-href *website*))) (loop for stylesheet in (website-style-sheet-urls *website*) do (html ((:link :rel "stylesheet" :type "text/css" :href stylesheet)))) (loop for javascript in (website-javascript-urls *website*)
Modified: branches/xml-class-rework/bknr/src/web/web-utils.lisp =================================================================== --- branches/xml-class-rework/bknr/src/web/web-utils.lisp 2006-10-22 16:43:35 UTC (rev 2026) +++ branches/xml-class-rework/bknr/src/web/web-utils.lisp 2006-10-22 16:45:33 UTC (rev 2027) @@ -60,12 +60,12 @@ (get-all-multipart-data request :limit *upload-file-size-limit*))))) (when file-size-limit-reached (error "upload file size limit exceeded")) - (setf (getf (request-reply-plist request) 'bknr-parsed-parameters) parameters) + (setf (getf (request-reply-plist request) 'bknr-parsed-body-parameters) parameters) (setf (getf (request-reply-plist request) 'uploaded-files) uploaded-files))))
(defun get-urlencoded-form-data (request) (loop for name-value in (form-urlencoded-to-query (get-request-body request)) - do (push name-value (getf (request-reply-plist request) 'bknr-parsed-parameters)))) + do (push name-value (getf (request-reply-plist request) 'bknr-parsed-body-parameters))))
(defun parse-request-body (request &key uploads) (let ((content-type (header-slot-value request :content-type))) @@ -89,7 +89,7 @@
(defmethod get-parameters-from-body ((request bknr-request)) (unless (getf (request-reply-plist request) 'body-parsed) - (setf (getf (request-reply-plist request) 'bknr-parsed-parameters) nil) + (setf (getf (request-reply-plist request) 'bknr-parsed-body-parameters) nil) (parse-request-body request :uploads t) (setf (getf (request-reply-plist request) 'body-parsed) t)))
@@ -112,10 +112,17 @@ body is present in the request, any uploaded files are saved in a temporary file and noted in the request's plist. Uploaded files will be automatically deleted by the with-bknr-http-response macro after the request body has been executed." - (get-parameters-from-body request) - (remove "" (append (form-urlencoded-to-query (uri-query (request-uri request))) - (getf (request-reply-plist request) 'bknr-parsed-parameters)) - :key #'cdr :test #'string-equal)) + (unless (getf (request-reply-plist request) 'bknr-parsed-parameters) + (let ((request-charset (or (register-groups-bind (charset) (#?r".*charset="?([^"; ]+).*" (header-slot-value request :content-type)) charset) + "utf-8"))) + (get-parameters-from-body request) + (setf (getf (request-reply-plist request) 'bknr-parsed-parameters) + (mapcar (lambda (param) (cons (car param) + (iconv:iconv request-charset "utf-8" (cdr param)))) + (remove "" (append (form-urlencoded-to-query (uri-query (request-uri request))) + (getf (request-reply-plist request) 'bknr-parsed-body-parameters)) + :key #'cdr :test #'string-equal))))) + (getf (request-reply-plist request) 'bknr-parsed-parameters))
(defun query-param (request param-name) (let ((value (cdr (assoc param-name (all-request-params request) :test #'string-equal))))