[hunchentoot-devel] [PATCH] debugging-acceptor breaks REDIRECT (among other things) - tbnl-devel@common-lisp.net - mailman3.common-lisp.net

25 Nov 2009

Greetings,
The invoke-process-request-with-error-handling method on the
debugging-acceptor gets a bit overzealous with catching unwinds.
Because we throw to 'handler-done in various places, there are many
unwinds that are not errors.  In particular, REDIRECT throws, as does
anything that calls ABORT-REQUEST-HANDLER (e.g. authorization-required
replies, http-forbidden, http-not-found, etc.).
The cleanest solution is to save a continuation before dropping into the
debugger, then check to see whether we have a continuation to call
during unwind.
Patch is attached.
(Thanks for providing a partial replacement for the old
*catch-errors-p*, by the way.)
Cheers,
-- 
Travis Cross

diff --git a/acceptor.lisp b/acceptor.lisp
index 88118d7..70a8dc2 100644
--- a/acceptor.lisp
+++ b/acceptor.lisp
@@ -493,22 +493,19 @@ errors if *LOG-LISP-ERRORS-P* is set and logs warnings for
                                                        *request* continuation)
   "Mechanism for entering the debugger if an unhandled error occurs
 while handling a request."
-  (let* ((aborted t))
+  (let (unwind-continuation)
     (unwind-protect
-        (let ((*debugger-hook*
-               (lambda (cond prev-hook)
-                 (setf aborted cond)
-                 (let ((*debugger-hook* prev-hook))
-                   (invoke-debugger cond)))))
-          (with-simple-restart (abort "Abort handling ~A ~A"
-                                      (request-method *request*)
-                                      (request-uri *request*))
-            (multiple-value-prog1
-              (funcall continuation)
-              ;; When execution continues, close the stream only if so
-              ;; desired:
-              (setq aborted nil))))
-      (when aborted
-        (when *headers-sent*
-          (setq *close-hunchentoot-stream* t))
-        (throw 'handler-done (values nil aborted))))))
\ No newline at end of file
+         (let ((*debugger-hook*
+                (lambda (cond prev-hook)
+                  (setq unwind-continuation
+                        (lambda ()
+                          (when *headers-sent*
+                            (setq *close-hunchentoot-stream* t))
+                          (throw 'handler-done (values nil cond))))
+                  (let ((*debugger-hook* prev-hook))
+                    (invoke-debugger cond)))))
+           (with-simple-restart (abort "Abort handling ~A ~A"
+                                       (request-method *request*)
+                                       (request-uri *request*))
+             (funcall continuation)))
+      (when unwind-continuation (funcall unwind-continuation)))))

    