Update domain name to kpe.io

[irc-logger.git] / logger.lisp

diff --git a/logger.lisp b/logger.lisp
index 72ad502823d87590cb292d4e48435d26d1e23644..a50e1be82eade7c0bd299011ee56349687270dd6 100644 (file)
--- 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*