aserve-logs-like-apache.lisp

(in-package :net.aserve)

;; Speedy to cache this.
(defparameter *ws-saved-ut-to-date* nil)

;; Generate the date for apache-style logs from a time and timezone.
(defun ws-universal-time-to-date (ut &optional (time-zone 8))
  (when (stringp ut) (return-from ws-universal-time-to-date ut))
  (let ((cval *ws-saved-ut-to-date*))
    (if* (and (eql ut (caar cval))
	      (eql time-zone (cdar cval)))
       then ;; turns out we often repeatedly ask for the same conversion
	    (cdr cval)
       else (let ((*print-pretty* nil))
	      (multiple-value-bind
		  (sec min hour date month year day-of-week dsp tz)
		  (decode-universal-time ut time-zone)
		(declare (ignore day-of-week))
		(let ((ans
		       (format
			nil
			"~2,'0d/~a/~d:~2,'0d:~2,'0d:~2,'0d ~A"

			date
			(svref '#(nil "Jan" "Feb" "Mar" "Apr" "May" "Jun"
				  "Jul" "Aug" "Sep" "Oct" "Nov" "Dec")
			       month)
			year
			hour
			min
			sec
			;; Work with daylight savings'
			;; adjust timezone accordingly.
			(if (not dsp)
			    (format nil "~A~2,'0D00"
				    (if (< tz 0) "" "-")
				    (abs tz))
			  (format nil "~A~2,'0D00"
				  (if (< tz 0) "" "-")
				  (abs (- tz 1)))))))
		  ;; Fill cache
		  (setf *ws-saved-ut-to-date* (cons (cons ut time-zone) ans))
		  ;; Return date
		  ans))))))

(defmethod log-request :around ((req http-request))
  ;; Do NOT (call-next-method), as this is essentially a redefinition of
  ;; the standard aserve log-request method.
  (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] ~s ~s ~s ~s ~s~%"
				  (socket:ipaddr-to-dotted ipaddr)
				  (ws-universal-time-to-date time)
				  (request-raw-request req)
				  code
				  (or length -1)
				  ;; The following two items added for Apache
				  ;; "combined" log compatibility:
				  (or (header-slot-value req :referer) "-")
				  (or (header-slot-value req :user-agent) "-"))
			   (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))))))