Permalink
Browse files

improve logging

<release-note>
Add lots of new debug categories suitable for net.aserve::debug-on and
net.aserve::debug-off. See documentation for more.
</release-note>

Also, add log1* (unexported for now), a generic function of (logger
category level message) args through which all logging eventually goes
through. The value of logger is from the logger slot of the current
wserver if the log comes from a server. For the client, it's the
whatever is in *logger*.

This is patch 13.

<documentation>
Note there are no :xmit-proxy-server-request-* categories, because at
the time of reading the request it's not yet known whether it's the
going to be proxied so these show up as :xmit-server-request-*.

Complicate the simple tree of debug categories into a DAG:
:xmit-server-request-command is a subcategory of each of :xmit :server
:request and :command. To turn on server side logging without the
bodies you'd do:

  (net.aserve::debug-on :server)
  (net.aserve::debug-off :body)

The list of debug categories:

:all                                     off
    The mother of all debug features.
:notrap                                  off
    If set than errors in handlers cause a break loop to be entered.
    (parent categories: :all)
:zoom-on-error                           off
    If set then print a zoom to the vhost-error-stream when an error occurs in a handler.
    (parent categories: :all)
:log                                     off
    Category of features that write some kind of log.
    (parent categories: :all)
:xmit                                    off
    Category of features that log the traffic between clients, servers.
    (parent categories: :log)
:info                                    off
    General information.
    (parent categories: :log)
:client                                  off
    Category of features that log client communication.
    (parent categories: :all)
:server                                  off
    Category of features that log server communication.
    (parent categories: :all)
:proxy                                   off
    Category of features that log proxy communication.
    (parent categories: :all)
:request                                 off
    Category of features that log requests.
    (parent categories: :all)
:response                                off
    Category of features that log responses.
    (parent categories: :all)
:command                                 off
    Category of features that log http request commands.
    (parent categories: :all)
:headers                                 off
    Category of features that log request/response headers.
    (parent categories: :all)
:body                                    off
    Category of features that log request/response bodies.
    (parent categories: :all)
:xmit-client-request-command             off
    If set then print the client request commands.
    (parent categories: :xmit, :client, :request, :command)
:xmit-client-request-headers             off
    If set then print the client request headers.
    (parent categories: :xmit, :client, :request, :headers)
:xmit-client-request-body                off
    If set then print the client request bodies.
    (parent categories: :xmit, :client, :request, :body)
:xmit-client-response-headers            off
    If set then print the client response headers.
    (parent categories: :xmit, :client, :response, :headers)
:xmit-client-response-body               off
    If set then print the client response bodies.
    (parent categories: :xmit, :client, :response, :body)
:xmit-server-request-command             off
    If set then print the server request commands.
    (parent categories: :xmit, :server, :request, :command)
:xmit-server-request-headers             off
    If set then print the server request headers.
    (parent categories: :xmit, :server, :request, :headers)
:xmit-server-request-body                off
    If set then print the server request bodies.
    (parent categories: :xmit, :server, :request, :body)
:xmit-server-response-headers            off
    If set then print the server response headers.
    (parent categories: :xmit, :server, :response, :headers)
:xmit-server-response-body               off
    If set then print the server response bodies.
    (parent categories: :xmit, :server, :response, :body)
:xmit-proxy-client-request-command       off
    If set then print the proxy request command sent to the real server.
    (parent categories: :xmit, :proxy, :client, :request, :command)
:xmit-proxy-client-request-headers       off
    If set then print the proxy request headers sent to the real server.
    (parent categories: :xmit, :proxy, :client, :request, :headers)
:xmit-proxy-client-request-body          off
    If set then print the proxy request bodies sent to the real server.
    (parent categories: :xmit, :proxy, :client, :request, :body)
:xmit-proxy-client-response-headers      off
    If set then print the proxy response headers sent by the real server.
    (parent categories: :xmit, :proxy, :client, :response, :headers)
:xmit-proxy-client-response-body         off
    If set then print the proxy response bodies sent by the real server.
    (parent categories: :xmit, :proxy, :client, :response, :body)
:xmit-proxy-server-response-headers      off
    If set then print the proxy response headers sent to the client.
    (parent categories: :xmit, :proxy, :server, :response, :headers)
:xmit-proxy-server-response-body         off
    If set then print the proxy response bodies sent by the client.
    (parent categories: :xmit, :proxy, :server, :response, :body)
</documentation>

Change-Id: I3209c64bfc3f25bc12cafe9cf4be7f7d0029091b
  • Loading branch information...
1 parent 65d85a2 commit ab9efeb4918b8cc3971b48863eabc69885b7dbc5 Gabor Melis committed with dklayer Feb 2, 2012
Showing with 907 additions and 679 deletions.
  1. +224 −210 client.cl
  2. +4 −1 headers.cl
  3. +79 −60 log.cl
  4. +294 −119 main.cl
  5. +2 −1 packages.cl
  6. +16 −18 parse.cl
  7. +49 −46 proxy.cl
  8. +217 −218 publish.cl
  9. +21 −5 test/t-aserve.cl
  10. +1 −1 webactions/websession.cl
View
View
@@ -703,7 +703,10 @@
(let* ((buff (get-sresource *header-block-sresource*))
(end (read-headers-into-buffer sock buff)))
(if* end
- then (prog1 (parse-and-listify-header-block buff end)
+ then (debug-format :xmit-client-response-headers "~a"
+ (octets-to-string buff :end end
+ :external-format :octets))
+ (prog1 (parse-and-listify-header-block buff end)
(free-sresource *header-block-sresource* buff))
else (free-sresource *header-block-sresource* buff)
(error "Incomplete headers sent by server"))))
View
@@ -35,6 +35,29 @@
(in-package :net.aserve)
+(defun log1 (category level message &key (logger *logger*))
+ (log1* logger category level message))
+
+(defgeneric log1* (logger category level message)
+ (:documentation "This the new, extensible logger interface to which
+all others defer. By default, category :access is handled by
+log-request* while the rest goes to logmess-stream. Note message is
+not necessarily a string: for instance it is a request object
+for :access which allows for more flexibility in presentation.")
+ (:method (logger category level message)
+ (declare (ignore logger))
+ (logmess-stream category level message *debug-stream*))
+ (:method (logger (category (eql :xmit-server-response-headers)) level message)
+ (declare (ignore logger))
+ ;; time is :pre or :post depending on whether the headers are
+ ;; generated before or after the body
+ (destructuring-bind (time string) message
+ (logmess-stream category level (format nil "~a ~s" time string)
+ *debug-stream*)))
+ (:method (logger (category (eql :access)) level (request http-request))
+ (declare (ignore logger level))
+ (log-request* request)))
+
(defvar *enable-logging* t) ; to turn on/off the standard logging method
(defvar *save-commands* nil) ; if true then a stream to which to write commands
@@ -43,21 +66,27 @@
(log-for-wserver *wserver* message format))
(defmethod log-for-wserver ((wserver wserver) message format)
- ;; send log message to the default vhost's error stream
- (logmess-stream message (vhost-error-stream (wserver-default-vhost wserver)) format))
+ ;; send log message to the default vhost's error stream
+ (let ((*debug-stream* (vhost-error-stream (wserver-default-vhost wserver)))
+ (*debug-format* format))
+ (log1 :aserve :info message)))
+
+(defvar *log-time-zone* 0)
-(defmethod logmess-stream (message stream &optional (format :long))
+(defmethod logmess-stream (category level message stream
+ &optional (format *debug-format*))
;; send the log message to the given stream which should be a
;; stream object and not a stream indicator (like t)
;; If the stream has a lock use that.
+ (declare (ignore level))
(multiple-value-bind (csec cmin chour cday cmonth cyear)
- (decode-universal-time (get-universal-time))
+ (decode-universal-time (get-universal-time) *log-time-zone*)
(let* ((*print-pretty* nil)
(str (ecase format
(:long
(format
- nil "~a: ~2,'0d/~2,'0d/~2,'0d - ~2,'0d:~2,'0d:~2,'0d - ~a~%"
- (mp:process-name sys:*current-process*)
+ nil "[~a] ~a: ~2,'0d/~2,'0d/~2,'0d - ~2,'0d:~2,'0d:~2,'0d - ~a~%"
+ category (mp:process-name sys:*current-process*)
cmonth cday (mod cyear 100) chour cmin csec
message))
(:brief
@@ -72,51 +101,11 @@
else (write-sequence str stream)
(finish-output stream)))))
-
(defmethod log-request ((req http-request))
;; after the request has been processed, write out log line
(if* *enable-logging*
- then (let* ((ipaddr (socket:remote-host (request-socket req)))
- (time (request-reply-date req))
- (code (let ((obj (request-reply-code req)))
- (if* obj
- then (response-number obj)
- else 999)))
- (length (or (request-reply-content-length req)
- #+(and allegro (version>= 6))
- (excl::socket-bytes-written
- (request-socket req))))
-
- (stream (vhost-log-stream (request-vhost req)))
-
- (lock (and (streamp stream)
- (getf (excl::stream-property-list stream)
- :lock))))
-
- (macrolet ((do-log ()
- '(progn (format stream
- "~A~A~a - - [~a] ~s ~s ~s~%"
- (if* *log-wserver-name*
- then (wserver-name *wserver*)
- else "")
- (if* *log-wserver-name*
- then " "
- else "")
- (socket:ipaddr-to-dotted ipaddr)
- (maybe-universal-time-to-date time)
- (request-raw-request req)
- code
- (or length -1))
- (force-output stream))))
-
- (if* lock
- then (mp:with-process-lock (lock)
- ; in case stream switched out while we weren't busy
- ; get the stream again
- (setq stream (vhost-log-stream (request-vhost req)))
- (do-log))
- else (do-log)))))
-
+ then ;; By default this ends up calling log-request*.
+ (log1 :access :info req))
(if* *save-commands*
then (multiple-value-bind (ok whole uri-string)
(match-re "^[^ ]+\\s+([^ ]+)" (request-raw-request req))
@@ -133,15 +122,49 @@
(let ((bod (request-request-body req)))
(and (not (equal "" bod)) bod))
(multiple-value-list (get-basic-authorization req))
- (header-slot-value req :content-type)
- ))
- (force-output *save-commands*))
-
-
- )
+ (header-slot-value req :content-type)))
+ (force-output *save-commands*)))
-
-
+(defun log-request* (req)
+ (let* ((entry (format-access-log-entry req))
+ (stream (vhost-log-stream (request-vhost req)))
+ (lock (and (streamp stream)
+ (getf (excl::stream-property-list stream)
+ :lock))))
+ (macrolet ((do-log ()
+ '(progn (format stream "~a~%" entry)
+ (force-output stream))))
+ (if* lock
+ then (mp:with-process-lock (lock)
+ ; in case stream switched out while we weren't busy
+ ; get the stream again
+ (setq stream (vhost-log-stream (request-vhost req)))
+ (do-log))
+ else (do-log)))))
+
+(defun format-access-log-entry (req)
+ (let* ((ipaddr (socket:remote-host (request-socket req)))
+ (time (request-reply-date req))
+ (code (let ((obj (request-reply-code req)))
+ (if* obj
+ then (response-number obj)
+ else 999)))
+ (length (or (request-reply-content-length req)
+ #+(and allegro (version>= 6))
+ (excl::socket-bytes-written
+ (request-socket req)))))
+ (format nil "~A~A~a - - [~a] ~s ~s ~s"
+ (if* *log-wserver-name*
+ then (wserver-name *wserver*)
+ else "")
+ (if* *log-wserver-name*
+ then " "
+ else "")
+ (socket:ipaddr-to-dotted ipaddr)
+ (maybe-universal-time-to-date time)
+ (request-raw-request req)
+ code
+ (or length -1))))
(defun log-proxy (uri level action extra)
;; log information from the proxy module
@@ -158,7 +181,3 @@
else (net.uri:render-uri uri nil))
extra)
:brief))
-
-
-
-
Oops, something went wrong. Retry.

0 comments on commit ab9efeb

Please sign in to comment.