X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;ds=sidebyside;f=logger.lisp;h=feb6dd5732dbff1e5674e80dec179224aa13eef3;hb=b8a8a19aabdd430565f1e41fb451e3a242d153de;hp=deb4ba5c8f9f2488de3ec32494d1b14a37cbbf3a;hpb=a965224d14cf77adbe25556368af633b7468f924;p=irc-logger.git diff --git a/logger.lisp b/logger.lisp index deb4ba5..feb6dd5 100644 --- a/logger.lisp +++ b/logger.lisp @@ -360,11 +360,16 @@ *standard-output*)) (defun add-log-entry (stream fmt &rest args) - (format-date-time (get-universal-time) :stream stream) - (write-char #\space stream) - (apply #'format stream fmt args) - (write-char #\newline stream) - (force-output stream)) + (handler-case + (progn + (format-date-time (get-universal-time) :stream stream) + (write-char #\space stream) + (apply #'format stream fmt args) + (write-char #\newline stream) + (force-output stream)) + (error (e) + (warn "Error ~A when trying to add-log-entry '~A'." e + (apply #'format nil fmt args))))) (defun add-private-log-entry (logger fmt &rest args) (apply #'add-log-entry (get-private-log-stream logger) fmt args)) @@ -402,6 +407,7 @@ (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) @@ -529,6 +535,7 @@ (t (add-log-entry (get-unknown-log-stream (find-logger-with-connection (connection msg))) + "~A" (raw-message-string msg)))) result)) @@ -708,11 +715,18 @@ (defun is-connected (logger) (%is-connected logger)) +(defparameter *timeout* 60) + (defun is-connected (logger) #-allegro (%is-connected logger) - #+allegro (mp:with-timeout (60 nil) + #+allegro (mp:with-timeout (*timeout* nil) (%is-connected logger))) +(defun quit-maybe-timeout (connection msg) + #-allegro (quit connection msg) + #+allegro (mp:with-timeout (*timeout* nil) + (quit connection msg))) + (defun %is-connected (logger) (when (ignore-errors (ping (connection logger) (server logger))) (dotimes (i 20) @@ -736,7 +750,7 @@ (log-disconnection logger) (when (connection logger) - (ignore-errors (quit (connection logger) "Client terminated by server")) + (ignore-errors (quit-maybe-timeout (connection logger) "Client terminated by server")) (setf *recon-nick* (nickname logger) *recon-server* (server logger) *recon-username* (username logger)