Author: hhubner Date: 2006-12-03 05:46:55 -0500 (Sun, 03 Dec 2006) New Revision: 2097 Modified: trunk/bknr/src/data/txn.lisp trunk/bknr/src/utils/acl-mp-compat.lisp trunk/bknr/src/utils/utils.lisp trunk/bknr/src/web/authorizer.lisp trunk/bknr/src/web/handlers.lisp trunk/bknr/src/web/sessions.lisp trunk/bknr/src/web/web-utils.lisp Log: Changes to make file uploads from forms work again. Small SBCL compatibility changes. Further change to properly generate UTF-8 on cmucl. This is really becoming too sick to be bearable. Modified: trunk/bknr/src/data/txn.lisp =================================================================== --- trunk/bknr/src/data/txn.lisp 2006-12-03 08:33:51 UTC (rev 2096) +++ trunk/bknr/src/data/txn.lisp 2006-12-03 10:46:55 UTC (rev 2097) @@ -42,13 +42,13 @@ (defclass mp-store (store) () (:default-initargs :guard (let ((lock (make-process-lock))) - #'(lambda (thunk) - (with-process-lock (lock) - (funcall thunk)))) + (lambda (thunk) + (mp-with-lock-held (lock) + (funcall thunk)))) :log-guard (let ((lock (make-process-lock))) - #'(lambda (thunk) - (with-process-lock (lock) - (funcall thunk))))) + (lambda (thunk) + (mp-with-lock-held (lock) + (funcall thunk))))) (:documentation "Store in which every transaction and operation is protected by a giant lock.")) Modified: trunk/bknr/src/utils/acl-mp-compat.lisp =================================================================== --- trunk/bknr/src/utils/acl-mp-compat.lisp 2006-12-03 08:33:51 UTC (rev 2096) +++ trunk/bknr/src/utils/acl-mp-compat.lisp 2006-12-03 10:46:55 UTC (rev 2097) @@ -1,6 +1,6 @@ (in-package :bknr.utils) -(defun mp-make-lock (name) +(defun mp-make-lock (&optional (name "Anonymous")) #+allegro (mp:make-process-lock :name name) #+sbcl Modified: trunk/bknr/src/utils/utils.lisp =================================================================== --- trunk/bknr/src/utils/utils.lisp 2006-12-03 08:33:51 UTC (rev 2096) +++ trunk/bknr/src/utils/utils.lisp 2006-12-03 10:46:55 UTC (rev 2097) @@ -364,7 +364,7 @@ (defun md5-string (input-string) (apply #'concatenate 'string (mapcar #'(lambda (c) (format nil "~2,'0X" c)) - (coerce (md5sum-sequence input-string) 'list)))) + (coerce (#+cmu md5sum-sequence #+sbcl md5sum-string input-string) 'list)))) #+(or) (defun md5-string (string) Modified: trunk/bknr/src/web/authorizer.lisp =================================================================== --- trunk/bknr/src/web/authorizer.lisp 2006-12-03 08:33:51 UTC (rev 2096) +++ trunk/bknr/src/web/authorizer.lisp 2006-12-03 10:46:55 UTC (rev 2097) @@ -71,7 +71,6 @@ (defmethod authorize ((authorizer bknr-authorizer) (req http-request) ent) - ;; Catch any errors that occur during request body processing (handler-case ;; first check session cookie or bknr-sessionid parameter. the Modified: trunk/bknr/src/web/handlers.lisp =================================================================== --- trunk/bknr/src/web/handlers.lisp 2006-12-03 08:33:51 UTC (rev 2096) +++ trunk/bknr/src/web/handlers.lisp 2006-12-03 10:46:55 UTC (rev 2097) @@ -465,8 +465,8 @@ (defgeneric object-list-handler-show-object-xml (handler object req)) (defmethod object-list-handler-show-object-xml ((handler xml-object-list-handler) object req) - (write-to-xml object - :string-rod-fn #'cxml::utf8-string-to-rod)) + (set-string-rod-fn #'cxml::utf8-string-to-rod) + (write-to-xml object)) (defmethod handle-object ((handler xml-object-list-handler) object req) (let ((element-name (xml-object-list-handler-toplevel-element-name handler))) Modified: trunk/bknr/src/web/sessions.lisp =================================================================== --- trunk/bknr/src/web/sessions.lisp 2006-12-03 08:33:51 UTC (rev 2096) +++ trunk/bknr/src/web/sessions.lisp 2006-12-03 10:46:55 UTC (rev 2097) @@ -166,6 +166,13 @@ (defmethod update-instance-for-different-class :before ((old http-request) (new bknr-request) &key session) + ;; Clear parsed parameters in request. During + ;; authorization, parameters are not completely parsed in + ;; order to save time. In particular, uploaded files are + ;; only parsed after authorization. This is accomplished by + ;; clearing the cache for the parsed parameters here. + (setf (getf (request-reply-plist old) 'bknr-parsed-parameters) nil) + (setf (getf (request-reply-plist old) 'bknr-parsed-body-parameters) nil) (setf (slot-value new 'session) session)) (defmethod bknr-request-user ((req bknr-request)) Modified: trunk/bknr/src/web/web-utils.lisp =================================================================== --- trunk/bknr/src/web/web-utils.lisp 2006-12-03 08:33:51 UTC (rev 2096) +++ trunk/bknr/src/web/web-utils.lisp 2006-12-03 10:46:55 UTC (rev 2097) @@ -117,8 +117,9 @@ "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)))) + (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)))))