[bknr-cvs] r2097 - in trunk/bknr/src: data utils web

[bknr at bknr.net]

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