Commit c11f12e9a88c3468f41375edfb67378db8258728
2018-06-16T14:07:02
use MSG where appropriate
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158
diff --git a/mime.lisp b/mime.lisp
index 9020615..d94dd0e 100644
--- a/mime.lisp
+++ b/mime.lisp
@@ -53,8 +53,7 @@
((mime-type-p sym) (setf mime-type sym))
(mime-type (let ((ext (ext sym)))
(when (debug-p :mime)
- (format t "~S ~S~%" ext mime-type)
- (force-output))
+ (msg mime ext " " mime-type))
(setf (mime-type ext)
mime-type)))))))
(cl:close in))))
diff --git a/package.lisp b/package.lisp
index e913988..6538be6 100644
--- a/package.lisp
+++ b/package.lisp
@@ -34,6 +34,7 @@
(:shadow #:probe-file)
#.(cl-stream:shadowing-import-from)
(:export
+ #:msg
#:request
#:*request*
#:request-socket
diff --git a/thot-threaded.lisp b/thot-threaded.lisp
index 86e12cc..a2a4daa 100644
--- a/thot-threaded.lisp
+++ b/thot-threaded.lisp
@@ -46,7 +46,7 @@
(defun acceptor-loop-threaded (fd)
(declare (type (unsigned-byte 31) fd))
(when (debug-p :thot)
- (format t " ~A~%" *worker-thread-for-fd*))
+ (msg debug " " *acceptor-loop*))
(set-nonblocking fd)
(with-worker-threads (fd (1- (the fixnum *init-threads*)))
(funcall (funcall *worker-thread-for-fd* fd))))
diff --git a/thot.lisp b/thot.lisp
index 98cfd28..f8297ca 100644
--- a/thot.lisp
+++ b/thot.lisp
@@ -9,6 +9,15 @@
;;(setf (debug-p :directory) t)
;;(setf (debug-p :file) t)
+(defmacro msg (level &rest parts)
+ `(progn
+ (write-str *standard-output*
+ ,(symbol-name level)
+ #\Space
+ ,@parts
+ #\Newline)
+ (force-output)))
+
(eval-when (:compile-toplevel :load-toplevel :execute)
(unless (boundp '+crlf+)
(defconstant +crlf+
@@ -211,12 +220,9 @@
(version))))
(version-lf (char)
(cond ((char= #\Newline char)
- (when (debug-p (or :thot :http))
- (format t "~&thot: ~A ~A ~A~%"
- (request-method% request)
- (request-target% request)
- (request-http-version% request))
- (force-output))
+ (msg info (request-method% request) " "
+ (request-target% request) " "
+ (request-http-version% request))
(next-header))
(t (error "Missing request line LF"))))
(next-header (char)
@@ -242,8 +248,7 @@
(header-lf (char)
(cond ((char= #\Newline char)
(when (debug-p (or :thot :http))
- (format t "~&thot: ~A: ~A~%" name value)
- (force-output))
+ (msg debug name ": " value))
(setf (request-header name request) value)
(next-header))
(t (error "Missing header LF"))))
@@ -423,8 +428,7 @@ The requested url "
(dolist (name sorted)
(let* ((url (str remote dir (url-encode name))))
(when (debug-p :directory)
- (format t "name ~S url ~S~%" name url)
- (force-output))
+ (msg directory "name " name " url " url))
(content " <li><a href=\"" (h url) "\">"
(h name)
"</a></li>
@@ -437,14 +441,12 @@ The requested url "
(defun directory-handler (local remote)
(let ((dir (path-as-directory (request-uri))))
(when (debug-p :directory)
- (format t "dir ~S local ~S remote ~S~%" dir local remote)
- (force-output))
+ (msg directory "dir " dir " local " local " remote " remote))
(when (prefix-p remote dir)
(let* ((subdir (subseq dir (length remote)))
(local-path (str local subdir)))
(when (debug-p :directory)
- (format t "subdir ~S local-path ~S~%" subdir local-path)
- (force-output))
+ (msg directory "subdir " subdir " local-path " local-path))
(when (probe-dir local-path)
`(directory-index ,local ,remote ,subdir))))))
@@ -487,14 +489,12 @@ The requested url "
(let ((uri (request-uri)))
(declare (type simple-string uri))
(when (debug-p :file)
- (format t "uri ~S local ~S remote ~S~%" uri local remote)
- (force-output))
+ (msg file "uri " uri " local " local " remote " remote))
(when (prefix-p remote uri)
(let* ((path (subseq uri (length remote)))
(local-path (str local path)))
(when (debug-p :file)
- (format t "local-path ~S~%" local-path)
- (force-output))
+ (msg file "local-path " local-path))
(with-stat (stat nil) local-path
(let ((mode (the fixnum (stat-mode stat))))
(cond ((s-isdir mode)
@@ -533,15 +533,14 @@ The requested url "
(when (find errno '(errno:+epipe+
errno:+econnreset+))
(when (debug-p :thot)
- (format t "~&WARN request-cont ~A~%" condition)
- (force-output))
+ (msg warn "request-handler: " condition))
(return-from request-cont))))))
(loop
(let ((handler-form (pop handlers)))
(unless handler-form (return))
(let ((handler (call-handler-form handler-form)))
(when (debug-p :thot)
- (format t "~&~S -> ~S~%" handler-form handler)
+ (format t "~A ~S -> ~S~%" 'debug handler-form handler)
(force-output))
(when handler
(call-handler handler)
@@ -576,9 +575,7 @@ The requested url "
(defvar *port*)
(defun start (&key (host "0.0.0.0") (port 8000))
- (when (debug-p :thot)
- (format t "~&Thot start ~A ~A~%" host port)
- (force-output))
+ (msg info "Thot start " host ":" port)
(setq *stop* nil)
(let ((*host* host)
(*port* port))