X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=logger.lisp;h=16a47aff2e5336703a96456c2aba9f48803629ce;hb=f4a678d829c00ccfe0703b18a150332a4520bd85;hp=28c3436ec1b3e043b44134ed91dd1bacd8d04a7a;hpb=03c73840ef9a1ddec27b24c12610151fd6f0e0e8;p=irc-logger.git

diff --git a/logger.lisp b/logger.lisp
index 28c3436..16a47af 100644
--- a/logger.lisp
+++ b/logger.lisp
@@ -1,4 +1,4 @@
-o;;;  -*- Mode: Lisp -*-
+;;;  -*- Mode: Lisp -*-
 ;;;; $Id: logger.lisp,v 1.11 2003/12/16 21:19:56 krosenberg Exp $
 ;;;;
 ;;;; Purpose: A IRC logging bot 
@@ -18,7 +18,7 @@ o;;;  -*- Mode: Lisp -*-
 
    
 (defclass logger ()
-  ((connection :initarg :connection :reader connection
+  ((connection :initarg :connection :accessor connection
 	       :documentation "IRC connection object.")
    (handler :initform nil :accessor handler
 	    :documentation "Background handler process.")
@@ -46,6 +46,22 @@ o;;;  -*- Mode: Lisp -*-
    (formats :initarg :formats :reader formats
 		  :documentation
 		  "A list of output formats.")
+   (async :initarg :async :reader async
+		  :documentation
+		  "Whether to use async")
+   (last-pong :initform nil :accessor last-pong
+		  :documentation
+		  "utime of last pong message")
+   (private-log :initarg :private-log :reader private-log
+		:documentation "Pathname of the private log file for the daemon.")
+   (unknown-log :initarg :unknown-log :reader unknown-log
+		:documentation "Pathname of the log file for unknown messages.")
+   (private-log-stream :initarg :private-log-stream :reader private-log-stream
+		       :documentation "Stream of the private log file for the daemon.")
+   (unknown-log-stream :initarg :unknown-log-stream :reader unknown-log-stream
+		:documentation "Stream of the log file for unknown messages.")
+   (monitor-events :initform nil :accessor monitor-events
+		   :documentation "List of events for the monitor to process.")
    (warning-message-utime :initform nil :accessor warning-message-utime
 		  :documentation
 		  "Time of last, potentially active, warning message.")))
@@ -164,7 +180,7 @@ o;;;  -*- Mode: Lisp -*-
 	  (close (get-stream channel istream)))
 	(setf (get-stream channel istream)
 	      (open path :direction :output :if-exists :append
-		    :if-does-not-exist :error))))))
+		    :if-does-not-exist :create))))))
 
 (defun ensure-output-stream (utime logger channel istream)
   "Ensures that *output-stream* is correct."
@@ -178,7 +194,8 @@ o;;;  -*- Mode: Lisp -*-
       (ensure-output-stream-for-unichannel utime logger channel istream))
      (t
       (setf (get-stream channel istream)
-	(open (user-output logger) :direction :output :if-exists :append)))))))
+	(open (user-output logger) :direction :output :if-exists :append
+	      :if-does-not-exist :create)))))))
 
 (defun format-date-time (utime)
   (multiple-value-bind
@@ -209,7 +226,11 @@ o;;;  -*- Mode: Lisp -*-
 	"")))
 
 (defun need-user-address? (type)
-  (not (or (eq :action type) (eq :privmsg type))))
+  (case type
+    ((:action :privmsg :names :rpl_topic)
+     nil)
+    (t
+     t)))
 
 (defgeneric %output-event (format stream utime type channel source text msg 
 			   unichannel))
@@ -220,9 +241,16 @@ o;;;  -*- Mode: Lisp -*-
 
 (defmethod %output-event ((format (eql :raw)) stream utime type channel source
 			  text msg unichannel)
-  (declare (ignore utime type channel source text text unichannel ))
-  (format stream "~S~%" (string-right-trim '(#\return) 
-					   (raw-message-string msg))))
+  (declare (ignore utime type channel source text text unichannel))
+  (when msg
+    (format stream "~S~%" 
+	    (string-right-trim '(#\return) (raw-message-string msg)))))
+
+(defconstant +posix-epoch+
+  (encode-universal-time 0 0 0 1 1 1970 0))
+
+(defun posix-time-to-utime (time)
+  (+ time +posix-epoch+))
 
 (defun last-sexp-field (type msg)
   (cond
@@ -230,18 +258,24 @@ o;;;  -*- Mode: Lisp -*-
     nil)
    ((eq type :kick)
     (trailing-argument msg))
+   ((eq type :rpl_topicwhotime)
+    (when (stringp (car (last (arguments msg))))
+      (let ((secs (parse-integer (car (last (arguments msg))) :junk-allowed t)))
+	(when secs
+	  (posix-time-to-utime secs)))))
    ((need-user-address? type)
     (user-address msg))))
 
 (defmethod %output-event ((format (eql :sexp)) stream utime type channel source text
 			  msg unichannel)
-  (if unichannel
-      (format stream "(~S ~S ~S ~S ~S)~%" utime type source text (last-sexp-field type msg))
-    (format stream "(~S ~S ~S ~S ~S ~S)~%" utime type source channel text
-	    (last-sexp-field type msg))))
-
-(defmethod %output-event ((format (eql :text)) stream utime type channel source text
-			  msg unichannel)
+  (with-standard-io-syntax
+    (if unichannel
+	(format stream "(~S ~S ~S ~S ~S)~%" utime type source text (last-sexp-field type msg))
+	(format stream "(~S ~S ~S ~S ~S ~S)~%" utime type source channel text
+		(last-sexp-field type msg)))))
+
+(defmethod %output-event ((format (eql :text)) stream utime type channel
+			  source text msg unichannel)
   (format stream "~A " (format-utime utime))
   (when (and (null unichannel) channel)
     (format stream "[~A] " channel))
@@ -270,12 +304,12 @@ o;;;  -*- Mode: Lisp -*-
        (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))
+      (:names
+       (format stream "-!- names: ~A" text))
+      (:rpl_topic
+       (format stream "-!- topic: ~A" text))
       (t
-     (warn "Unhandled msg type ~A." type))))
+       (warn "Unhandled msg type ~A." type))))
   (write-char #\Newline stream))
 
 (defun output-event-for-a-stream (msg type channel text logger istream)
@@ -288,10 +322,14 @@ o;;;  -*- Mode: Lisp -*-
 (defun log-daemon-message (logger fmt &rest args)
   (let ((text (apply #'format nil fmt args))
 	(time (get-universal-time)))
+    (format (get-private-log-stream logger)
+	    "~A ~A~%" (format-date-time time) text)
+    (force-output (get-private-log-stream logger))
     (dolist (channel (channels logger))
-      (dotimes (istream (formats logger))
+      (dotimes (istream (length (formats logger)))
 	(ensure-output-stream time logger channel istream)
-	(%output-event  (get-format logger istream) (get-stream 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))))))
@@ -301,7 +339,14 @@ o;;;  -*- Mode: Lisp -*-
   (setq *msg* msg)
   (dolist (logger *loggers*)
     (case type
+      ((:error :server :kill)
+       (format (get-private-log-stream logger)
+	       "~A ~A~%"
+	       (format-date-time (received-time msg))
+	       (raw-message-string msg))
+       (force-output (get-private-log-stream logger)))
       ((:quit :nick)
+       ;; send to all channels that a nickname is joined
        (let* ((user (find-user (connection logger)
 			       (case type
 				 (:nick (source msg))
@@ -313,18 +358,36 @@ 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
+       ;; msg contains channel name
        (let* ((channel (find-channel-with-name logger channel-name)))
 	 (when channel
 	   (dotimes (i (length (formats logger)))
 	     (output-event-for-a-stream msg type channel text logger i))))))))
 
+(defun get-private-log-stream (logger)
+  (if (and logger (private-log-stream logger))
+      (private-log-stream logger)
+    *standard-output*))
+
+(defun get-unknown-log-stream (logger)
+  (if (and logger (unknown-log-stream logger))
+      (unknown-log-stream logger)
+    *standard-output*))
+
 (defun privmsg-hook (msg)
-  (output-event msg :privmsg (first (arguments msg)) (trailing-argument msg)))
+  (let ((logger (find-logger-with-connection (connection msg)))
+	(channel (first (arguments msg))))
+    (cond
+     ((equal channel (nickname logger))
+      (format
+       (get-private-log-stream logger)
+       "~A ~A~%" 
+       (format-date-time (get-universal-time))
+       (raw-message-string msg))
+      (force-output (get-private-log-stream logger)))
+     (t
+      (output-event msg :privmsg channel (trailing-argument msg))))))
 
 (defun action-hook (msg)
   (output-event msg :action (first (arguments msg))
@@ -344,17 +407,62 @@ o;;;  -*- Mode: Lisp -*-
   (output-event msg :join (trailing-argument msg)))
 
 (defun kick-hook (msg)
-  (output-event msg :kick (first (arguments msg))))
+  (let ((logger (find-logger-with-connection (connection msg)))
+	(channel (first (arguments msg)))
+	(who-kicked (second (arguments msg))))
+    (output-event msg :kick channel who-kicked)
+    (when (string-equal (nickname logger) who-kicked)
+      (format
+       (get-private-log-stream logger)
+       "~A Logging daemon ~A has been kicked from ~A (~A)~%"
+       (format-date-time (received-time msg))
+       (nickname logger)
+       channel
+       (trailing-argument msg))
+      (force-output (get-private-log-stream logger))
+      (daemon-sleep 1)
+      (remove-channel-logger logger channel)
+      (daemon-sleep 1)
+      (add-channel-logger logger channel)
+      (format
+       (get-private-log-stream logger)
+       "~A Rejoined ~A~%"
+       (format-date-time (received-time msg))
+       channel)
+      (force-output (get-private-log-stream logger)))))
 
 (defun notice-hook (msg)
-  (if (and (string-equal (source msg) "NickServ")
-	   (string-equal "owned by someone else" (trailing-argument msg)))
-      (let ((logger (find-logger-with-connection (connection msg))))
-	(if logger
-	    (privmsg (connection msg) (source msg) (format nil "IDENTIFY ~A" (password logger)))
-	    (warn "NickServ asks for identity with connection not found."))) 
-      (output-event msg :notice (first (arguments msg)) (trailing-argument msg))))
+  (let ((logger (find-logger-with-connection (connection msg)))
+	(channel (first (arguments msg))))
+    (cond
+      ((and (string-equal (source msg) "NickServ")
+	    (string-equal channel (nickname logger))
+	    (string-equal "owned by someone else" (trailing-argument msg)))
+       (if logger
+	   (privmsg (connection msg) (source msg) (format nil "IDENTIFY ~A" (password logger)))
+	 (format
+	  (get-private-log-stream logger)
+	  "~A NickServ asks for identity with connection not found.~%"
+	  (format-date-time (received-time msg)))))
+      ((equal channel (nickname logger))
+       (format
+	(get-private-log-stream logger)
+	"~A ~A~%" 
+	(format-date-time (get-universal-time))
+	(raw-message-string msg))
+       (force-output (get-private-log-stream logger)))
+      (t
+       (output-event msg :notice channel (trailing-argument msg))))))
+
+(defun ping-hook (msg)
+  (let ((logger (find-logger-with-connection (connection msg))))
+    (pong (connection msg) (server logger))
+    #+debug (format *standard-output* "Sending pong to ~A~%" (server logger))))
 
+(defun pong-hook (msg)
+  (let ((logger (find-logger-with-connection (connection msg))))
+    (setf (last-pong logger) (received-time msg))))
+	
 (defun topic-hook (msg)
   (output-event msg :topic (first (arguments msg)) (trailing-argument msg)))
 
@@ -362,6 +470,35 @@ o;;;  -*- Mode: Lisp -*-
   (output-event msg :mode (first (arguments msg)) 
 		(format nil "~{~A~^ ~}" (cdr (arguments msg)))))
 
+(defun rpl_namreply-hook (msg)
+  (output-event msg :names (third (arguments msg))
+		(trailing-argument msg)))
+
+(defun rpl_endofnames-hook (msg)
+  (declare (ignore msg))
+  ;; nothing to do for this message
+  )
+
+(defun rpl_topic-hook (msg)
+  (output-event msg :rpl_topic (format nil "~{~A~^ ~}" (arguments msg))
+		(trailing-argument msg)))
+
+(defun rpl_topicwhotime-hook (msg)
+  (output-event msg :rpl_topicwhotime
+		(second (arguments msg))
+		(third (arguments msg))))
+
+
+(defun invite-hook (msg)
+  (let ((logger (find-logger-with-connection (connection msg))))
+    (format 
+     (get-private-log-stream logger)
+     "~A ~A~%"
+     (format-date-time (get-universal-time))
+     (raw-message-string msg))
+    (force-output (get-private-log-stream logger))))
+
+
 (defun make-a-channel (name formats output)
   (make-instance 'channel
 		 :name name
@@ -379,10 +516,64 @@ o;;;  -*- Mode: Lisp -*-
 (defun is-unichannel-output (user-output)
   "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
+		       :username username :realname realname
+		       :logging-stream logging-stream)))
+    (mapc #'(lambda (channel) (join conn channel)) channels)
+    (add-hook conn 'irc::irc-privmsg-message 'privmsg-hook)
+    (add-hook conn 'irc::ctcp-action-message 'action-hook)
+    (add-hook conn 'irc::irc-nick-message 'nick-hook)
+    (add-hook conn 'irc::irc-part-message 'part-hook)
+    (add-hook conn 'irc::irc-quit-message 'quit-hook)
+    (add-hook conn 'irc::irc-join-message 'join-hook)
+    (add-hook conn 'irc::irc-kick-message 'kick-hook)
+    (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-error-message 'error-hook)
+    (add-hook conn 'irc::irc-ping-message 'ping-hook)
+    (add-hook conn 'irc::irc-pong-message 'pong-hook)
+    (add-hook conn 'irc::irc-kill-message 'kill-hook)
+    (add-hook conn 'irc::irc-invite-message 'invite-hook)
+    (add-hook conn 'irc::irc-rpl_killdone-message 'warning-hook)
+    (add-hook conn 'irc::irc-rpl_closing-message 'warning-hook)
+    (add-hook conn 'irc::irc-rpl_topic-message 'rpl_topic-hook)
+    (add-hook conn 'irc::irc-rpl_namreply-message 'rpl_namreply-hook)
+    (add-hook conn 'irc::irc-rpl_endofnames-message 'rpl_endofnames-hook)
+    (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)))
+    (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
+	irc::irc-kick-message irc::irc-mode-message irc::irc-topic-message
+	irc::irc-notice-message irc::irc-error-message irc::irc-ping-message
+	irc::irc-pong-message irc::irc-kill-message irc::irc-invite-message
+	irc::irc-rpl_killdone-message irc::irc-rpl_closing-message
+	irc::irc-rpl_topic-message irc::irc-rpl_namreply-message
+	irc::irc-rpl_endofnames-message irc::irc-rpl_topicwhotime-message
+	irc::irc-rpl_motd-message irc::irc-rpl_motdstart-message
+	irc::irc-rpl_endofmotd-message)
+       ;; nothing to do
+       )
+      (t
+       (let ((logger (find-logger-with-connection (connection msg))))
+	 (format (get-unknown-log-stream
+		  (find-logger-with-connection (connection msg)))
+		 "~A ~A~%"
+		 (format-date-time (received-time msg ))
+		 (raw-message-string msg))
+	 (force-output (get-unknown-log-stream logger)))))
+    result))
+
 (defun create-logger (nick server &key channels output password
-				       realname username
-				       (logging-stream t) (formats '(:text)))
+		      realname username async
+		      private-log unknown-log
+		      (logging-stream t) (formats '(:text)))
   "OUTPUT may be a pathname or a stream"
   ;; check arguments
   (assert formats)
@@ -392,9 +583,7 @@ o;;;  -*- Mode: Lisp -*-
       (setq formats (list formats)))
   (if (stringp output)
       (setq output (parse-namestring output)))
-  (let* ((conn (connect :nickname nick :server server
-			 :username username :realname realname
-			 :logging-stream logging-stream))
+  (let* ((conn (do-connect-and-join nick server username realname logging-stream channels))
 	 (logger (make-instance
 		  'logger
 		  :connection conn
@@ -405,24 +594,21 @@ o;;;  -*- Mode: Lisp -*-
 		  :channel-names channels
 		  :username username
 		  :realname realname
+		  :async async
 		  :logging-stream logging-stream
 		  :user-output output
 		  :formats formats
+		  :private-log private-log
+		  :unknown-log unknown-log
+		  :private-log-stream (when private-log
+					(open private-log :direction :output
+					      :if-exists :append
+					      :if-does-not-exist :create))
+		  :unknown-log-stream (when unknown-log
+					(open unknown-log :direction :output
+					      :if-exists :append
+					      :if-does-not-exist :create))
 		  :unichannel (is-unichannel-output output))))
-    
-    (mapc #'(lambda (channel) (join conn channel)) channels)
-    (add-hook conn 'irc::irc-privmsg-message 'privmsg-hook)
-    (add-hook conn 'irc::ctcp-action-message 'action-hook)
-    (add-hook conn 'irc::irc-nick-message 'nick-hook)
-    (add-hook conn 'irc::irc-part-message 'part-hook)
-    (add-hook conn 'irc::irc-quit-message 'quit-hook)
-    (add-hook conn 'irc::irc-join-message 'join-hook)
-    (add-hook conn 'irc::irc-kick-message 'kick-hook)
-    (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))
@@ -438,38 +624,57 @@ o;;;  -*- Mode: Lisp -*-
   (let ((logger (find-logger-with-nick nick)))
     (cond
       ((null logger)
-       (warn "No active connection found with nick ~A." nick)
+       (warn
+	"~A No active connection found with nick ~A [remove-logger].~%"
+	(format-date-time (get-universal-time))
+	nick)
        nil)
       (t
-       (irc:quit (connection logger))
+       (ignore-errors (irc:quit (connection logger) ""))
        (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)))))))
+       (when (private-log-stream logger)
+	 (close (private-log-stream logger)))
+       (when (unknown-log-stream logger)
+	 (close (unknown-log-stream logger)))
+
        (setq *loggers*
 	     (delete nick *loggers*  :test #'string-equal :key #'nickname))
        t))))
 
 (defun add-logger (nick server &key channels output (password "")
-				    realname username
-		   (logging-stream t) (async t) (formats '(:text)))
+				    realname username private-log unknown-log
+				    (logging-stream t) (async t)
+				    (formats '(:sexp)))
   (when (find-logger-with-nick nick)
-    (warn "Closing previously active connection.")
-    (remove-logger nick))
+    (format
+     (get-private-log-stream (find-logger-with-nick nick))
+     "~A Closing previously active connection [add-logger].~%"
+     (format-date-time (get-universal-time)))
+    (ignore-errors (remove-logger nick)))
   (let ((logger (create-logger nick server :channels channels :output output
 			       :logging-stream logging-stream :password password
 			       :realname realname :username username
-			       :formats formats)))
+			       :private-log private-log 
+			       :unknown-log unknown-log 
+			       :formats formats
+			       :async async)))
     (push logger *loggers*)
     (start-logger logger async)
     logger))
-
+  
 (defun add-channel-logger (logger channel-name)
   (cond
     ((find-channel-with-name logger channel-name)
-     (warn "Channel ~A already in logger ~A." channel-name logger)
+     (format (get-private-log-stream logger)
+	     "~A Channel ~A already in logger ~A.~%" 
+	     (format-date-time (get-universal-time))
+	     channel-name logger)
+     (force-output (get-private-log-stream logger))
      nil)
     (t
      (let ((channel (make-a-channel channel-name (formats logger) (user-output logger))))
@@ -493,8 +698,11 @@ o;;;  -*- Mode: Lisp -*-
 					    :test #'string-equal))
        t)
       (t
-       (warn "Channel name ~A not found in logger ~A." 
-	     channel-name logger)
+       (format
+	(get-private-log-stream logger)
+	"~A Channel name ~A not found in logger ~A.~%" 
+	(format-date-time (get-universal-time)) 
+	channel-name logger)
        nil))))
 
 (defun add-hook-logger (logger class hook)
@@ -505,6 +713,26 @@ o;;;  -*- Mode: Lisp -*-
 
 (defvar *warning-message-utime* nil)
 
+(defun kill-hook (msg)
+  (let ((target (second (arguments msg)))
+	(logger (find-logger-with-connection (connection msg))))
+    (when (and (stringp target)
+	       (string-equal target (nickname logger)))
+      (setf (warning-message-utime logger) (received-time msg)))
+    (format (get-private-log-stream logger)
+	    "~A Killed by ~A~%"
+	    (format-date-time (received-time msg))
+	    (source msg))
+    (force-output (get-private-log-stream logger))))
+
+(defun error-hook (msg)
+  (let ((text (trailing-argument msg))
+	(logger (find-logger-with-connection (connection msg))))
+    (when (and (stringp text) 
+	       (zerop (search (format nil "Closing Link: ~A" (nickname logger)) text)))
+      (setf (warning-message-utime logger) (received-time msg)))
+    (output-event msg :error nil (trailing-argument msg))))
+
 (defun warning-hook (msg)
   (let ((logger (find-logger-with-connection (connection msg))))
     (output-event msg :server 
@@ -520,45 +748,99 @@ o;;;  -*- Mode: Lisp -*-
 
 (defun log-disconnection (logger)
   ;; avoid generating too many reconnect messages in the logs
-  (when (< (- (get-universal-time) (warning-message-utime logger)) 300)
+  (when (or (null (warning-message-utime logger))
+	    (< (- (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)))
+  (log-daemon-message
+   logger
+   "Connection restablished at ~A." (format-date-time (get-universal-time))))
+
+(defun is-connected (logger)
+  (when (ignore-errors (ping (connection logger) (server logger)))
+    (dotimes (i 20)
+      (when (and (last-pong logger)
+		 (< (- (get-universal-time) (last-pong logger)) 21))
+	(return-from is-connected t))
+      (sleep 1))))
+
+
+(let (*recon-nick* *recon-server* *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*
+		    *recon-formats* *recon-password* *recon-async* 
+		    *recon-user-output* *recon-private-log* *recon-unknown-log*
+		    *recon-logging-stream* *recon-channel-names*))
+  
+  (defun attempt-reconnection (logger)
+    (when (is-connected logger)
+      (return-from attempt-reconnection nil))
+    
+    (log-disconnection logger)
+    (when (connection logger)
+      (ignore-errors (quit (connection logger) "Client terminated by server"))
+      (setf *recon-nick* (nickname logger)
+	    *recon-server* (server logger)
+	    *recon-username* (username logger)
+	    *recon-realname* (realname logger)
+	    *recon-password* (password logger)
+	    *recon-async* (async logger)
+	    *recon-user-output* (user-output logger)
+	    *recon-private-log* (private-log logger)
+	    *recon-unknown-log* (unknown-log logger)
+	    *recon-formats* (formats logger)
+	    *recon-logging-stream* (logging-stream logger)
+	    *recon-channel-names* (channel-names logger))
+      (ignore-errors (remove-logger logger)))
+    
+    (let ((new-logger
+	   (ignore-errors
+	    (add-logger *recon-nick* *recon-server*
+			:channels *recon-channel-names*
+			:output *recon-user-output*
+			:password *recon-password*
+			:realname *recon-realname*
+			:username *recon-username*
+			:logging-stream *recon-logging-stream*
+			:private-log *recon-private-log*
+			:unknown-log *recon-unknown-log*
+			:async *recon-async*
+			:formats *recon-formats*))))
+      (when new-logger
+	(sleep 5)
+	(when (is-connected new-logger)
+	  (log-reconnection new-logger)))))
+      
+  )
 
 (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)))
+    (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)))))
+  
+
+