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

[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

[cl-irc-devel] [patch] Make cl-irc more compatible with bouncers
by Andreas Fuchs 27 Jan '06

27 Jan '06

Hi, irc bouncers like miau send a 30-minute backlog on reconnect. The problem is that they don't send NAMES before they send the backlog. AFAICT, that's even allowed by the irc spec. cl-irc breaks when it sees a QUIT message when it didn't build a channel user table before. This patch makes cl-irc accept quit messages when it can't find a user for them: Cheers, -- Andreas Fuchs, (http://|im:asf@|mailto:asf@)boinkor.net, antifuchs

1 0

[cl-irc-devel] [patch] Add a connection arg to irc-message-event
by Andreas Fuchs 27 Jan '06

27 Jan '06

Hi, Beirc as it is right now uses a really ugly re-implementation of the read-message method, because in order to operate correctly, we can't just use an :around method on read-message like this: (defmethod read-message ((con my-irc-connection)) (let ((m (call-next-method))) (dispatch-on-message m) m)) Why? Because (in the case of a QUIT message) read-message modified the channel user table already when beirc tries to find out which channels a user who just quit was on. So, I think we're specializing a method one level too high. We should be specializing the irc-message-event method, but it has no connection argument. Yet. The attached patch adds a connection argument on which irc-message-event can be specialized. I would also suggest exporting irc-message-event and making that method the recommended way to dispatch on all messages on an irc connection. I've used this patch with a locally hacked version of beirc for a few days now and it works very well for me. I hope you all like it, because I'd really like to see that ugly wart in beirc go away. (-: -- Andreas Fuchs, (http://|im:asf@|mailto:asf@)boinkor.net, antifuchs

2 1

[cl-irc-devel] Re: [Cl-irc-cvs] r120 - trunk/cl-irc
by Erik Huelsmann 24 Jan '06

24 Jan '06

Sorry for the noise: this was a test commit message to see if I configured the commit mailer program correctly. It looks like I did... bye, Erik. > --- Ursprüngliche Nachricht --- > Von: ehuelsmann(a)common-lisp.net > An: cl-irc-cvs(a)common-lisp.net > Betreff: [Cl-irc-cvs] r120 - trunk/cl-irc > Datum: Tue, 24 Jan 2006 15:36:49 -0600 (CST) > > Author: ehuelsmann > Date: Mon Jan 23 17:49:01 2006 > New Revision: 120 > > Modified: > trunk/cl-irc/protocol.lisp > Log: > Untabify for consistent indenting accross all systems and editors. > > > Modified: trunk/cl-irc/protocol.lisp > ============================================================================== > --- trunk/cl-irc/protocol.lisp (original) > +++ trunk/cl-irc/protocol.lisp Mon Jan 23 17:49:01 2006 > @@ -268,9 +268,9 @@ > (start-process #'do-loop name) > #+(and sbcl (not sb-thread)) > (sb-sys:add-fd-handler (sb-sys:fd-stream-fd > - (server-stream connection)) > - :input (lambda (fd) > - (declare (ignore fd)) > + (server-stream connection)) > + :input (lambda (fd) > + (declare (ignore fd)) > (if (listen (server-stream > connection)) > (read-message connection) > ;; select() returns with no > @@ -850,19 +850,19 @@ > "Intern based on symbol-name to support case-sensitive mlisp" > (intern > (concatenate 'string > - (symbol-name prefix) > - "-" > - (symbol-name name) > - "-" > - (symbol-name '#:message)))) > + (symbol-name prefix) > + "-" > + (symbol-name name) > + "-" > + (symbol-name '#:message)))) > > (defun define-irc-message (command) > (let ((name (intern-message-symbol :irc command))) > `(progn > - (defmethod find-irc-message-class ((type (eql ,command))) > - (find-class ',name)) > - (export ',name) > - (defclass ,name (irc-message) ()))))) > + (defmethod find-irc-message-class ((type (eql ,command))) > + (find-class ',name)) > + (export ',name) > + (defclass ,name (irc-message) ()))))) > > (defmacro create-irc-message-classes (class-list) > `(progn ,@(mapcar #'define-irc-message class-list))) > @@ -870,7 +870,7 @@ > ;; should perhaps wrap this in an eval-when? > (create-irc-message-classes #.(remove-duplicates (mapcar #'second > *reply-names*))) > (create-irc-message-classes (:privmsg :notice :kick :topic :error :mode > :ping > - :nick :join :part :quit :kill :pong :invite)) > + :nick :join :part :quit :kill :pong > :invite)) > > (defmethod find-irc-message-class (type) > (declare (ignore type)) > @@ -909,10 +909,10 @@ > (defun define-ctcp-message (ctcp-command) > (let ((name (intern-message-symbol :ctcp ctcp-command))) > `(progn > - (defmethod find-ctcp-message-class ((type (eql ,ctcp-command))) > - (find-class ',name)) > - (export ',name) > - (defclass ,name (ctcp-mixin irc-message) ()))))) > + (defmethod find-ctcp-message-class ((type (eql ,ctcp-command))) > + (find-class ',name)) > + (export ',name) > + (defclass ,name (ctcp-mixin irc-message) ()))))) > > (defmacro create-ctcp-message-classes (class-list) > `(progn ,@(mapcar #'define-ctcp-message class-list))) > _______________________________________________ > Cl-irc-cvs mailing list > Cl-irc-cvs(a)common-lisp.net > http://common-lisp.net/cgi-bin/mailman/listinfo/cl-irc-cvs > -- 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] Start using trivial-sockets to reduce implementation dependent code
by Erik Huelsmann 24 Jan '06

24 Jan '06

Hi! Somewhere in the TODO, there's mention of abstracting/extracting implementation dependent sockets code into it's own (simple) library. I believe that library has been available for a while now and would like to switch cl-irc to using that: trivial-sockets. Hoping for reactions (but committing the change otherwise), Erik. -- Telefonieren Sie schon oder sparen Sie noch? NEU: GMX Phone_Flat http://www.gmx.net/de/go/telefonie

1 1

[cl-irc-devel] Switching CVS to Subversion?
by Erik Huelsmann 23 Jan '06

23 Jan '06

Hi! Well, it's no secret that I am a Subversion dev, but apart from that: I like Subversion's interface (much) better than CVS's. Is there anybody who objects to switching the CVS repository to Subversion? bye, Erik. -- 10 GB Mailbox, 100 FreeSMS/Monat http://www.gmx.net/de/go/topmail +++ GMX - die erste Adresse f�r Mail, Message, More +++

1 0