X-Git-Url: http://git.kpe.io/?p=irc-logger.git;a=blobdiff_plain;f=logger.lisp;h=feb6dd5732dbff1e5674e80dec179224aa13eef3;hp=449f154a08e97c76b37f1e0c0e4c43b87347b252;hb=b8a8a19aabdd430565f1e41fb451e3a242d153de;hpb=bf7cb3143da8886c3671d2ce007487b0a93ebbcd diff --git a/logger.lisp b/logger.lisp index 449f154..feb6dd5 100644 --- a/logger.lisp +++ b/logger.lisp @@ -91,11 +91,23 @@ (format nil "~A-~4,'0D.~2,'0D.~2,'0D" (canonicalize-channel-name name) year month day)) +(defmacro with-decoding ((utime &optional zone) &body body) + `(multiple-value-bind + (second minute hour day-of-month month year day-of-week daylight-p zone) + (decode-universal-time ,utime ,@(if zone (list zone))) + (declare (ignorable second minute hour day-of-month month year day-of-week daylight-p zone)) + ,@body)) + +(defun format-utime (utime &optional zone) + (with-decoding (utime zone) + (format nil "~2,'0D:~2,'0D:~2,'0D" hour minute second))) + +(defun format-date-time (utime &key stream) + (with-decoding (utime) + (format stream "~4,'0D/~2,'0D/~2,'0D ~2,'0D:~2,'0D:~2,'0D" year month day-of-month hour minute second))) + (defun make-output-name-utime (name utime) - (multiple-value-bind - (second minute hour day-of-month month year day-of-week daylight-p zone) - (decode-universal-time utime) - (declare (ignore second minute hour day-of-week daylight-p zone)) + (with-decoding (utime 0) (make-output-name name year month day-of-month))) (defgeneric write-file-header (format channel-name stream)) @@ -137,11 +149,8 @@ (defun log-file-path-utime (output-root channel-name format utime) - (multiple-value-bind - (second minute hour day month year day-of-week daylight-p zone) - (decode-universal-time utime) - (declare (ignore second minute hour day-of-week daylight-p zone)) - (log-file-path output-root channel-name year month day format))) + (with-decoding (utime 0) + (log-file-path output-root channel-name year month day-of-month format))) (defun get-stream (channel istream) (elt (streams channel) istream)) @@ -197,27 +206,6 @@ (open (user-output logger) :direction :output :if-exists :append :if-does-not-exist :create))))))) -(defun format-date-time (utime) - (multiple-value-bind - (second minute hour day-of-month month year day-of-week daylight-p zone) - (decode-universal-time utime) - (declare (ignore day-of-week daylight-p zone)) - (format nil "~4,'0D/~2,'0D/~2,'0D ~2,'0D:~2,'0D:~2,'0D" year month day-of-month hour minute second))) - -(defun format-utime (utime) - (multiple-value-bind - (second minute hour day-of-month month year day-of-week daylight-p zone) - (decode-universal-time utime) - (declare (ignore day-of-month month year day-of-week daylight-p zone)) - (format nil "~2,'0D:~2,'0D:~2,'0D" hour minute second))) - -(defun format-utime-short (utime) - (multiple-value-bind - (second minute hour day-of-month month year day-of-week daylight-p zone) - (decode-universal-time utime) - (declare (ignore second day-of-month month year day-of-week daylight-p zone)) - (format nil "~2,'0D:~2,'0D" hour minute))) - (defun user-address (msg) (let ((split (split *user-address-scanner* (raw-message-string msg) :with-registers-p t))) @@ -246,10 +234,11 @@ (format stream "~S~%" (string-right-trim '(#\return) (raw-message-string msg))))) -(uffi:def-foreign-type time-t :unsigned-long) -(uffi:def-function ("ctime" c-ctime) - ((time (* time-t))) - :returning :cstring) +(defconstant +posix-epoch+ + (encode-universal-time 0 0 0 1 1 1970 0)) + +(defun posix-time-to-utime (time) + (+ time +posix-epoch+)) (defun last-sexp-field (type msg) (cond @@ -261,26 +250,22 @@ (when (stringp (car (last (arguments msg)))) (let ((secs (parse-integer (car (last (arguments msg))) :junk-allowed t))) (when secs - (string-right-trim '(#\newline #\return) - (uffi:convert-from-cstring - (uffi:with-foreign-object (time 'time-t) - (setf (uffi:deref-pointer time :unsigned-long) secs) - (c-ctime time)))))))) + (posix-time-to-utime secs))))) ((need-user-address? type) (user-address msg)))) (defmethod %output-event ((format (eql :sexp)) stream utime type channel source text msg unichannel) - (let ((*print-circle* nil) - (*print-pretty* nil)) - (if unichannel - (format stream "(~S ~S ~S ~S ~S)~%" utime type source text (last-sexp-field type msg)) - (format stream "(~S ~S ~S ~S ~S ~S)~%" utime type source channel text - (last-sexp-field type msg))))) + (with-standard-io-syntax + (let ((cl:*print-case* :downcase)) + (if unichannel + (format stream "(~S ~S ~S ~S ~S)~%" utime type source text (last-sexp-field type msg)) + (format stream "(~S ~S ~S ~S ~S ~S)~%" utime type source channel text + (last-sexp-field type msg)))))) (defmethod %output-event ((format (eql :text)) stream utime type channel source text msg unichannel) - (format stream "~A " (format-utime utime)) + (format stream "~A " (format-utime utime 0)) (when (and (null unichannel) channel) (format stream "[~A] " channel)) @@ -324,11 +309,10 @@ (force-output (get-stream channel istream))) (defun log-daemon-message (logger fmt &rest args) - (let ((text (apply #'format nil fmt args)) - (time (get-universal-time))) - (format (get-private-log-stream logger) - "~A ~A~%" (format-date-time time) text) - (force-output (get-private-log-stream logger)) + (let ((text (apply #'format nil fmt args))) + (add-private-log-entry logger "~A" text) + ;;don't daemon messages to the logs + #+ignore (dolist (channel (channels logger)) (dotimes (istream (length (formats logger))) (ensure-output-stream time logger channel istream) @@ -344,11 +328,7 @@ (dolist (logger *loggers*) (case type ((:error :server :kill) - (format (get-private-log-stream logger) - "~A ~A~%" - (format-date-time (received-time msg)) - (raw-message-string msg)) - (force-output (get-private-log-stream logger))) + (add-private-log-entry logger "~A" (raw-message-string msg))) ((:quit :nick) ;; send to all channels that a nickname is joined (let* ((user (find-user (connection logger) @@ -370,22 +350,36 @@ (output-event-for-a-stream msg type channel text logger i)))))))) (defun get-private-log-stream (logger) - (or (private-log-stream logger) *standard-output*)) + (if (and logger (private-log-stream logger)) + (private-log-stream logger) + *standard-output*)) (defun get-unknown-log-stream (logger) - (or (unknown-log-stream logger) *standard-output*)) + (if (and logger (unknown-log-stream logger)) + (unknown-log-stream logger) + *standard-output*)) + +(defun add-log-entry (stream fmt &rest args) + (handler-case + (progn + (format-date-time (get-universal-time) :stream stream) + (write-char #\space stream) + (apply #'format stream fmt args) + (write-char #\newline stream) + (force-output stream)) + (error (e) + (warn "Error ~A when trying to add-log-entry '~A'." e + (apply #'format nil fmt args))))) + +(defun add-private-log-entry (logger fmt &rest args) + (apply #'add-log-entry (get-private-log-stream logger) fmt args)) (defun privmsg-hook (msg) (let ((logger (find-logger-with-connection (connection msg))) (channel (first (arguments msg)))) (cond ((equal channel (nickname logger)) - (format - (get-private-log-stream logger) - "~A ~A~%" - (format-date-time (get-universal-time)) - (raw-message-string msg)) - (force-output (get-private-log-stream logger))) + (add-private-log-entry logger "~A" (raw-message-string msg))) (t (output-event msg :privmsg channel (trailing-argument msg)))))) @@ -412,24 +406,15 @@ (who-kicked (second (arguments msg)))) (output-event msg :kick channel who-kicked) (when (string-equal (nickname logger) who-kicked) - (format - (get-private-log-stream logger) - "~A Logging daemon ~A has been kicked from ~A (~A)~%" - (format-date-time (received-time msg)) - (nickname logger) - channel - (trailing-argument msg)) - (force-output (get-private-log-stream logger)) + (add-private-log-entry + logger + "Logging daemon ~A has been kicked from ~A (~A)" + (nickname logger) channel (trailing-argument msg)) (daemon-sleep 1) (remove-channel-logger logger channel) (daemon-sleep 1) (add-channel-logger logger channel) - (format - (get-private-log-stream logger) - "~A Rejoined ~A~%" - (format-date-time (received-time msg)) - channel) - (force-output (get-private-log-stream logger))))) + (add-private-log-entry logger "Rejoined ~A" channel)))) (defun notice-hook (msg) (let ((logger (find-logger-with-connection (connection msg))) @@ -440,17 +425,9 @@ (string-equal "owned by someone else" (trailing-argument msg))) (if logger (privmsg (connection msg) (source msg) (format nil "IDENTIFY ~A" (password logger))) - (format - (get-private-log-stream logger) - "~A NickServ asks for identity with connection not found.~%" - (format-date-time (received-time msg))))) + (add-private-log-entry logger "NickServ asks for identity with connection not found."))) ((equal channel (nickname logger)) - (format - (get-private-log-stream logger) - "~A ~A~%" - (format-date-time (get-universal-time)) - (raw-message-string msg)) - (force-output (get-private-log-stream logger))) + (add-private-log-entry logger "~A" (raw-message-string msg))) (t (output-event msg :notice channel (trailing-argument msg)))))) @@ -491,12 +468,7 @@ (defun invite-hook (msg) (let ((logger (find-logger-with-connection (connection msg)))) - (format - (get-private-log-stream logger) - "~A ~A~%" - (format-date-time (get-universal-time)) - (raw-message-string msg)) - (force-output (get-private-log-stream logger)))) + (add-private-log-entry logger "~A" (raw-message-string msg)))) (defun make-a-channel (name formats output) @@ -561,13 +533,10 @@ ;; nothing to do ) (t - (let ((logger (find-logger-with-connection (connection msg)))) - (format (get-unknown-log-stream - (find-logger-with-connection (connection msg))) - "~A ~A~%" - (format-date-time (received-time msg )) - (raw-message-string msg)) - (force-output (get-unknown-log-stream logger))))) + (add-log-entry + (get-unknown-log-stream (find-logger-with-connection (connection msg))) + "~A" + (raw-message-string msg)))) result)) (defun create-logger (nick server &key channels output password @@ -651,10 +620,8 @@ (logging-stream t) (async t) (formats '(:sexp))) (when (find-logger-with-nick nick) - (format - (get-private-log-stream (find-logger-with-nick nick)) - "~A Closing previously active connection [add-logger].~%" - (format-date-time (get-universal-time))) + (add-private-log-entry (find-logger-with-nick nick) + "Closing previously active connection [add-logger].") (ignore-errors (remove-logger nick))) (let ((logger (create-logger nick server :channels channels :output output :logging-stream logging-stream :password password @@ -670,11 +637,7 @@ (defun add-channel-logger (logger channel-name) (cond ((find-channel-with-name logger channel-name) - (format (get-private-log-stream logger) - "~A Channel ~A already in logger ~A.~%" - (format-date-time (get-universal-time)) - channel-name logger) - (force-output (get-private-log-stream logger)) + (add-private-log-entry logger "Channel ~A already in logger ~A." channel-name logger) nil) (t (let ((channel (make-a-channel channel-name (formats logger) (user-output logger)))) @@ -698,11 +661,8 @@ :test #'string-equal)) t) (t - (format - (get-private-log-stream logger) - "~A Channel name ~A not found in logger ~A.~%" - (format-date-time (get-universal-time)) - channel-name logger) + (add-private-log-entry + logger "Channel name ~A not found in logger ~A." channel-name logger) nil)))) (defun add-hook-logger (logger class hook) @@ -719,11 +679,7 @@ (when (and (stringp target) (string-equal target (nickname logger))) (setf (warning-message-utime logger) (received-time msg))) - (format (get-private-log-stream logger) - "~A Killed by ~A~%" - (format-date-time (received-time msg)) - (source msg)) - (force-output (get-private-log-stream logger)))) + (add-private-log-entry logger "Killed by ~A" (source msg)))) (defun error-hook (msg) (let ((text (trailing-argument msg)) @@ -750,21 +706,34 @@ ;; avoid generating too many reconnect messages in the logs (when (or (null (warning-message-utime logger)) (< (- (get-universal-time) (warning-message-utime logger)) 300)) - (log-daemon-message logger "Disconnected. Attempting reconnection at ~A." - (format-date-time (get-universal-time))))) + (log-daemon-message logger "Disconnected. Attempting reconnection."))) (defun log-reconnection (logger) - (log-daemon-message - logger - "Connection restablished at ~A." (format-date-time (get-universal-time)))) + (log-daemon-message logger "Connection restablished.")) + +#+ignore +(defun is-connected (logger) + (%is-connected logger)) + +(defparameter *timeout* 60) (defun is-connected (logger) + #-allegro (%is-connected logger) + #+allegro (mp:with-timeout (*timeout* nil) + (%is-connected logger))) + +(defun quit-maybe-timeout (connection msg) + #-allegro (quit connection msg) + #+allegro (mp:with-timeout (*timeout* nil) + (quit connection msg))) + +(defun %is-connected (logger) (when (ignore-errors (ping (connection logger) (server logger))) (dotimes (i 20) (when (and (last-pong logger) (< (- (get-universal-time) (last-pong logger)) 21)) - (return-from is-connected t)) - (sleep 1)))) + (return-from %is-connected t)) + (daemon-sleep 1)))) (let (*recon-nick* *recon-server* *recon-username* *recon-realname* @@ -781,7 +750,7 @@ (log-disconnection logger) (when (connection logger) - (ignore-errors (quit (connection logger) "Client terminated by server")) + (ignore-errors (quit-maybe-timeout (connection logger) "Client terminated by server")) (setf *recon-nick* (nickname logger) *recon-server* (server logger) *recon-username* (username logger)