OSCL/CLASH
2
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Changes that bring CLASH up to extended HTTP/1.0 support:

Browse Source 
Added simple common logging file format mixin and a simple profiling
mixin.  This is more for demonstration purposes, than for real-life
usage.  Real world appliations will probably want to do their own
customized forms of logging and/or profiling.
This commit is contained in:
Pierre R. Mai
2000-07-21 23:24:24 +00:00
parent eac484a06f
commit d2b1422049
1 changed files with 109 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

109
src/main/logging.cl Normal file
View File

@ -0,0 +1,109 @@
;;;; CLASH --- The Common Lisp Adaptable Simple HTTP server
;;;; This is copyrighted software. See documentation for terms.
;;;;
;;;; logging.cl --- Logging and tracing functionality
;;;;
;;;; Checkout Tag: $Name$
;;;; $Id$
(in-package :CLASH)
;;;; %File Description:
;;;;
;;;;
;;;;
(defclass server-profiling-mixin ()
((connection-count :initform 0
:accessor server-profiling-mixin-connection-count)
(connection-time :initform 0
:accessor server-profiling-mixin-connection-time)
(connection-min :initform most-positive-fixnum
:accessor server-profiling-mixin-connection-min)
(connection-max :initform 0
:accessor server-profiling-mixin-connection-max)
(request-count :initform 0
:accessor server-profiling-mixin-request-count)
(request-time :initform 0
:accessor server-profiling-mixin-request-time)
(request-min :initform most-positive-fixnum
:accessor server-profiling-mixin-request-min)
(request-max :initform 0
:accessor server-profiling-mixin-request-max)))
(defmethod server-profiling-mixin-connection-avg ((server server-profiling-mixin))
(/ (server-profiling-mixin-connection-time server)
(server-profiling-mixin-connection-count server)))
(defmethod server-profiling-mixin-request-avg ((server server-profiling-mixin))
(/ (server-profiling-mixin-request-time server)
(server-profiling-mixin-request-count server)))
(defmethod serve-connection :around
((server server-profiling-mixin) connection)
(let ((start (get-internal-real-time)))
(multiple-value-prog1 (call-next-method)
(let ((delay (- (get-internal-real-time) start)))
(incf (server-profiling-mixin-connection-time server) delay)
(incf (server-profiling-mixin-connection-count server))
(setf (server-profiling-mixin-connection-min server)
(min (server-profiling-mixin-connection-min server) delay)
(server-profiling-mixin-connection-max server)
(max (server-profiling-mixin-connection-max server) delay))))))
(defmethod serve-request :around ((server server-profiling-mixin) request)
(let ((start (get-internal-real-time)))
(multiple-value-prog1 (call-next-method)
(let ((delay (- (get-internal-real-time) start)))
(incf (server-profiling-mixin-request-time server) delay)
(incf (server-profiling-mixin-request-count server))
(setf (server-profiling-mixin-request-min server)
(min (server-profiling-mixin-request-min server) delay)
(server-profiling-mixin-request-max server)
(max (server-profiling-mixin-request-max server) delay))))))
(defclass server-logging-mixin ()
((pathname :initarg :pathname :accessor server-logging-mixin-pathname)
(stream :accessor server-logging-mixin-stream)))
(defmethod initialize-instance :after
((instance server-logging-mixin) &rest args)
(declare (ignore args))
(unless (slot-boundp instance 'stream)
(setf (server-logging-mixin-stream instance)
(open (server-logging-mixin-pathname instance)
:direction :output
:if-exists :append :if-does-not-exist :create))))
(defmethod (setf server-logging-mixin-pathname) :before
(new (instance server-logging-mixin))
(when (slot-boundp instance 'stream)
(close (server-logging-mixin-stream instance))))
(defmethod (setf server-logging-mixin-pathname) :after
(new (instance server-logging-mixin))
(setf (server-logging-mixin-stream instance)
(open (server-logging-mixin-pathname instance)
:direction :output
:if-exists :append :if-does-not-exist :create)))
(defmethod write-response :after
((server server-logging-mixin) connection response)
(let ((stream (server-logging-mixin-stream server)))
(multiple-value-bind (second minute hour date month year day daylight-p
zone)
(get-decoded-time)
(declare (ignore daylight-p day))
(ignore-errors
(format stream
"~A - - [~2,'0D/~2,'0D/~4,'0D:~2,'0D:~2,'0D:~2,'0D ~@4,'0D] \"~A ~A ~A\" ~3,'0D ~D~%"
(connection-hostname connection)
date month year hour minute second (* zone 100)
(request-method (response-request response))
(request-url (response-request response))
(http-message-version (response-request response))
(response-status-code response)
(let ((entity (http-message-entity response)))
(if entity
(or (entity-content-length entity) 0)
0)))))))