Hi,

"Leslie P. Polzer" <[email protected]> writes:

> Some changes that need to be made:
>
>   * you forgot to export *default-restart*
>
>   * the documentation for *default-restart* should be a docstring
> instead of a code comment
>
>   * I think we still need *catch-errors-p* to be able to pass on
> handling of a signal outside of the Weblocks handler (for example in
> the test case `allow-restart-in-sessinit')
>
>   * the indentation level in handle-client-request is too much now,
> and the PROGN is pretty ugly. Let's separate it into two functions.

I rewrote the patch taking into account your suggestions.

Could you please take a look at it and let me know if I should make
other changes?

Thank you very much for your help!

Andrea.

-- 
Reclama i tuoi diritti digitali, elimina il DRM.  Approfondisci su
http://www.no1984.org
Reclaim your digital rights, eliminate DRM.  Learn more at
http://www.defectivebydesign.org/what_is_drm


--~--~---------~--~----~------------~-------~--~----~
You received this message because you are subscribed to the Google Groups 
"weblocks" group.
To post to this group, send email to [email protected]
To unsubscribe from this group, send email to 
[email protected]
For more options, visit this group at 
http://groups.google.com/group/weblocks?hl=en
-~----------~----~----~----~------~----~------~--~---

# HG changeset patch
# User Andrea Russo <[email protected]>
# Date 1240268483 -7200
# Node ID 6eaafa356c0c46c04d3c2029dfa1c8de99daa29d
# Parent  f87db6efdb271c85116508fed6a7acebac0c0cec
Add some error handling in `handle-client-request'.

We can control which restart strategy to use by setting the special
variable `*restart-handler*' to appropriate values. If this variable
is set to `invoke-debugger' we enter the debugger, so we can choose
among the enstablished restarts.

diff -r f87db6efdb27 -r 6eaafa356c0c src/request-handler.lisp
--- a/src/request-handler.lisp	Sat Apr 18 03:43:05 2009 -0500
+++ b/src/request-handler.lisp	Tue Apr 21 01:01:23 2009 +0200
@@ -3,7 +3,8 @@
 
 (export '(handle-client-request
           *before-ajax-complete-scripts* *on-ajax-complete-scripts*
-	  *catch-errors-p*))
+	  *catch-errors-p* *restart-handler* invoke-debugger abort-request
+          rehandle-request show-backtrace))
 
 (defvar *before-ajax-complete-scripts*)
 (setf (documentation '*before-ajax-complete-scripts* 'variable)
@@ -20,6 +21,13 @@
 
 ;; remove this when Hunchentoot reintroduces *catch-errors-p*
 (defvar *catch-errors-p* t)
+
+(defvar *restart-handler* 'show-backtrace)
+(setf (documentation '*restart-handler* 'variable)
+      "Select which restart the request handler should choose.
+       Possible values are: abort-request, show-backtrace,
+       invoke-debugger. The default behavior is to show a backtrace
+       page to the browser.")
 
 (defgeneric handle-client-request (app)
   (:documentation
@@ -51,73 +59,87 @@
 customize behavior."))
 
 (defmethod handle-client-request :around (app)
-  (handler-bind ((error (lambda (c)
-                          (if *catch-errors-p*
-                            (return-from handle-client-request
-                                         (handle-error-condition app c))
-                            (invoke-debugger c)))))
-    (call-next-method)))
+  (let ((*current-webapp* app)
+        (error-condition))
+    (declare (special *current-webapp*))
+    (handler-bind ((error (lambda (c)
+                            (setf error-condition c)
+                            (when *catch-errors-p*
+                              (if (eql *restart-handler*
+                                       'invoke-debugger)
+                                  (invoke-debugger c)
+                                  (invoke-restart *restart-handler*))))))
+      (restart-case (call-next-method)
+        (abort-request ()
+          :report "Abort this request."
+          (return-from handle-client-request "<h1>Aborted</h1>"))
+        (rehandle-request ()
+          :report "Rehandle this request."
+          (return-from handle-client-request
+            (handle-client-request app)))
+        (show-backtrace ()
+          :report "Send a backtrace page to the browser."
+          (return-from handle-client-request
+            (handle-error-condition app error-condition)))))))
 
 (defmethod handle-client-request ((app weblocks-webapp))
-  (let ((*current-webapp* app))
-    (declare (special *current-webapp*))
-    (when (null *session*)
-      (when (get-request-action-name)
-	(expired-action-handler app))
-      (start-session)
-      (setf (webapp-session-value 'last-request-uri) :none)
-      (redirect (request-uri*)))
-    (when *maintain-last-session*
-      (bordeaux-threads:with-lock-held (*maintain-last-session*)
-	(setf *last-session* *session*)))
-    (let ((*request-hook* (make-instance 'request-hooks)))
-      (when (null (root-widget))
-	(let ((root-widget (make-instance 'widget :name "root")))
-	  (when (weblocks-webapp-debug app)
-	    (initialize-debug-actions))
-	  (setf (root-widget) root-widget)
-	  (let (finished?)
-	    (unwind-protect
-		 (progn
-		   (funcall (webapp-init-user-session) root-widget)
-		   (setf finished? t))
-	      (unless finished?
-		(setf (root-widget) nil)
-		(reset-webapp-session))))
-	  (push 'update-dialog-on-request (request-hook :session :post-action)))
-	(when (cookie-in (session-cookie-name *weblocks-server*))
-	  (redirect (remove-session-from-uri (request-uri*)))))
+  (when (null *session*)
+    (when (get-request-action-name)
+      (expired-action-handler app))
+    (start-session)
+    (setf (webapp-session-value 'last-request-uri) :none)
+    (redirect (request-uri*)))
+  (when *maintain-last-session*
+    (bordeaux-threads:with-lock-held (*maintain-last-session*)
+      (setf *last-session* *session*)))
+  (let ((*request-hook* (make-instance 'request-hooks)))
+    (when (null (root-widget))
+      (let ((root-widget (make-instance 'widget :name "root")))
+        (when (weblocks-webapp-debug app)
+          (initialize-debug-actions))
+        (setf (root-widget) root-widget)
+        (let (finished?)
+          (unwind-protect
+               (progn
+                 (funcall (webapp-init-user-session) root-widget)
+                 (setf finished? t))
+            (unless finished?
+              (setf (root-widget) nil)
+              (reset-webapp-session))))
+        (push 'update-dialog-on-request (request-hook :session :post-action)))
+      (when (cookie-in (session-cookie-name *weblocks-server*))
+        (redirect (remove-session-from-uri (request-uri*)))))
 
-      (let ((*weblocks-output-stream* (make-string-output-stream))
-	    (*uri-tokens* (make-instance 'uri-tokens :tokens (tokenize-uri (request-uri*))))
-	     *dirty-widgets*
-	    *before-ajax-complete-scripts* *on-ajax-complete-scripts*
-	    *page-dependencies* *current-page-description*
-	    (cl-who::*indent* (weblocks-webapp-html-indent-p app)))
-	(declare (special *weblocks-output-stream* *dirty-widgets*
-			  *on-ajax-complete-scripts* *uri-tokens* *page-dependencies*))
-	(when (pure-request-p)
-	  (throw 'hunchentoot::handler-done (eval-action)))
-	;; a default dynamic-action hook function wraps get operations in a transaction
-	(eval-hook :pre-action)
-	(with-dynamic-hooks (:dynamic-action)
-	  (eval-action))
-	(eval-hook :post-action)
-	(when (and (not (ajax-request-p))
-		   (find *action-string* (get-parameters*)
-			 :key #'car :test #'string-equal))
-	  (redirect (remove-action-from-uri (request-uri*))))
-	(eval-hook :pre-render)
-	(with-dynamic-hooks (:dynamic-render)
-	  (if (ajax-request-p)
+    (let ((*weblocks-output-stream* (make-string-output-stream))
+          (*uri-tokens* (make-instance 'uri-tokens :tokens (tokenize-uri (request-uri*))))
+          *dirty-widgets*
+          *before-ajax-complete-scripts* *on-ajax-complete-scripts*
+          *page-dependencies* *current-page-description*
+          (cl-who::*indent* (weblocks-webapp-html-indent-p app)))
+      (declare (special *weblocks-output-stream* *dirty-widgets*
+                        *on-ajax-complete-scripts* *uri-tokens* *page-dependencies*))
+      (when (pure-request-p)
+        (throw 'hunchentoot::handler-done (eval-action)))
+      ;; a default dynamic-action hook function wraps get operations in a transaction
+      (eval-hook :pre-action)
+      (with-dynamic-hooks (:dynamic-action)
+        (eval-action))
+      (eval-hook :post-action)
+      (when (and (not (ajax-request-p))
+                 (find *action-string* (get-parameters*)
+                       :key #'car :test #'string-equal))
+        (redirect (remove-action-from-uri (request-uri*))))
+      (eval-hook :pre-render)
+      (with-dynamic-hooks (:dynamic-render)
+        (if (ajax-request-p)
             (handle-ajax-request app)
             (handle-normal-request app)))
-        (eval-hook :post-render)
-	(unless (ajax-request-p)
-	  (setf (webapp-session-value 'last-request-uri) (all-tokens *uri-tokens*)))
-        (if (member (return-code*) *approved-return-codes*)
+      (eval-hook :post-render)
+      (unless (ajax-request-p)
+        (setf (webapp-session-value 'last-request-uri) (all-tokens *uri-tokens*)))
+      (if (member (return-code*) *approved-return-codes*)
           (get-output-stream-string *weblocks-output-stream*)
-          (handle-http-error app (return-code*)))))))
+          (handle-http-error app (return-code*))))))
 
 (defmethod handle-ajax-request ((app weblocks-webapp))
   (declare (special *weblocks-output-stream* *dirty-widgets*

Reply via email to