X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=logger.lisp;h=f186916eef3175e2472aebf091072bd21a807011;hb=460aef96a391eae776da6a28929d6c4fcdc43e31;hp=14294517eca26b1827a6f374aad079c33c88d02d;hpb=0f9d06416786a978c616fbdfdfef871c29e310a6;p=irc-logger.git diff --git a/logger.lisp b/logger.lisp index 1429451..f186916 100644 --- a/logger.lisp +++ b/logger.lisp @@ -599,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) @@ -722,7 +725,7 @@ #+allegro (mp:with-timeout (*timeout* nil) (%is-connected logger))) -(defun quit-maybe-timeout (connection msg) +(defun quit-with-timeout (connection msg) #-allegro (quit connection msg) #+allegro (mp:with-timeout (*timeout* nil) (quit connection msg))) @@ -750,7 +753,7 @@ (log-disconnection logger) (when (connection logger) - (ignore-errors (quit-maybe-timeout (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) @@ -790,26 +793,28 @@ ;; run forever (loop 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))))) - + (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))) +