From: Kevin M. Rosenberg Date: Thu, 1 Jan 2004 08:12:21 +0000 (+0000) Subject: r8436: add monitor process for restarting any failed connection X-Git-Tag: v0.9.3~37 X-Git-Url: http://git.kpe.io/?p=irc-logger.git;a=commitdiff_plain;h=03c73840ef9a1ddec27b24c12610151fd6f0e0e8 r8436: add monitor process for restarting any failed connection --- diff --git a/debian/changelog b/debian/changelog index 0a97e0e..5f8fff5 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,3 +1,9 @@ +cl-irc-logger (0.5-1) unstable; urgency=low + + * Added background monitor + + -- Kevin M. Rosenberg Thu, 1 Jan 2004 01:02:40 -0700 + cl-irc-logger (0.4-1) unstable; urgency=low * Fix bug with :mode event diff --git a/logger.lisp b/logger.lisp index 3aab458..28c3436 100644 --- a/logger.lisp +++ b/logger.lisp @@ -6,6 +6,8 @@ o;;; -*- Mode: Lisp -*- (in-package irc-logger) +(defvar *daemon-monitor-process* nil "Process of background monitor.") + (defclass channel () ((name :initarg :name :reader name :documentation "Name of channel.") @@ -26,6 +28,14 @@ o;;; -*- Mode: Lisp -*- :documentation "Nickname's nickserver password.") (server :initarg :server :reader server :documentation "Connected IRC server.") + (channel-names :initarg :channel-names :accessor channel-names + :documentation "List of channel names.") + (realname :initarg :realname :reader realname + :documentation "Realname for cl-irc") + (username :initarg :username :reader username + :documentation "Username for cl-irc") + (logging-stream :initarg :logging-stream :reader logging-stream + :documentation "logging-stream for cl-irc.") (channels :initarg :channels :accessor channels :documentation "List of channels.") (user-output :initarg :user-output :reader user-output @@ -35,7 +45,10 @@ o;;; -*- Mode: Lisp -*- :documentation "T if user-output is directory for individual channel output.") (formats :initarg :formats :reader formats :documentation - "A list of output formats."))) + "A list of output formats.") + (warning-message-utime :initform nil :accessor warning-message-utime + :documentation + "Time of last, potentially active, warning message."))) (defvar *loggers* nil "List of active loggers.") @@ -167,6 +180,13 @@ o;;; -*- Mode: Lisp -*- (setf (get-stream channel istream) (open (user-output logger) :direction :output :if-exists :append))))))) +(defun format-date-time (utime) + (multiple-value-bind + (second minute hour day-of-month month year day-of-week daylight-p zone) + (decode-universal-time utime) + (declare (ignore day-of-week daylight-p zone)) + (format nil "~4,'0D/~2,'0D/~2,'0D ~2,'0D:~2,'0D:~2,'0D" year month day-of-month hour minute second))) + (defun format-utime (utime) (multiple-value-bind (second minute hour day-of-month month year day-of-week daylight-p zone) @@ -174,7 +194,7 @@ o;;; -*- Mode: Lisp -*- (declare (ignore day-of-month month year day-of-week daylight-p zone)) (format nil "~2,'0D:~2,'0D:~2,'0D" hour minute second))) -(defun format-utime-short(utime) +(defun format-utime-short (utime) (multiple-value-bind (second minute hour day-of-month month year day-of-week daylight-p zone) (decode-universal-time utime) @@ -206,6 +226,8 @@ o;;; -*- Mode: Lisp -*- (defun last-sexp-field (type msg) (cond + ((null msg) + nil) ((eq type :kick) (trailing-argument msg)) ((need-user-address? type) @@ -224,7 +246,7 @@ o;;; -*- Mode: Lisp -*- (when (and (null unichannel) channel) (format stream "[~A] " channel)) - (let ((user-address (when (need-user-address? type) (user-address msg)))) + (let ((user-address (when (and msg (need-user-address? type)) (user-address msg)))) (case type (:privmsg (format stream "<~A> ~A" source text)) @@ -246,6 +268,12 @@ o;;; -*- Mode: Lisp -*- (format stream "-!- ~A changed the topic of ~A to: ~A" source channel text)) (:notice (format stream "-~A:~A- ~A" source channel text)) + (:daemon + (format stream "-!!!- ~A" text)) + (:server + (format stream "-!!!- server send message ~A" source channel text)) + (:unhandled + (format stream "-!!!- ~A" text)) (t (warn "Unhandled msg type ~A." type)))) (write-char #\Newline stream)) @@ -257,6 +285,17 @@ o;;; -*- Mode: Lisp -*- (unichannel logger)) (force-output (get-stream channel istream))) +(defun log-daemon-message (logger fmt &rest args) + (let ((text (apply #'format nil fmt args)) + (time (get-universal-time))) + (dolist (channel (channels logger)) + (dotimes (istream (formats logger)) + (ensure-output-stream time logger channel istream) + (%output-event (get-format logger istream) (get-stream channel istream) + time :daemon nil nil text nil + (unichannel logger)) + (force-output (get-stream channel istream)))))) + (defvar *msg*) (defun output-event (msg type channel-name &optional text) (setq *msg* msg) @@ -274,6 +313,10 @@ o;;; -*- Mode: Lisp -*- (when channel (dotimes (i (length (formats logger))) (output-event-for-a-stream msg type channel text logger i)))))) + (:server + (dolist (channel (channels logger)) + (dotimes (i (length (formats logger))) + (output-event-for-a-stream msg type channel text logger i)))) (t (let* ((channel (find-channel-with-name logger channel-name))) (when channel @@ -349,7 +392,7 @@ o;;; -*- Mode: Lisp -*- (setq formats (list formats))) (if (stringp output) (setq output (parse-namestring output))) - (let* ((conn (connect :nickname nick :server server + (let* ((conn (connect :nickname nick :server server :username username :realname realname :logging-stream logging-stream)) (logger (make-instance @@ -359,6 +402,10 @@ o;;; -*- Mode: Lisp -*- :password password :server server :channels (make-channels channels formats output) + :channel-names channels + :username username + :realname realname + :logging-stream logging-stream :user-output output :formats formats :unichannel (is-unichannel-output output)))) @@ -374,6 +421,10 @@ o;;; -*- Mode: Lisp -*- (add-hook conn 'irc::irc-mode-message 'mode-hook) (add-hook conn 'irc::irc-topic-message 'topic-hook) (add-hook conn 'irc::irc-notice-message 'notice-hook) + (add-hook conn 'irc::irc-rpl_killdone-message 'warning-hook) + (add-hook conn 'irc::irc-rpl_closing-message 'warning-hook) + (unless *daemon-monitor-process* + (setq *daemon-monitor-process* (cl-irc::start-process 'daemon-monitor "logger-monitor"))) logger)) (defun start-logger (logger async) @@ -423,7 +474,8 @@ o;;; -*- Mode: Lisp -*- (t (let ((channel (make-a-channel channel-name (formats logger) (user-output logger)))) (join (connection logger) channel-name) - (push channel (channels logger)))))) + (push channel (channels logger)) + (push channel-name (channel-names logger)))))) (defun remove-channel-logger (logger channel-name) (let ((channel (find-channel-with-name logger channel-name))) @@ -437,6 +489,8 @@ o;;; -*- Mode: Lisp -*- (setf (channels logger) (delete channel-name (channels logger) :test #'string-equal :key #'name)) + (setf (channel-names logger) (delete channel-name (channel-names logger) + :test #'string-equal)) t) (t (warn "Channel name ~A not found in logger ~A." @@ -449,17 +503,62 @@ o;;; -*- Mode: Lisp -*- (defun remove-hook-logger (logger class hook) (remove-hook (connection logger) class hook)) -;; before disconnect, server usually sends something like -;; -;; Closing Link: nick[ipaddr or hostname] by servername (reason) -;; some other reasons are: "G-lined", "K-lined", and "Your host is -;; trying to (re)connect too fast -- throttled" -;; -;; reconnect should wait 30 sec depending upon the throttle -;; -;; avoid too many reconnect messages in the logs -;; -;; grep'ing around the net-nittin-ir source, it looks like 361 -;; rpl_killdone and 362 rpl_closing may refer to the closing link -;; error i mention, as in, modern ircds may use numerics for such -;; logging of unhandled numerics is good to do also +(defvar *warning-message-utime* nil) + +(defun warning-hook (msg) + (let ((logger (find-logger-with-connection (connection msg)))) + (output-event msg :server + (format nil "~{~A~^ ~} ~A)" + (arguments msg) + (trailing-argument msg))) + (when logger + (setf (warning-message-utime logger) (get-universal-time))))) + +(defun daemon-sleep (seconds) + #-allegro (sleep seconds) + #+allegro (mp:process-sleep seconds)) + +(defun log-disconnection (logger) + ;; avoid generating too many reconnect messages in the logs + (when (< (- (get-universal-time) (warning-message-utime logger)) 300) + (log-daemon-message logger "Disconnected. Attempting reconnection at ~A." + (format-date-time (get-universal-time))))) + +(defun log-reconnection (logger) + (log-daemon-message logger + "Connection restablished at ~A." (format-date-time (get-universal-time)))) + +(defun attempt-reconnection (logger) + (log-disconnection logger) + (setf (connection logger) nil) + (let ((connection (connect :nickname (nickname logger) + :server (server logger) + :channel-names (channel-names logger) + :username (username logger) + :realname (realname logger) + :logging-stream (logging-stream logger)))) + (when (and connection (cl-irc::connectedp connection)) + (setf (connection logger) connection) + (log-reconnection logger) + t))) + +(defun daemon-monitor () + "This function runs in the background and monitors the connection of the logger." + ;; run forever + (do () + () + (dolist (logger *loggers*) + (do ((conn (connection logger)) + (warning-time (warning-message-utime logger) (warning-message-utime logger))) + (warning-time) + (cond + ((> (- (get-universal-time) warning-time) 180) + ;;give up frequent checking because no disconnection despite waiting + (setf (warning-message-utime logger) nil)) + ((not (cl-irc::connectedp conn)) + (unless warning-time + (setf (warning-message-utime logger) (get-universal-time))) + (attempt-reconnection logger)) + (t + (daemon-sleep 30))))) + (daemon-sleep 600)))