aboutsummaryrefslogtreecommitdiff
path: root/src/protocol.lisp
diff options
context:
space:
mode:
Diffstat (limited to 'src/protocol.lisp')
-rw-r--r--src/protocol.lisp28
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.