February 2006 - cl-irc-devel - mailman3.common-lisp.net

[cl-irc-devel] [patch] ctcp request loop protection
by Andreas Fuchs 22 Feb '06

22 Feb '06

as it stands now, cl-irc answers ctcp replies with a reply of its own; this leads to loops (and, in the case of bouncers, to amplified loops). Here's a patch that makes cl-irc reply only if the request was in a privmsg (as specified in http://www.invlogic.com/irc/ctcpprot_06.html) Cheers, -- Andreas Fuchs, (http://|im:asf@|mailto:asf@)boinkor.net, antifuchs

2 1

[cl-irc-devel] trailing argument bots patch
by Erik Huelsmann 20 Feb '06

20 Feb '06

Hi! Deprecating trailing-argument makes the bots in examples/ out of date. Below is a patch to fix that, but, given that I don't run them much, I'd like to send the patch here and have someone look them over and commit. Brian, could you? Thanks in advance! bye, Erik. Index: example/cliki.lisp =================================================================== RCS file: /project/cl-irc/cvsroot/cl-irc/example/cliki.lisp,v retrieving revision 1.38 diff -u -r1.38 cliki.lisp --- example/cliki.lisp 15 Oct 2005 19:16:52 -0000 1.38 +++ example/cliki.lisp 20 Feb 2006 20:36:21 -0000 @@ -723,7 +723,7 @@ (defun valid-cliki-message (message) - (scan *cliki-attention-prefix* (trailing-argument message))) + (scan *cliki-attention-prefix* (car (last (arguments message))))) (defvar *respond-to-general-hellos* nil) @@ -740,24 +740,27 @@ (format *trace-output* "~A~%" (nthcdr 10 (sb-debug:backtrace-as-list))) (return-from msg-hook)))) - (progn - (scan-for-more (trailing-argument message)) - (let ((respond-to (if (string-equal (first (arguments message)) *cliki-nickname*) (source message) (first (arguments message))))) + (destructuring-arguments + (target &rest unused &last text) + message + (declare (ignore unused)) + (scan-for-more text) + (let ((respond-to (if (string-equal target *cliki-nickname*) (source message) target))) (if (valid-cliki-message message) - (let ((response (cliki-lookup (regex-replace *cliki-attention-prefix* (trailing-argument message) "") :sender (source message) :channel (first (irc:arguments message))))) + (let ((response (cliki-lookup (regex-replace *cliki-attention-prefix* text "") :sender (source message) :channel target))) (and response (privmsg *cliki-connection* respond-to response))) - (if (string-equal (first (arguments message)) *cliki-nickname*) - (aif (cliki-lookup (trailing-argument message) :sender (source message)) + (if (string-equal target *cliki-nickname*) + (aif (cliki-lookup text :sender (source message)) (privmsg *cliki-connection* respond-to it)) - (if (anybody-here (trailing-argument message)) - (privmsg *cliki-connection* (first (arguments message)) (format nil "~A: hello." (source message)))))) + (if (anybody-here text) + (privmsg *cliki-connection* target (format nil "~A: hello." (source message)))))) (take-care-of-memos respond-to (source message)))))) (defvar *cliki-nickserv-password* "") (defun notice-hook (message) (if (and (string-equal (source message) "NickServ") - (scan "owned by someone else" (trailing-argument message))) + (scan "owned by someone else" (car (last (arguments message))))) (privmsg *cliki-connection* (source message) (format nil "IDENTIFY ~A" *cliki-nickserv-password*)))) (defun rename-cliki (new-nick) Index: example/specbot.lisp =================================================================== RCS file: /project/cl-irc/cvsroot/cl-irc/example/specbot.lisp,v retrieving revision 1.14 diff -u -r1.14 specbot.lisp --- example/specbot.lisp 9 Aug 2005 01:26:14 -0000 1.14 +++ example/specbot.lisp 20 Feb 2006 20:36:21 -0000 @@ -102,12 +102,13 @@ (and (not final) string)) (defun msg-hook (message) - (let ((destination (if (string-equal (first (arguments message)) *nickname*) - (source message) - (first (arguments message)))) + (let* ((target (first (arguments message)))) + (destination (if (string-equal target *nickname*) + (source message) + target)) (to-lookup (strip-address (trailing-argument message)))) (if (and (or - (string-equal (first (arguments message)) *nickname*) + (string-equal target *nickname*) (not (string= to-lookup (trailing-argument message)))) (member to-lookup '("help" "help?") :test #'string-equal)) (progn -- DSL-Aktion wegen gro�er Nachfrage bis 28.2.2006 verl�ngert: GMX DSL-Flatrate 1 Jahr kostenlos* http://www.gmx.net/de/go/dsl

1 0

[cl-irc-devel] CVS cl-irc
by Erik Huelsmann 15 Feb '06

15 Feb '06

> Log Message: > Fix crash on unknown modes.tility.lisp Sorry guys, this commit contains way more than intended. The code included however, is good. It includes the rewrite to remove calls to trailing-argument. bye, Erik. > > --- /project/cl-irc/cvsroot/cl-irc/event.lisp 2006/02/15 20:42:48 1.17 > +++ /project/cl-irc/cvsroot/cl-irc/event.lisp 2006/02/15 23:24:34 1.18 > @@ -1,4 +1,4 @@ > -;;;; $Id: event.lisp,v 1.17 2006/02/15 20:42:48 ehuelsmann Exp $ > +;;;; $Id: event.lisp,v 1.18 2006/02/15 23:24:34 ehuelsmann Exp $ > ;;;; $Source: /project/cl-irc/cvsroot/cl-irc/event.lisp,v $ > > ;;;; See LICENSE for licensing information. > @@ -108,9 +108,11 @@ > :user-count > user-count)))))) > > (defmethod default-hook ((message irc-rpl_topic-message)) > - (setf (topic (find-channel (connection message) > - (second (arguments message)))) > - (trailing-argument message))) > + (destructuring-bind > + (target channel topic) > + (arguments message) > + (declare (ignore target)) > + (setf (topic (find-channel (connection message) channel)) topic))) > > (defmethod default-hook ((message irc-rpl_namreply-message)) > (let* ((connection (connection message))) > @@ -159,32 +161,43 @@ > (apply #'pong (connection message) (arguments message))) > > (defmethod default-hook ((message irc-join-message)) > - (let* ((connection (connection message)) > - (user (find-or-make-user > - (connection message) > - (source message) > - :hostname (host message) > - :username (user message))) > - (channel (or (find-channel connection (trailing-argument > message)) > - (make-channel connection > - :name (trailing-argument message))))) > - (when (self-message-p message) > - (add-channel connection channel)) > - (add-user connection user) > - (add-user channel user))) > + (with-slots > + (connection source host user arguments) > + message > + (destructuring-bind > + (channel) > + arguments > + (let ((user (find-or-make-user connection source > + :hostname host > + :username user)) > + (channel (or (find-channel connection channel) > + (make-channel connection :name channel)))) > + (when (self-message-p message) > + (add-channel connection channel)) > + (add-user connection user) > + (add-user channel user))))) > > (defmethod default-hook ((message irc-topic-message)) > - (setf (topic (find-channel (connection message) > - (first (arguments message)))) > - (trailing-argument message))) > + (with-slots > + (connection arguments) > + message > + (destructuring-bind > + (channel &optional topic) > + arguments > + (setf (topic (find-channel connection channel)) topic)))) > > (defmethod default-hook ((message irc-part-message)) > - (let* ((connection (connection message)) > - (channel (find-channel connection (first (arguments message)))) > - (user (find-user connection (source message)))) > - (if (self-message-p message) > - (remove-channel user channel) > - (remove-user channel user)))) > + (with-slots > + (connection arguments source) > + message > + (destructuring-bind > + (channel &optional text) > + arguments > + (let ((channel (find-channel connection channel)) > + (user (find-user connection source))) > + (if (self-message-p message) > + (remove-channel user channel) > + (remove-user channel user)))))) > > (defmethod default-hook ((message irc-quit-message)) > (let* ((connection (connection message)) > @@ -193,30 +206,34 @@ > (remove-user-everywhere connection user)))) > > (defmethod default-hook ((message irc-rpl_channelmodeis-message)) > - (destructuring-bind > - (target &rest arguments) > - ;; ignore the my own nick which is the first message argument > - (rest (arguments message)) > - (let* ((connection (connection message)) > - (target (find-channel connection target)) > + (with-slots > + (connection arguments) > + message > + (destructuring-bind > + (target channel &rest mode-arguments) > + arguments > + (declare (ignore target)) > + (let* ((channel (find-channel connection channel)) > (mode-changes > - (when target > - (parse-mode-arguments connection target arguments > + (when channel > + (parse-mode-arguments connection channel arguments > :server-p (user connection))))) > (dolist (change mode-changes) > (destructuring-bind > (op mode-name value) > change > - (unless (has-mode-p target mode-name) > + (unless (has-mode-p channel mode-name) > (add-mode target mode-name > - (make-mode connection target mode-name))) > + (make-mode connection channel mode-name))) > (funcall (if (char= #\+ op) #'set-mode #'unset-mode) > - target mode-name value)))))) > + channel mode-name value))))))) > > (defmethod default-hook ((message irc-mode-message)) > (destructuring-bind > (target &rest arguments) > (arguments message) > + (print (arguments message)) > + (print arguments) > (let* ((connection (connection message)) > (target (or (find-channel connection target) > (find-user connection target))) > @@ -235,22 +252,35 @@ > target mode-name value)))))) > > (defmethod default-hook ((message irc-nick-message)) > - (let* ((con (connection message)) > - (user (find-or-make-user con (source message) > - :hostname (host message) > - :username (user message)))) > - (change-nickname con user (trailing-argument message)))) > + (with-slots > + (connection source host user arguments) > + message > + (destructuring-bind > + (new-nick) > + arguments > + (let* ((user (find-or-make-user connection source > + :hostname host > + :username user))) > + (change-nickname connection user new-nick))))) > > (defmethod default-hook ((message irc-kick-message)) > - (let* ((connection (connection message)) > - (channel (find-channel connection (first (arguments message)))) > - (user (find-user connection (second (arguments message))))) > - (if (self-message-p message) > - (remove-channel user channel) > - (remove-user channel user)))) > + (with-slots > + (connection arguments) > + message > + (destructuring-bind > + (channel nick &optional reason) > + arguments > + (declare (ignore arguments)) > + (let* ((channel (find-channel connection channel)) > + (user (find-user connection nick))) > + (if (self-message-p message) > + (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) > + (multiple-value-bind > + (second minute hour date month year day) > + (get-decoded-time) > (send-irc-message > (connection message) > :notice (source message) > --- /project/cl-irc/cvsroot/cl-irc/utility.lisp 2006/02/15 20:14:21 1.10 > +++ /project/cl-irc/cvsroot/cl-irc/utility.lisp 2006/02/15 23:24:34 1.11 > @@ -1,4 +1,4 @@ > -;;;; $Id: utility.lisp,v 1.10 2006/02/15 20:14:21 ehuelsmann Exp $ > +;;;; $Id: utility.lisp,v 1.11 2006/02/15 23:24:34 ehuelsmann Exp $ > ;;;; $Source: /project/cl-irc/cvsroot/cl-irc/utility.lisp,v $ > > ;;;; See the LICENSE file for licensing information. > @@ -292,9 +292,11 @@ > (mode-description connection target > (mode-name-from-char > connection target > (char > modes i)))) > - (param-p (funcall param-req mode-rec))) > - (when (and param-p > - (= 0 (length arguments))) > + (param-p (when mode-rec > + (funcall param-req mode-rec)))) > + (when (or (null mode-rec) > + (and param-p > + (= 0 (length arguments)))) > (throw 'illegal-mode-spec nil)) > (push (list this-op > (mode-desc-symbol mode-rec) > > _______________________________________________ > cl-irc-cvs mailing list > cl-irc-cvs(a)common-lisp.net > http://common-lisp.net/cgi-bin/mailman/listinfo/cl-irc-cvs > -- 10 GB Mailbox, 100 FreeSMS/Monat http://www.gmx.net/de/go/topmail +++ GMX - die erste Adresse f�r Mail, Message, More +++

1 0

[cl-irc-devel] patch: make mode list parsing work on ircnet servers
by Andreas Fuchs 15 Feb '06

15 Feb '06

Hi all, cl-irc's mode list parsing expects a set-by and set-at argument in rpl_*list messages. IRCNet servers don't always send them, as the parsing routine doesn't use the args anyway, this patch makes them &optional: --- event.lisp 27 Jan 2006 21:10:02 -0000 1.13 +++ event.lisp 5 Feb 2006 21:36:27 -0000 @@ -26,7 +26,7 @@ `(progn (defmethod default-hook ((message ,listmsg-class)) (destructuring-bind - (target channel-name mask set-by time-set) + (target channel-name mask &optional set-by time-set) (arguments message) (declare (ignore target set-by time-set)) ;; note: the structure currently does not allow for logging Cheers, -- Andreas Fuchs, (http://|im:asf@|mailto:asf@)boinkor.net, antifuchs

2 1

[cl-irc-devel] Elimination of trailing-argument
by Erik Huelsmann 14 Feb '06

14 Feb '06

As brought up by Zach in Jan 2004, cl-irc distinguishes between arguments and trailing-argument. The RFCs don't: the ':' preceding the trailing argument is just 'syntactic sugar to allow SPACE characters in an argument'. The patch below introduces a growth path to a situation without a trailing argument field: - eliminate the field (but introduce a method by the same name) - remove the (temporary) method (in 6 months) Why is applying this patch important? Some networks send: :<USER> JOIN <#channel> Others :<USER> JOIN :<#channel> Which are equivalent in the RFC, but quite different from a library user POV. Applying this patch would resolve that issue. Comments? Bye, Erik. Index: parse-message.lisp =================================================================== RCS file: /project/cl-irc/cvsroot/cl-irc/parse-message.lisp,v retrieving revision 1.6 diff -u -r1.6 parse-message.lisp --- parse-message.lisp 21 Mar 2005 18:15:52 -0000 1.6 +++ parse-message.lisp 14 Feb 2006 22:56:47 -0000 @@ -60,6 +60,19 @@ trailing-argument part is not present." (cut-between string #\: '(#\Return) :start start)) +(defun combine-arguments-and-trailing (string &key (start 0)) + (multiple-value-bind + (start return-string) + (return-arguments string :start start) + (print return-string) + (multiple-value-bind + (return-index trailing) + (return-trailing-argument string :start start) + (print trailing) + (values return-index + (append return-string (when (and trailing (string/= "" trailing))+ (list trailing))))))) + (defun parse-raw-message (string &key (start 0)) "Assuming `string' is a valid IRC message, parse the message and return the values in the following order: @@ -78,8 +91,7 @@ return-user return-host return-command - return-arguments - return-trailing-argument)) + combine-arguments-and-trailing)) (multiple-value-bind (return-index return-string) (funcall function string :start index) (setf index return-index) @@ -145,10 +157,11 @@ "If `string' is a valid IRC message parse it and return an object of the correct type with its slots prefilled according to the information in the message." - (multiple-value-bind (source user host command arguments trailing-argument) + (multiple-value-bind (source user host command arguments) (parse-raw-message string) - (let ((class 'irc-message) - (ctcp (ctcp-message-type trailing-argument))) + (let* ((class 'irc-message) + (trailing-argument (car (last arguments))) + (ctcp (ctcp-message-type trailing-argument))) (when command (cond (nil ;(irc-error-reply-p command) @@ -177,7 +190,6 @@ "") :arguments arguments :connection nil - :trailing-argument (or trailing-argument "") :received-time (get-universal-time) :raw-message-string (or string "")))) (when ctcp Index: protocol.lisp =================================================================== RCS file: /project/cl-irc/cvsroot/cl-irc/protocol.lisp,v retrieving revision 1.33 diff -u -r1.33 protocol.lisp --- protocol.lisp 12 Feb 2006 08:08:07 -0000 1.33 +++ protocol.lisp 14 Feb 2006 22:56:47 -0000 @@ -817,10 +817,6 @@ :accessor arguments :initarg :arguments :type list) - (trailing-argument - :accessor trailing-argument - :initarg :trailing-argument - :type string) (connection :accessor connection :initarg :connection) @@ -837,6 +833,12 @@ (print-unreadable-object (object stream :type t :identity t) (format stream "~A ~A" (source object) (command object)))) +;;Compat code; remove after 2006-08-01 + +(defgeneric trailing-argument (message)) +(defmethod trailing-argument ((message irc-message)) + (car (last (arguments message)))) + (defgeneric self-message-p (message)) (defgeneric find-irc-message-class (type)) (defgeneric client-log (connection message &optional prefix)) Index: test/test-parse-message.lisp =================================================================== RCS file: /project/cl-irc/cvsroot/cl-irc/test/test-parse-message.lisp,v retrieving revision 1.2 diff -u -r1.2 test-parse-message.lisp --- test/test-parse-message.lisp 5 Jan 2004 14:18:07 -0000 1.2 +++ test/test-parse-message.lisp 14 Feb 2006 22:56:47 -0000 @@ -10,6 +10,8 @@ (defvar *msg3* (format nil "NOTICE AUTH :*** Your forward and reverse DNS don't match~A" #\Return)) (defvar *msg4* (format nil ":kire_!~~eenge@adsl-156-35-240.asm.bellsouth.net MODE #lisppaste +k key~A" #\Return)) (defvar *msg5* (format nil ":kire_!~~eenge@adsl-156-35-240.asm.bellsouth.net MODE #lisppaste +bbb *!*(a)somewhere.com *!*(a)somewhereles.com *!*(a)youdontwannaknow.org~A" #\Return)) +(defvar *msg6* (format nil ":kire!~~eenge@216.248.178.227 PRIVMSG cl-irc heyhey!~A" #\Return)) + (deftest find-reply-name.1 (irc:find-reply-name 1) :rpl_welcome) (deftest find-reply-name.2 @@ -59,4 +61,8 @@ (deftest parse-raw-message.1 (irc::parse-raw-message cl-irc-test::*msg1*) - "kire" "~eenge" "216.248.178.227" "PRIVMSG" ("cl-irc") "heyhey!") + "kire" "~eenge" "216.248.178.227" "PRIVMSG" ("cl-irc" "heyhey!")) + +(deftest no-trailing.1 + (irc::parse-raw-message *msg6*) + "kire" "~eenge" "216.248.178.227" "PRIVMSG" ("cl-irc" "heyhey!")) -- Lust, ein paar Euro nebenbei zu verdienen? Ohne Kosten, ohne Risiko! Satte Provisionen f�r GMX Partner: http://www.gmx.net/de/go/partner

1 0

[cl-irc-devel] [patch] password support for join
by Andreas Fuchs 14 Feb '06

14 Feb '06

Hi, here's a patch to support join commands that add a password argument: Cheers, -- Andreas Fuchs, (http://|im:asf@|mailto:asf@)boinkor.net, antifuchs

2 1

[cl-irc-devel] Switching cl-irc from trivial-sockets to usocket
by Erik Huelsmann 13 Feb '06

13 Feb '06

Hi! Other than that trivial-sockets has a bug where it forgets to include sb-bsd-sockets on SBCL, usocket doesn't provide any additional functionality (yet). The path through which usocket will evolve in the comming weeks will allow me to include support for DCC connections initiated by the cl-irc library. Today, I released usocket version 0.1.0, which doesn't include a full stable api, but the parts cl-irc uses (atm) probably won't change. So, my question: can I switch cl-irc to usocket with your consent? bye, Erik. -- Telefonieren Sie schon oder sparen Sie noch? NEU: GMX Phone_Flat http://www.gmx.net/de/go/telefonie

1 0