X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=logger.lisp;h=a6aea52c6495a8fe80c97a334686fff044793d8c;hb=2ca1ab4fda6c7a17b6a8f9ccb903f3ecdf35eefe;hp=3c7ff2dae32158d18d14c05303312d5b864772f3;hpb=3a0664a78d4388d5bc17e120a296d5c2a159d265;p=irc-logger.git diff --git a/logger.lisp b/logger.lisp index 3c7ff2d..a6aea52 100644 --- a/logger.lisp +++ b/logger.lisp @@ -9,7 +9,7 @@ (defvar *daemon-monitor-process* nil "Process of background monitor.") (defparameter *timeout* 60) -(defclass channel () +(defclass log-channel () ((name :initarg :name :reader c-name :documentation "Name of channel.") (streams :initarg :streams :reader streams @@ -67,6 +67,10 @@ :documentation "Time of last, potentially active, warning message."))) +(defmethod print-object ((obj logger) stream) + (print-unreadable-object (obj stream :type t :identity t) + (format stream "~A" (l-nickname obj)))) + (defvar *loggers* nil "List of active loggers.") (defparameter *user-address-scanner* @@ -142,6 +146,9 @@ (defmethod log-file-path (output-root channel-name year month day (format (eql :sexp))) (%log-file-path output-root channel-name year month day "sexp")) +(defmethod log-file-path (output-root channel-name year month day (format (eql :binary))) + (%log-file-path output-root channel-name year month day "bin")) + (defmethod log-file-path (output-root channel-name year month day (format (eql :text))) (%log-file-path output-root channel-name year month day "txt")) @@ -374,9 +381,9 @@ (defun add-private-log-entry (logger fmt &rest args) (apply #'add-log-entry - (if (get-private-log-stream logger) + (if (and logger (get-private-log-stream logger)) (get-private-log-stream logger) - *standard-output*) + *standard-output*) fmt args)) (defun privmsg-hook (msg) @@ -389,9 +396,13 @@ (output-event msg :privmsg channel (trailing-argument msg)))))) (defun action-hook (msg) - (output-event msg :action (first (arguments msg)) - (subseq (trailing-argument msg) 8 - (- (length (trailing-argument msg)) 1)))) + (let ((end (- (length (trailing-argument msg)) 1))) + ;; end has been as low as 7 + (when (< end 8) + (warn "End is less than 8: `~A'." msg)) + (output-event msg :action (first (arguments msg)) + (subseq (trailing-argument msg) (min 8 end) + (- (length (trailing-argument msg)) 1))))) (defun nick-hook (msg) (output-event msg :nick nil (trailing-argument msg))) @@ -415,9 +426,9 @@ logger "Logging daemon ~A has been kicked from ~A (~A)" (l-nickname logger) channel (trailing-argument msg)) - (daemon-sleep 1) + (daemon-sleep 5) (remove-channel-logger logger channel) - (daemon-sleep 1) + (daemon-sleep 10) (add-channel-logger logger channel) (add-private-log-entry logger "Rejoined ~A" channel)))) @@ -477,7 +488,7 @@ (defun make-a-channel (name formats output) - (make-instance 'channel + (make-instance 'log-channel :name name :streams (make-array (length formats) :initial-element nil) :output-root (when (and (pathnamep output) @@ -634,7 +645,8 @@ (add-private-log-entry nil "Calling create-logger [add-logger].~%") (let ((logger (do ((new-logger - (mp:with-timeout (*timeout* nil) + (#-sbcl mp:with-timeout #-sbcl (*timeout* nil) + #+sbcl sb-ext:with-timeout #+sbcl *timeout* (create-logger nick server :channels channels :output output :logging-stream logging-stream :password password :realname realname :username username @@ -642,7 +654,8 @@ :unknown-log unknown-log :formats formats :async async)) - (mp:with-timeout (*timeout* nil) + (#-sbcl mp:with-timeout #-sbcl (*timeout* nil) + #+sbcl sb-ext:with-timeout #+sbcl *timeout* (create-logger nick server :channels channels :output output :logging-stream logging-stream :password password :realname realname :username username @@ -711,7 +724,8 @@ (let ((text (trailing-argument msg)) (logger (find-logger-with-connection (connection msg)))) (when (and (stringp text) - (zerop (search (format nil "Closing Link: ~A" (l-nickname logger)) text))) + (eql 0 (search (format nil "Closing Link: ~A" + (l-nickname logger)) text))) (setf (warning-message-utime logger) (received-time msg))) (output-event msg :error nil (trailing-argument msg)))) @@ -790,23 +804,35 @@ *recon-channel-names* (channel-names logger)) (ignore-errors (remove-logger logger))) - (let ((new-logger - (ignore-errors - (add-logger *recon-nick* *recon-server* - :channels *recon-channel-names* - :output *recon-user-output* - :password *recon-password* - :realname *recon-realname* - :username *recon-username* - :logging-stream *recon-logging-stream* - :private-log *recon-private-log* - :unknown-log *recon-unknown-log* - :async *recon-async* - :formats *recon-formats*)))) - (when new-logger - (sleep 5) - (when (is-connected new-logger) - (log-reconnection new-logger))))) + (do ((new-logger nil)) + (new-logger) + (setq new-logger + (ignore-errors + (add-logger *recon-nick* *recon-server* + :channels *recon-channel-names* + :output *recon-user-output* + :password *recon-password* + :realname *recon-realname* + :username *recon-username* + :logging-stream *recon-logging-stream* + :private-log *recon-private-log* + :unknown-log *recon-unknown-log* + :async *recon-async* + :formats *recon-formats*))) + (cond + (new-logger + (sleep 240) + (cond + ((is-connected new-logger) + (log-reconnection new-logger)) + (t + (log-daemon-message new-logger "Newly added logger is not connected. Removing connection and will re-attempt.") + (ignore-errors (remove-logger new-logger)) + (sleep 60) + (setq new-logger nil)))) + (t + (log-daemon-message nil "Got NIL for new logger. Waiting and retrying.") + (sleep 20))))) ) ;; end closure (defun daemon-monitor ()