;;;; 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.")
(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)
(t
(add-log-entry
(get-unknown-log-stream (find-logger-with-connection (connection msg)))
+ "~A"
(raw-message-string msg))))
result))
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 (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)
#+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)))
(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)
(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)))
+