r8779: fix remove-channel call for new arguments signature

[irc-logger.git] / logger.lisp

diff --git a/logger.lisp b/logger.lisp
index deb4ba5c8f9f2488de3ec32494d1b14a37cbbf3a..f186916eef3175e2472aebf091072bd21a807011 100644 (file)
--- a/logger.lisp
+++ b/logger.lisp
@@ -4,7 +4,7 @@
 ;;;; Purpose: A IRC logging bot 
 ;;;; Author:  Kevin Rosenberg
 
-(in-package irc-logger)
+(in-package #:irc-logger)
 
 (defvar *daemon-monitor-process* nil "Process of background monitor.")
 
@@ -360,11 +360,16 @@
     *standard-output*))
 
 (defun add-log-entry (stream fmt &rest args)
-  (format-date-time (get-universal-time) :stream stream)
-  (write-char #\space stream)
-  (apply #'format stream fmt args)
-  (write-char #\newline stream)
-  (force-output stream))
+  (handler-case 
+      (progn
+       (format-date-time (get-universal-time) :stream stream)
+       (write-char #\space stream)
+       (apply #'format stream fmt args)
+       (write-char #\newline stream)
+       (force-output stream))
+    (error (e)
+     (warn "Error ~A when trying to add-log-entry '~A'." e
+          (apply #'format nil fmt args)))))
 
 (defun add-private-log-entry (logger fmt &rest args)
   (apply #'add-log-entry (get-private-log-stream logger) fmt args))
@@ -402,6 +407,7 @@
     (output-event msg :kick channel who-kicked)
     (when (string-equal (nickname logger) who-kicked)
       (add-private-log-entry
+       logger
        "Logging daemon ~A has been kicked from ~A (~A)"
        (nickname logger) channel (trailing-argument msg))
       (daemon-sleep 1)
@@ -529,6 +535,7 @@
       (t
        (add-log-entry
        (get-unknown-log-stream (find-logger-with-connection (connection msg)))
+       "~A"
        (raw-message-string msg))))
     result))
 
@@ -592,13 +599,16 @@
        nick)
        nil)
       (t
-       (ignore-errors (irc:quit (connection logger) ""))
-       (stop-background-message-handler (handler logger))
+       (ignore-errors (quit-with-timeout (connection logger) ""))
+       (ignore-errors (stop-background-message-handler (handler logger)))
        (sleep 1)
-       (dolist (channel (channels logger))
-        (let ((c (connection logger)))
-          (when c
-            (ignore-errors (remove-channel c (find-channel c (name channel)))))))
+       (ignore-errors
+        (let* ((c (connection logger))
+               (user (find-user c (nickname logger))))
+          (when (and c user)
+            (dolist (channel (channels logger))
+              (remove-channel user channel)))))
+       (ignore-errors (add-private-log-entry logger "Deleting loggers with nick of '~A' [remove-logger]." nick))
        (when (private-log-stream logger)
         (close (private-log-stream logger)))
        (when (unknown-log-stream logger)
@@ -708,11 +718,18 @@
 (defun is-connected (logger)
   (%is-connected logger))
 
+(defparameter *timeout* 60)
+
 (defun is-connected (logger)
   #-allegro (%is-connected logger)
-  #+allegro (mp:with-timeout (60 nil)
+  #+allegro (mp:with-timeout (*timeout* nil)
              (%is-connected logger)))
 
+(defun quit-with-timeout (connection msg)
+  #-allegro (quit connection msg)
+  #+allegro (mp:with-timeout (*timeout* nil)
+             (quit connection msg)))
+
 (defun %is-connected (logger)
   (when (ignore-errors (ping (connection logger) (server logger)))
     (dotimes (i 20)
@@ -736,7 +753,7 @@
     
     (log-disconnection logger)
     (when (connection logger)
-      (ignore-errors (quit (connection logger) "Client terminated by server"))
+      (ignore-errors (quit-with-timeout (connection logger) "Client terminated by server"))
       (setf *recon-nick* (nickname logger)
            *recon-server* (server logger)
            *recon-username* (username logger)
@@ -774,28 +791,30 @@
 (defun daemon-monitor ()
   "This function runs in the background and monitors the connection of the logger."
   ;; run forever
-  (do ()
-      ()
-    (block main-loop
-      (dolist (logger *loggers*)
-       (do ((warning-time (warning-message-utime logger) (warning-message-utime logger)))
-           ((or (is-connected logger) (null warning-time)))
-         (cond
-          ((and warning-time (> (- (get-universal-time) warning-time) 180))
-           ;;give up frequent checking because no disconnection despite waiting
-           (setf (warning-message-utime logger) nil))
-          ((not (is-connected logger))
-           (unless warning-time
-             (setf (warning-message-utime logger) (get-universal-time)))
-           (attempt-reconnection logger)
-           ;;after a succesful reconnection, the value of logger will be invalid 
-           (sleep 30)
-           (return-from main-loop))
-          (t
-           (daemon-sleep 30)))))
-      (do ((i 0 (1+ i)))
-         ((or (>= i 20) (some (lambda (logger) (warning-message-utime logger)) *loggers*))) 
-       (daemon-sleep 15)))))
-  
+  (loop
+   do
+   (monitor-once)))
+
+(defun monitor-once ()
+  (dolist (logger *loggers*)
+    (do ((warning-time (warning-message-utime logger) (warning-message-utime logger)))
+       ((and (is-connected logger) (null warning-time)))
+      (cond
+       ((and warning-time (> (- (get-universal-time) warning-time) 180))
+        ;;give up frequent checking because no disconnection despite waiting
+        (setf (warning-message-utime logger) nil))
+       ((not (is-connected logger))
+        (unless warning-time
+          (setf (warning-message-utime logger) (get-universal-time)))
+        (attempt-reconnection logger)
+        ;;after a succesful reconnection, the value of logger will be invalid 
+        (sleep 30)
+        (return-from monitor-once))
+       (t
+        (daemon-sleep 30)))))
+  (do ((i 0 (1+ i)))
+      ((or (>= i 10) (some (lambda (logger) (warning-message-utime logger)) *loggers*))) 
+    (daemon-sleep 15)))
+