From dd99f55b19fef478e792c6c6a6b5d360d679c8fa Mon Sep 17 00:00:00 2001 From: colin Date: Thu, 28 Nov 2024 11:52:05 -0800 Subject: Added thread-safe debug logging when debugging is on --- src/protocol.lisp | 28 +++++++++++++++++++++++++++- 1 file changed, 27 insertions(+), 1 deletion(-) (limited to 'src/protocol.lisp') 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. -- cgit v1.2.3