X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=logger.lisp;h=a50e1be82eade7c0bd299011ee56349687270dd6;hb=refs%2Fheads%2Fmaster;hp=72ad502823d87590cb292d4e48435d26d1e23644;hpb=6fbf5b37e581612fb1beb88f92684affcb5c6cdb;p=irc-logger.git diff --git a/logger.lisp b/logger.lisp index 72ad502..a50e1be 100644 --- a/logger.lisp +++ b/logger.lisp @@ -7,7 +7,7 @@ (in-package #:irc-logger) (defvar *daemon-monitor-process* nil "Process of background monitor.") -(defparameter *timeout* 60) +(defparameter *timeout* 120) (defclass log-channel () ((name :initarg :name :reader c-name @@ -29,6 +29,8 @@ :documentation "Nickname's nickserver password.") (server :initarg :server :reader server :documentation "Connected IRC server.") + (port :initarg :port :reader port + :documentation "Connected IRC server's port.") (channel-names :initarg :channel-names :accessor channel-names :documentation "List of channel names.") (realname :initarg :realname :reader l-realname @@ -505,8 +507,9 @@ "Returns T if output is setup for a single channel directory structure." (and (pathnamep user-output) (null (pathname-name user-output)))) -(defun do-connect-and-join (nick server username realname logging-stream channels) - (let ((conn (connect :nickname nick :server server +(defun do-connect-and-join (nick server port username realname logging-stream channels) + (unless port (setq port 6667)) + (let ((conn (connect :nickname nick :server server :port port :username username :realname realname :logging-stream logging-stream))) (mapc #'(lambda (channel) (join conn channel)) channels) @@ -533,8 +536,8 @@ (add-hook conn 'irc::irc-rpl_topicwhotime-message 'rpl_topicwhotime-hook) conn)) -(defmethod cl-irc::irc-message-event :around ((msg cl-irc::irc-message)) - (let ((result (call-next-method msg))) +(defmethod cl-irc::irc-message-event :around (connection (msg cl-irc::irc-message)) + (let ((result (call-next-method connection 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 @@ -550,12 +553,12 @@ ) (t (add-log-entry - (get-unknown-log-stream (find-logger-with-connection (connection msg))) + (get-unknown-log-stream (find-logger-with-connection connection)) "~A" (raw-message-string msg)))) result)) -(defun create-logger (nick server &key channels output password +(defun create-logger (nick server &key (port 6667) channels output password realname username async private-log unknown-log (logging-stream t) (formats '(:text))) @@ -568,13 +571,14 @@ (setq formats (list formats))) (if (stringp output) (setq output (parse-namestring output))) - (let* ((conn (do-connect-and-join nick server username realname logging-stream channels)) + (let* ((conn (do-connect-and-join nick server port username realname logging-stream channels)) (logger (make-instance 'logger :connection conn :nick nick :password password :server server + :port port :channels (make-channels channels formats output) :channel-names channels :username username @@ -634,7 +638,7 @@ (delete nick *loggers* :test #'string-equal :key #'l-nickname)) t)))) -(defun add-logger (nick server &key channels output (password "") +(defun add-logger (nick server &key (port 6667) channels output (password "") realname username private-log unknown-log (logging-stream t) (async t) (formats '(:sexp))) @@ -645,24 +649,27 @@ (add-private-log-entry nil "Calling create-logger [add-logger].~%") (let ((logger (do ((new-logger - (#-sbcl mp:with-timeout #-sbcl (*timeout* nil) - #+sbcl sb-ext:with-timeout #+sbcl *timeout* - (create-logger nick server :channels channels :output output + (#+allegro mp:with-timeout #+allegro (*timeout* nil) + #+sbcl sb-ext:with-timeout #+sbcl *timeout* + #+lispworks progn + (create-logger nick server :port port :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)) - (#-sbcl mp:with-timeout #-sbcl (*timeout* nil) - #+sbcl sb-ext:with-timeout #+sbcl *timeout* - (create-logger nick server :channels channels :output output + (#+allegro mp:with-timeout #+allegro (*timeout* nil) + #+sbcl sb-ext:with-timeout #+sbcl *timeout* + #+lispworks progn + (create-logger nick server :port port :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)))) + (new-logger (progn (add-private-log-entry nil "Acquired new logger ~A." new-logger) @@ -775,10 +782,10 @@ (daemon-sleep 1)))) -(let (*recon-nick* *recon-server* *recon-username* *recon-realname* +(let (*recon-nick* *recon-server* *recon-port* *recon-username* *recon-realname* *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* + (declare (special *recon-nick* *recon-server* *recon-port* *recon-username* *recon-realname* *recon-formats* *recon-password* *recon-async* *recon-user-output* *recon-private-log* *recon-unknown-log* *recon-logging-stream* *recon-channel-names*)) @@ -792,6 +799,7 @@ (ignore-errors (quit-with-timeout (connection logger) "Client terminated by server")) (setf *recon-nick* (l-nickname logger) *recon-server* (server logger) + *recon-port* (port logger) *recon-username* (l-username logger) *recon-realname* (l-realname logger) *recon-password* (password logger) @@ -809,6 +817,7 @@ (setq new-logger (ignore-errors (add-logger *recon-nick* *recon-server* + :port *recon-port* :channels *recon-channel-names* :output *recon-user-output* :password *recon-password*