Added thread-safe debug logging when debugging is on

1 files changed, 27 insertions, 1 deletions

diff --git a/src/protocol.lisp b/src/protocol.lisp
index 31934f4..dfee2e6 100644
--- a/src/protocol.lisp
+++ b/src/protocol.lisp
@@ -5,8 +5,29 @@
 (defvar *debugging* nil
   "If T, the debugger will be evoked.")
 
+(defvar *debug-indent* nil
+  "If an integer, debug print will print this many spaces before printing the debug message. It will then increment the count. 
+
+The debug indent is bound when request handling starts.")
+
+(defvar *debug-lock* nil
+  "Whens set, use this to ensure that writing to the debug stream doesn't
+interleave writes across threads")
+
 (defun toggle-debugging ()
-  (setf *debugging* (not *debugging*)))
+  (setf
+   *debug-lock* (bt:make-lock)
+   *debugging* (not *debugging*)))
+
+(declaim (inline debug-print))
+(defun debug-print (&rest objects)
+  (when *debugging*
+    (bt:with-lock-held (*debug-lock*)
+      (write-string "DEBUG: " *error-output*)
+      (loop :repeat (or *debug-indent* 0)
+            :do (write-char #\space *error-output*))
+      (format *error-output* "~{~s ~}~%" objects)
+      (when *debug-indent* (incf *debug-indent* 2)))))
 
 (define-condition protocol-error (error)
   ((raw-request
@@ -175,6 +196,11 @@ successfully.
 
 This method should return data to be sent back to the client and
 MUST be implemented for every endpoint class.")
+  (:method :around ((endpoint t))
+    (debug-print :handle endpoint)
+    (prog1 (call-next-method)
+      (debug-print)))
+
   (:method :before ((endpoint t))
     ;; The default before method checks that the endpoint is
     ;; authenticated, authorized, default, each of these is T.