Revision: 4518 Author: hans URL: http://bknr.net/trac/changeset/4518
Debugging improved, patch supplied by Andrey Moskvitin.
Introduces a new parameter:
(defparameter *max-debugging-threads* 5 "Maximum number of simultaneous active calls invoke-debuger")
This can be used to limit the number of debuggers that can be opened at once.
U trunk/thirdparty/hunchentoot/conditions.lisp U trunk/thirdparty/hunchentoot/packages.lisp U trunk/thirdparty/hunchentoot/specials.lisp
Modified: trunk/thirdparty/hunchentoot/conditions.lisp =================================================================== --- trunk/thirdparty/hunchentoot/conditions.lisp 2010-02-26 11:39:21 UTC (rev 4517) +++ trunk/thirdparty/hunchentoot/conditions.lisp 2010-03-07 09:16:10 UTC (rev 4518) @@ -90,15 +90,55 @@ "Used to signal an error if an operation named NAME is not implemented." (error 'operation-not-implemented :operation name))
+(defun kill-all-debugging-threads () + "Used for destroy all debugging threads" + (with-lock-held (*debugging-threads-lock*) + (dolist (thread *debugging-threads*) + (when (ignore-errors + (bt:destroy-thread thread) + t) + (setf *debugging-threads* + (remove thread *debugging-threads*)))))) + +(defun debug-mode-on () + "Used to enable debug mode" + (setf *catch-errors-p* nil)) + +(defun debug-mode-off (&optional (kill-debuging-threads t)) + "Used to turn off debug mode" + (setf *catch-errors-p* t) + (when kill-debuging-threads + (kill-all-debugging-threads))) + +(defun after-close-swank-connection (connection) + "Turns off debug mode and destroy debugging threads after closing the connection with the swank-server" + (declare (ignore connection)) + (debug-mode-off t)) + +(when (find-package :swank) + (ignore-errors + (eval `(,(find-symbol (string '#:add-hook) :swank) + ,(find-symbol (string '#:*connection-closed-hook*) :swank) + 'after-close-swank-connection)))) + (defgeneric maybe-invoke-debugger (condition) (:documentation "This generic function is called whenever a condition CONDITION is signaled in Hunchentoot. You might want to specialize it on specific condition classes for debugging purposes.") (:method (condition) - "The default method invokes the debugger with CONDITION if + "The default method invokes the debugger with CONDITION if *CATCH-ERRORS-P* is NIL." - (unless *catch-errors-p* - (invoke-debugger condition)))) + (unless (or *catch-errors-p* + (< *max-debugging-threads* + (length *debugging-threads*))) + (let ((thread (bt:current-thread))) + (with-lock-held (*debugging-threads-lock*) + (push thread *debugging-threads*)) + (unwind-protect + (invoke-debugger condition) + (with-lock-held (*debugging-threads-lock*) + (setf *debugging-threads* + (remove thread *debugging-threads*))))))))
(defmacro with-debugger (&body body) "Executes BODY and invokes the debugger if an error is signaled and
Modified: trunk/thirdparty/hunchentoot/packages.lisp =================================================================== --- trunk/thirdparty/hunchentoot/packages.lisp 2010-02-26 11:39:21 UTC (rev 4517) +++ trunk/thirdparty/hunchentoot/packages.lisp 2010-03-07 09:16:10 UTC (rev 4518) @@ -62,6 +62,7 @@ "*LOG-LISP-BACKTRACES-P*" "*LOG-LISP-ERRORS-P*" "*LOG-LISP-WARNINGS-P*" + "*MAX-DEBUGGING-THREADS*" "*MESSAGE-LOG-PATHNAME*" "*METHODS-FOR-POST-PARAMETERS*" "*REPLY*" @@ -264,5 +265,7 @@ "URL-DECODE" "URL-ENCODE" "USER-AGENT" - "WITHIN-REQUEST-P")) + "WITHIN-REQUEST-P" + "DEBUG-MODE-ON" + "DEBUG-MODE-OFF"))
Modified: trunk/thirdparty/hunchentoot/specials.lisp =================================================================== --- trunk/thirdparty/hunchentoot/specials.lisp 2010-02-26 11:39:21 UTC (rev 4517) +++ trunk/thirdparty/hunchentoot/specials.lisp 2010-03-07 09:16:10 UTC (rev 4518) @@ -236,6 +236,16 @@ "Whether Hunchentoot should catch and log errors (or rather invoke the debugger).")
+(defparameter *max-debugging-threads* 5 + "Maximum number of simultaneous active calls invoke-debuger") + +(defvar *debugging-threads* nil + "List debugged threads") + +(defvar *debugging-threads-lock* (make-lock "debugging threads lock") + "A global lock to prevent two threads from modifying *debugging-threads* at +the same time") + (defvar-unbound *acceptor* "The current ACCEPTOR object while in the context of a request.")