X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=logger.lisp;h=3aab458ec665fc7ca826c8b2d8fc4bfe003c5856;hb=5b8c953c38b5a88cfd01c100dbace7ae04dd4c0c;hp=a1b8f5b2be15b62d2dcce262d8ff7c9674a63068;hpb=c12932912e292d322e6451aa4357c48863a8ecc0;p=irc-logger.git diff --git a/logger.lisp b/logger.lisp index a1b8f5b..3aab458 100644 --- a/logger.lisp +++ b/logger.lisp @@ -1,4 +1,4 @@ -;;;; -*- Mode: Lisp -*- +o;;; -*- Mode: Lisp -*- ;;;; $Id: logger.lisp,v 1.11 2003/12/16 21:19:56 krosenberg Exp $ ;;;; ;;;; Purpose: A IRC logging bot @@ -18,13 +18,15 @@ (defclass logger () ((connection :initarg :connection :reader connection :documentation "IRC connection object.") + (handler :initform nil :accessor handler + :documentation "Background handler process.") (nick :initarg :nick :reader nickname :documentation "Nickname of the bot.") (password :initarg :password :reader password :documentation "Nickname's nickserver password.") (server :initarg :server :reader server :documentation "Connected IRC server.") - (channels :initarg :channels :reader channels + (channels :initarg :channels :accessor channels :documentation "List of channels.") (user-output :initarg :user-output :reader user-output :documentation @@ -50,9 +52,15 @@ (defun find-logger-with-connection (conn) (find conn (the list *loggers*) :test #'eq :key #'connection)) +(defun canonicalize-channel-name (name) + (string-left-trim '(#\#) name)) + +(defun find-channel-with-name (logger name) + (find name (the list (channels logger)) :test #'string-equal :key #'name)) + (defun make-output-name (name year month day) - (format nil "~A-~4,'0D.~2,'0D.~2,'0D" - (string-left-trim '(#\#) name) year month day)) + (format nil "~A-~4,'0D.~2,'0D.~2,'0D" (canonicalize-channel-name name) + year month day)) (defun make-output-name-utime (name utime) (multiple-value-bind @@ -95,6 +103,9 @@ (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")) +(defmethod log-file-path (output-root channel-name year month day (format string)) + (%log-file-path output-root channel-name year month day format)) + (defun log-file-path-utime (output-root channel-name format utime) (multiple-value-bind @@ -193,13 +204,19 @@ (format stream "~S~%" (string-right-trim '(#\return) (raw-message-string msg)))) +(defun last-sexp-field (type msg) + (cond + ((eq type :kick) + (trailing-argument msg)) + ((need-user-address? type) + (user-address msg)))) + (defmethod %output-event ((format (eql :sexp)) stream utime type channel source text msg unichannel) (if unichannel - (format stream "(~S ~S ~S ~S ~S)~%" utime type source text - (when (need-user-address? type) (user-address msg))) - (format stream "(~S ~S ~S ~S ~S ~S)~%" utime type source channel - text (when (need-user-address? type) (user-address msg))))) + (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) @@ -222,7 +239,7 @@ (:kick (format stream "-!- ~A [~A] has been kicked from ~A" source user-address channel)) (:quit - (format stream "-!- ~A [~A] has quit [~A]" source user-address text)) + (format stream "-!- ~A [~A] has quit [~A]" source user-address (if text text ""))) (:mode (format stream "-!- ~A has set mode ~A" source text)) (:topic @@ -240,16 +257,25 @@ (unichannel logger)) (force-output (get-stream channel istream))) +(defvar *msg*) (defun output-event (msg type channel-name &optional text) + (setq *msg* msg) (dolist (logger *loggers*) (case type ((:quit :nick) - (dolist (channel (channels logger)) - (dotimes (i (length (formats logger))) - (output-event-for-a-stream msg type channel text logger i)))) + (let* ((user (find-user (connection logger) + (case type + (:nick (source msg)) + (:quit (source msg))))) + (channels (when user (cl-irc::channels user)))) + (dolist (channel (mapcar + #'(lambda (name) (find-channel-with-name logger name)) + (mapcar #'cl-irc::name channels))) + (when channel + (dotimes (i (length (formats logger))) + (output-event-for-a-stream msg type channel text logger i)))))) (t - (let* ((channel (find channel-name (the list (channels logger)) - :test #'string-equal :key #'name))) + (let* ((channel (find-channel-with-name logger channel-name))) (when channel (dotimes (i (length (formats logger))) (output-event-for-a-stream msg type channel text logger i)))))))) @@ -269,7 +295,7 @@ (output-event msg :part (first (arguments msg)))) (defun quit-hook (msg) - (output-event msg :quit (trailing-argument msg))) + (output-event msg :quit nil (trailing-argument msg))) (defun join-hook (msg) (output-event msg :join (trailing-argument msg))) @@ -290,37 +316,41 @@ (output-event msg :topic (first (arguments msg)) (trailing-argument msg))) (defun mode-hook (msg) - (output-event msg :mode (first (arguments msg)))) - + (output-event msg :mode (first (arguments msg)) + (format nil "~{~A~^ ~}" (cdr (arguments msg))))) + +(defun make-a-channel (name formats output) + (make-instance 'channel + :name name + :streams (make-array (length formats) :initial-element nil) + :output-root (when (and (pathnamep output) + (null (pathname-name output))) + output) + :current-output-names (make-array (length formats) + :initial-element nil))) + (defun make-channels (names formats output) (loop for i from 0 to (1- (length names)) - collect - (make-instance 'channel - :name (nth i names) - :streams (make-array (length formats) :initial-element nil) - :output-root (when (and (pathnamep output) - (null (pathname-name output))) - output) - :current-output-names (make-array (length formats) - :initial-element nil)))) + collect (make-a-channel (elt names i) formats output))) (defun is-unichannel-output (user-output) "Returns T if output is setup for a single channel directory structure." (and (pathnamep user-output) (null (pathname-name user-output)))) (defun create-logger (nick server &key channels output password - (logging-stream t) (formats '(:text))) + realname username + (logging-stream t) (formats '(:text))) "OUTPUT may be a pathname or a stream" ;; check arguments - (assert channels) (assert formats) - (if (atom channels) + (if (and channels (atom channels)) (setq channels (list channels))) (if (atom formats) (setq formats (list formats))) (if (stringp output) (setq output (parse-namestring output))) (let* ((conn (connect :nickname nick :server server + :username username :realname realname :logging-stream logging-stream)) (logger (make-instance 'logger @@ -348,10 +378,11 @@ (defun start-logger (logger async) (if async - (start-background-message-handler (connection logger)) + (setf (handler logger) + (start-background-message-handler (connection logger))) (read-message-loop (connection logger)))) -(defun quit-logger (nick) +(defun remove-logger (nick) "Quit the active connection with nick and remove from active list." (let ((logger (find-logger-with-nick nick))) (cond @@ -360,30 +391,75 @@ nil) (t (irc:quit (connection logger)) + (stop-background-message-handler (handler logger)) (sleep 1) (dolist (channel (channels logger)) - (dotimes (i (length (streams channel))) - (when (streamp (get-stream channel i)) - (close (get-stream channel i)) - (setf (get-stream channel i) nil)))) + (let ((c (connection logger))) + (when c + (ignore-errors (remove-channel c (find-channel c (name channel))))))) (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))) (when (find-logger-with-nick nick) (warn "Closing previously active connection.") - (quit-logger nick)) + (remove-logger nick)) (let ((logger (create-logger nick server :channels channels :output output :logging-stream logging-stream :password password + :realname realname :username username :formats formats))) (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) + nil) + (t + (let ((channel (make-a-channel channel-name (formats logger) (user-output logger)))) + (join (connection logger) channel-name) + (push channel (channels logger)))))) + +(defun remove-channel-logger (logger channel-name) + (let ((channel (find-channel-with-name logger channel-name))) + (cond + (channel + (part (connection logger) channel-name) + (dotimes (i (length (streams channel))) + (when (streamp (get-stream channel i)) + (close (get-stream channel i)) + (setf (get-stream channel i) nil))) + (setf (channels logger) (delete channel-name (channels logger) + :test #'string-equal + :key #'name)) + t) + (t + (warn "Channel name ~A not found in logger ~A." + channel-name logger) + nil)))) + (defun add-hook-logger (logger class hook) (add-hook (connection logger) class hook)) (defun remove-hook-logger (logger class hook) (remove-hook (connection logger) class hook)) + +;; before disconnect, server usually sends something like +;; +;; Closing Link: nick[ipaddr or hostname] by servername (reason) +;; some other reasons are: "G-lined", "K-lined", and "Your host is +;; trying to (re)connect too fast -- throttled" +;; +;; reconnect should wait 30 sec depending upon the throttle +;; +;; avoid too many reconnect messages in the logs +;; +;; grep'ing around the net-nittin-ir source, it looks like 361 +;; rpl_killdone and 362 rpl_closing may refer to the closing link +;; error i mention, as in, modern ircds may use numerics for such +;; logging of unhandled numerics is good to do also