Update of /project/cl-irc/cvsroot/cl-irc In directory common-lisp:/tmp/cvs-serv598

Modified Files: protocol.lisp event.lisp Log Message: Prevent ctcp request loops: NOTICE messages are responses. By Andreas Fuchs.

--- /project/cl-irc/cvsroot/cl-irc/protocol.lisp 2006/02/22 18:55:18 1.38 +++ /project/cl-irc/cvsroot/cl-irc/protocol.lisp 2006/02/22 18:59:13 1.39 @@ -1,4 +1,4 @@ -;;;; $Id: protocol.lisp,v 1.38 2006/02/22 18:55:18 ehuelsmann Exp $ +;;;; $Id: protocol.lisp,v 1.39 2006/02/22 18:59:13 ehuelsmann Exp $ ;;;; $Source: /project/cl-irc/cvsroot/cl-irc/protocol.lisp,v $

;;;; See LICENSE for licensing information. @@ -932,6 +932,12 @@ (declare (ignore type)) (find-class 'standard-ctcp-message))

+(defmethod ctcp-request-p ((message ctcp-mixin)) + (string= (command message) :privmsg)) + +(defmethod ctcp-reply-p ((message ctcp-mixin)) + (string= (command message) :notice)) + (defmethod client-log ((connection connection) (message ctcp-mixin) &optional (prefix "")) (let ((stream (client-stream connection))) (format stream "~A~A: ~A (~A): ~A~{ ~A~} "~A"~%" --- /project/cl-irc/cvsroot/cl-irc/event.lisp 2006/02/22 18:54:18 1.23 +++ /project/cl-irc/cvsroot/cl-irc/event.lisp 2006/02/22 18:59:13 1.24 @@ -1,4 +1,4 @@ -;;;; $Id: event.lisp,v 1.23 2006/02/22 18:54:18 ehuelsmann Exp $ +;;;; $Id: event.lisp,v 1.24 2006/02/22 18:59:13 ehuelsmann Exp $ ;;;; $Source: /project/cl-irc/cvsroot/cl-irc/event.lisp,v $

;;;; See LICENSE for licensing information. @@ -289,52 +289,52 @@ (remove-channel user channel) (remove-user channel user)))))))

-(defmethod default-hook ((message ctcp-time-message)) - (multiple-value-bind - (second minute hour date month year day) - (get-decoded-time) - (send-irc-message - (connection message) - :notice (source message) - (make-ctcp-message - (format nil "TIME ~A" - (make-time-message second minute hour date month year day)))))) - -(defmethod default-hook ((message ctcp-source-message)) - (send-irc-message - (connection message) - :notice - (source message) - (make-ctcp-message - (format nil "SOURCE ~A:~A:~A" - *download-host* - *download-directory* - *download-file*)))) - -(defmethod default-hook ((message ctcp-finger-message)) - (let* ((user (user (connection message))) - (finger-info (if (not (zerop (length (realname user)))) - (realname user) - (nickname user)))) - (send-irc-message - (connection message) - :notice (source message) - (make-ctcp-message - (format nil "FINGER ~A" finger-info))))) - -(defmethod default-hook ((message ctcp-version-message)) - (send-irc-message - (connection message) - :notice (source message) - (make-ctcp-message - (format nil "VERSION ~A" *ctcp-version*)))) - -(defmethod default-hook ((message ctcp-ping-message)) - (send-irc-message - (connection message) - :notice (source message) - (make-ctcp-message - (format nil "PING ~A" (car (last (arguments message))))))) +(macrolet ((define-ctcp-reply-hook ((message-var message-type) &body body) + `(defmethod default-hook ((,message-var ,message-type)) + (when (ctcp-request-p ,message-var) + ,@body)))) + (define-ctcp-reply-hook (message ctcp-time-message) + (multiple-value-bind + (second minute hour date month year day) + (get-decoded-time) + (send-irc-message + (connection message) + :notice (source message) + (make-ctcp-message + (format nil "TIME ~A" + (make-time-message second minute hour date month year day)))))) + (define-ctcp-reply-hook (message ctcp-source-message) + (send-irc-message + (connection message) + :notice + (source message) + (make-ctcp-message + (format nil "SOURCE ~A:~A:~A" + *download-host* + *download-directory* + *download-file*)))) + (define-ctcp-reply-hook (message ctcp-finger-message) + (let* ((user (user (connection message))) + (finger-info (if (not (zerop (length (realname user)))) + (realname user) + (nickname user)))) + (send-irc-message + (connection message) + :notice (source message) + (make-ctcp-message + (format nil "FINGER ~A" finger-info))))) + (define-ctcp-reply-hook (message ctcp-version-message) + (send-irc-message + (connection message) + :notice (source message) + (make-ctcp-message + (format nil "VERSION ~A" *ctcp-version*)))) + (define-ctcp-reply-hook (message ctcp-ping-message) + (send-irc-message + (connection message) + :notice (source message) + (make-ctcp-message + (format nil "PING ~A" (car (last (arguments message))))))))

(defmethod irc-message-event (connection (message ctcp-dcc-chat-request-message)) (declare (ignore connection))