[bknr-cvs] hans changed trunk/thirdparty/hunchentoot/

[BKNR Commits]

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