X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=logger.lisp;h=7baa2415d8a227a1a54e0c781d53bac067d76e7b;hb=d2506e00f04b101331b460806d23cb47364ebec5;hp=e0da56a665a345e32f28c42b6f7aba33eb884d22;hpb=5bce8846ed56d86d07b41f5fcb27e2630d82c4e1;p=irc-logger.git diff --git a/logger.lisp b/logger.lisp index e0da56a..7baa241 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 @@ -20,9 +20,11 @@ :documentation "IRC connection object.") (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 @@ -45,9 +47,18 @@ (defun find-logger-with-nick (nick) (find nick (the list *loggers*) :test #'string-equal :key #'nickname)) +(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 @@ -217,7 +228,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 @@ -243,8 +254,7 @@ (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)))))))) @@ -264,7 +274,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))) @@ -273,38 +283,45 @@ (output-event msg :kick (first (arguments msg)))) (defun notice-hook (msg) - (output-event msg :notice (first (arguments msg)) (trailing-argument 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)))) (defun topic-hook (msg) (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 - (logging-stream t) - (formats '(:text))) +(defun create-logger (nick server &key channels output password + (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))) @@ -316,6 +333,7 @@ 'logger :connection conn :nick nick + :password password :server server :channels (make-channels channels formats output) :user-output output @@ -337,10 +355,10 @@ (defun start-logger (logger async) (if async - (read-message-loop-background (connection logger)) - (read-message-loop (connection 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 @@ -351,28 +369,51 @@ (irc:quit (connection 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)))) + (remove-channel logger (name channel))) (setq *loggers* (delete nick *loggers* :test #'string-equal :key #'nickname)) t)))) -(defun add-logger (nick server &key channels output - (logging-stream t) - (async t) - (formats '(:text))) +(defun add-logger (nick server &key channels output (password "") + (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 + :logging-stream logging-stream :password password :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))