From d2b14220496e9a1be36d5abf11122a68097a6628 Mon Sep 17 00:00:00 2001
From: "Pierre R. Mai" <pmai@pmsf.de>
Date: Fri, 21 Jul 2000 23:24:24 +0000
Subject: [PATCH] Changes that bring CLASH up to extended HTTP/1.0 support:

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.
---
 src/main/logging.cl | 109 ++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 109 insertions(+)
 create mode 100644 src/main/logging.cl

diff --git a/src/main/logging.cl b/src/main/logging.cl
new file mode 100644
index 0000000..f1816eb
--- /dev/null
+++ b/src/main/logging.cl
@@ -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)))))))