-o;;; -*- Mode: Lisp -*-
+;;; -*- Mode: Lisp -*-
;;;; $Id: logger.lisp,v 1.11 2003/12/16 21:19:56 krosenberg Exp $
;;;;
;;;; Purpose: A IRC logging bot
(last-pong :initform nil :accessor last-pong
:documentation
"utime of last pong message")
+ (private-log :initarg :private-log :reader private-log
+ :documentation "Pathname of the private log file for the daemon.")
+ (unknown-log :initarg :unknown-log :reader unknown-log
+ :documentation "Pathname of the log file for unknown messages.")
+ (private-log-stream :initarg :private-log-stream :reader private-log-stream
+ :documentation "Stream of the private log file for the daemon.")
+ (unknown-log-stream :initarg :unknown-log-stream :reader unknown-log-stream
+ :documentation "Stream of the log file for unknown messages.")
+ (monitor-events :initform nil :accessor monitor-events
+ :documentation "List of events for the monitor to process.")
(warning-message-utime :initform nil :accessor warning-message-utime
:documentation
"Time of last, potentially active, warning message.")))
(close (get-stream channel istream)))
(setf (get-stream channel istream)
(open path :direction :output :if-exists :append
- :if-does-not-exist :error))))))
+ :if-does-not-exist :create))))))
(defun ensure-output-stream (utime logger channel istream)
"Ensures that *output-stream* is correct."
(ensure-output-stream-for-unichannel utime logger channel istream))
(t
(setf (get-stream channel istream)
- (open (user-output logger) :direction :output :if-exists :append)))))))
+ (open (user-output logger) :direction :output :if-exists :append
+ :if-does-not-exist :create)))))))
(defun format-date-time (utime)
(multiple-value-bind
"")))
(defun need-user-address? (type)
- (not (or (eq :action type) (eq :privmsg type))))
+ (case type
+ ((:action :privmsg :names :rpl_topic)
+ nil)
+ (t
+ t)))
(defgeneric %output-event (format stream utime type channel source text msg
unichannel))
(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)
+(defmethod %output-event ((format (eql :text)) stream utime type channel
+ source text msg unichannel)
(format stream "~A " (format-utime utime))
(when (and (null unichannel) channel)
(format stream "[~A] " channel))
(format stream "-~A:~A- ~A" source channel text))
(:daemon
(format stream "-!!!- ~A" text))
- (:server
- (format stream "-!!!- server send message ~A" source channel text))
- (:error
- (format stream "-!!!- error: ~A ~A" source text))
- (:kill
- (format stream "-!!!- kill: ~A ~A" source text))
+ (:names
+ (format stream "-!- names: ~A" text))
+ (:rpl_topic
+ (format stream "-!- topic: ~A" text))
(t
(warn "Unhandled msg type ~A." type))))
(write-char #\Newline stream))
(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))
(dolist (channel (channels logger))
(dotimes (istream (length (formats logger)))
(ensure-output-stream time logger channel istream)
- (%output-event (get-format logger istream) (get-stream channel istream)
+ (%output-event (get-format logger istream)
+ (get-stream channel istream)
time :daemon nil nil text nil
(unichannel logger))
(force-output (get-stream channel istream))))))
(dolist (logger *loggers*)
(case type
((:error :server :kill)
- ;;send to all channels
- (dolist (channel (channels logger))
- (dotimes (i (length (formats logger)))
- (output-event-for-a-stream msg type channel text logger i))))
+ (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)))
((:quit :nick)
;; send to all channels that a nickname is joined
(let* ((user (find-user (connection logger)
(dotimes (i (length (formats logger)))
(output-event-for-a-stream msg type channel text logger i))))))))
+(defun get-private-log-stream (logger)
+ (or (private-log-stream logger) *standard-output*))
+
+(defun get-unknown-log-stream (logger)
+ (or (unknown-log-stream logger) *standard-output*))
+
(defun privmsg-hook (msg)
- (output-event msg :privmsg (first (arguments msg)) (trailing-argument 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)))
+ (t
+ (output-event msg :privmsg channel (trailing-argument msg))))))
(defun action-hook (msg)
(output-event msg :action (first (arguments msg))
(let ((logger (find-logger-with-connection (connection msg)))
(channel (first (arguments msg)))
(who-kicked (second (arguments msg))))
+ (output-event msg :kick channel who-kicked)
(when (string-equal (nickname logger) who-kicked)
- (warn "*** Logging daemon ~A has been kicked from ~A at ~A" (nickname logger)
- channel (format-date-time (received-time msg)))
- #+ignore (remove-channel-logger logger channel))
- (output-event msg :kick channel 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))
+ (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)))))
(defun notice-hook (msg)
- (if (and (string-equal (source msg) "NickServ")
- (string-equal "owned by someone else" (trailing-argument msg)))
- (let ((logger (find-logger-with-connection (connection msg))))
- (if logger
- (privmsg (connection msg) (source msg) (format nil "IDENTIFY ~A" (password logger)))
- (warn "NickServ asks for identity with connection not found.")))
- (output-event msg :notice (first (arguments msg)) (trailing-argument msg))))
+ (let ((logger (find-logger-with-connection (connection msg)))
+ (channel (first (arguments msg))))
+ (cond
+ ((and (string-equal (source msg) "NickServ")
+ (string-equal channel (nickname logger))
+ (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)))))
+ ((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)))
+ (t
+ (output-event msg :notice channel (trailing-argument msg))))))
(defun ping-hook (msg)
(let ((logger (find-logger-with-connection (connection msg))))
(output-event msg :mode (first (arguments msg))
(format nil "~{~A~^ ~}" (cdr (arguments msg)))))
+(defun rpl_namreply-hook (msg)
+ (output-event msg :names (third (arguments msg))
+ (trailing-argument msg)))
+
+(defun rpl_endofnames-hook (msg)
+ (declare (ignore msg))
+ ;; nothing to do for this message
+ )
+
+(defun rpl_topic-hook (msg)
+ (output-event msg :rpl_topic (format nil "~{~A~^ ~}" (arguments msg))
+ (trailing-argument msg)))
+
+(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))))
+
+
(defun make-a-channel (name formats output)
(make-instance 'channel
:name name
(add-hook conn 'irc::irc-mode-message 'mode-hook)
(add-hook conn 'irc::irc-topic-message 'topic-hook)
(add-hook conn 'irc::irc-notice-message 'notice-hook)
- (add-hook conn 'irc::irc-rpl_killdone-message 'warning-hook)
- (add-hook conn 'irc::irc-rpl_closing-message 'warning-hook)
(add-hook conn 'irc::irc-error-message 'error-hook)
(add-hook conn 'irc::irc-ping-message 'ping-hook)
(add-hook conn 'irc::irc-pong-message 'pong-hook)
(add-hook conn 'irc::irc-kill-message 'kill-hook)
+ (add-hook conn 'irc::irc-invite-message 'invite-hook)
+ (add-hook conn 'irc::irc-rpl_killdone-message 'warning-hook)
+ (add-hook conn 'irc::irc-rpl_closing-message 'warning-hook)
+ (add-hook conn 'irc::irc-rpl_topic-message 'rpl_topic-hook)
+ (add-hook conn 'irc::irc-rpl_namreply-message 'rpl_namreply-hook)
+ (add-hook conn 'irc::irc-rpl_endofnames-message 'rpl_endofnames-hook)
conn))
+(defmethod cl-irc::irc-message-event :around ((msg cl-irc::irc-message))
+ (let ((result (call-next-method msg)))
+ (typecase msg
+ ((or irc::irc-privmsg-message irc::ctcp-action-message irc::irc-nick-message
+ irc::irc-part-message irc::irc-quit-message irc::irc-join-message
+ irc::irc-kick-message irc::irc-mode-message irc::irc-topic-message
+ irc::irc-notice-message irc::irc-error-message irc::irc-ping-message
+ irc::irc-pong-message irc::irc-kill-message irc::irc-invite-message
+ irc::irc-rpl_killdone-message irc::irc-rpl_closing-message
+ irc::irc-rpl_topic-message irc::irc-rpl_namreply-message
+ irc::irc-rpl_endofnames-message)
+ ;; 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)))))
+ result))
+
(defun create-logger (nick server &key channels output password
- realname username async
- (logging-stream t) (formats '(:text)))
+ realname username async
+ private-log unknown-log
+ (logging-stream t) (formats '(:text)))
"OUTPUT may be a pathname or a stream"
;; check arguments
(assert formats)
:logging-stream logging-stream
:user-output output
:formats formats
+ :private-log private-log
+ :unknown-log unknown-log
+ :private-log-stream (when private-log
+ (open private-log :direction :output
+ :if-exists :append
+ :if-does-not-exist :create))
+ :unknown-log-stream (when unknown-log
+ (open unknown-log :direction :output
+ :if-exists :append
+ :if-does-not-exist :create))
:unichannel (is-unichannel-output output))))
(unless *daemon-monitor-process*
(setq *daemon-monitor-process* (cl-irc::start-process 'daemon-monitor "logger-monitor")))
(let ((logger (find-logger-with-nick nick)))
(cond
((null logger)
- (warn "No active connection found with nick ~A." nick)
+ (warn
+ "~A No active connection found with nick ~A [remove-logger].~%"
+ (format-date-time (get-universal-time))
+ nick)
nil)
(t
(ignore-errors (irc:quit (connection logger) ""))
(let ((c (connection logger)))
(when c
(ignore-errors (remove-channel c (find-channel c (name channel)))))))
+ (when (private-log-stream logger)
+ (close (private-log-stream logger)))
+ (when (unknown-log-stream logger)
+ (close (unknown-log-stream logger)))
+
(setq *loggers*
(delete nick *loggers* :test #'string-equal :key #'nickname))
t))))
(defun add-logger (nick server &key channels output (password "")
- realname username
- (logging-stream t) (async t) (formats '(:text)))
+ realname username private-log unknown-log
+ (logging-stream t) (async t)
+ (formats '(:text)))
(when (find-logger-with-nick nick)
- (warn "Closing previously active connection.")
+ (format
+ (get-private-log-stream (find-logger-with-nick nick))
+ "~A Closing previously active connection [add-logger].~%"
+ (format-date-time (get-universal-time)))
(ignore-errors (remove-logger nick)))
(let ((logger (create-logger nick server :channels channels :output output
:logging-stream logging-stream :password password
:realname realname :username username
+ :private-log private-log
+ :unknown-log unknown-log
:formats formats
:async async)))
(push logger *loggers*)
(start-logger logger async)
logger))
-
+
(defun add-channel-logger (logger channel-name)
(cond
((find-channel-with-name logger channel-name)
- (warn "Channel ~A already in logger ~A." channel-name logger)
+ (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))
nil)
(t
(let ((channel (make-a-channel channel-name (formats logger) (user-output logger))))
:test #'string-equal))
t)
(t
- (warn "Channel name ~A not found in logger ~A."
- channel-name logger)
+ (format
+ (get-private-log-stream logger)
+ "~A Channel name ~A not found in logger ~A.~%"
+ (format-date-time (get-universal-time))
+ channel-name logger)
nil))))
(defun add-hook-logger (logger class hook)
(when (and (stringp target)
(string-equal target (nickname logger)))
(setf (warning-message-utime logger) (received-time msg)))
- (output-event msg :kill nil (format nil "~{~A~^ ~}" (arguments 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))))
(defun error-hook (msg)
(let ((text (trailing-argument msg))
(format-date-time (get-universal-time)))))
(defun log-reconnection (logger)
- (log-daemon-message logger
- "Connection restablished at ~A." (format-date-time (get-universal-time))))
+ (log-daemon-message
+ logger
+ "Connection restablished at ~A." (format-date-time (get-universal-time))))
(defun is-connected (logger)
(when (ignore-errors (ping (connection logger) (server logger)))
(let (*recon-nick* *recon-server* *recon-username* *recon-realname*
- *recon-user-output*
+ *recon-user-output* *recon-private-log* *recon-unknown-log*
*recon-formats* *recon-async* *recon-logging-stream* *recon-channel-names*)
(declare (special *recon-nick* *recon-server* *recon-username* *recon-realname*
*recon-formats* *recon-password* *recon-async*
- *recon-user-output*
+ *recon-user-output* *recon-private-log* *recon-unknown-log*
*recon-logging-stream* *recon-channel-names*))
(defun attempt-reconnection (logger)
*recon-password* (password logger)
*recon-async* (async logger)
*recon-user-output* (user-output logger)
+ *recon-private-log* (private-log logger)
+ *recon-unknown-log* (unknown-log logger)
*recon-formats* (formats logger)
*recon-logging-stream* (logging-stream logger)
*recon-channel-names* (channel-names logger))
(ignore-errors (remove-logger 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*
- :async *recon-async*
- :formats *recon-formats*)))
+ (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)))))
+
)
(defun daemon-monitor ()
((or (>= i 20) (some (lambda (logger) (warning-message-utime logger)) *loggers*)))
(daemon-sleep 15)))))
+
+
projects / irc-logger.git / commitdiff