X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=logger.lisp;h=449f154a08e97c76b37f1e0c0e4c43b87347b252;hb=bf7cb3143da8886c3671d2ce007487b0a93ebbcd;hp=3aab458ec665fc7ca826c8b2d8fc4bfe003c5856;hpb=5b8c953c38b5a88cfd01c100dbace7ae04dd4c0c;p=irc-logger.git

diff --git a/logger.lisp b/logger.lisp
index 3aab458..449f154 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 
@@ -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.")
@@ -16,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.")
@@ -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,26 @@ 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.")
+   (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.")))
 
 (defvar *loggers* nil "List of active loggers.")
 
@@ -151,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."
@@ -165,7 +194,15 @@ 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
+	(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
@@ -174,7 +211,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)
@@ -189,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))
@@ -200,31 +241,50 @@ 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)))))
+
+(uffi:def-foreign-type time-t :unsigned-long)
+(uffi:def-function ("ctime" c-ctime) 
+    ((time (* time-t)))
+  :returning :cstring)
 
 (defun last-sexp-field (type msg)
   (cond
+   ((null msg)
+    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
+	  (string-right-trim '(#\newline #\return)
+			     (uffi:convert-from-cstring
+			      (uffi:with-foreign-object (time 'time-t)
+				(setf (uffi:deref-pointer time :unsigned-long) secs)
+				(c-ctime time))))))))
    ((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)
+  (let ((*print-circle* nil)
+	(*print-pretty* nil))
+    (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))
   
-  (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,8 +306,14 @@ 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))
+      (: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)
@@ -257,12 +323,34 @@ 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)))
+    (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 (length (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)
   (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))
@@ -275,13 +363,31 @@ o;;;  -*- Mode: Lisp -*-
 	     (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)
+  (or (private-log-stream logger) *standard-output*))
+
+(defun get-unknown-log-stream (logger)
+  (or (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))
@@ -301,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)))
 
@@ -319,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
@@ -336,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)
@@ -349,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
@@ -359,21 +591,26 @@ o;;;  -*- Mode: Lisp -*-
 		  :password password
 		  :server server
 		  :channels (make-channels channels formats output)
+		  :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)
+    (unless *daemon-monitor-process*
+      (setq *daemon-monitor-process* (cl-irc::start-process 'daemon-monitor "logger-monitor")))
     logger))
 
 (defun start-logger (logger async)
@@ -387,43 +624,63 @@ 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))))
        (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,10 +694,15 @@ 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." 
-	     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)
@@ -449,17 +711,136 @@ 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 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 
+		  (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 (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 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 ()
+      ()
+    (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)))))
+  
+
+