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

[cl-irc-devel] [PATCH] Add 'seen' and 'spoke' support
by Erik Huelsmann 06 Jan '06

06 Jan '06

Hi! Some time ago Xach (Zach) gave me the source to a utility routine he wrote to add 'seen' tracking to a bot of his. I generalised the code and made library-code of it adding several hooks. The patch below applies to HEAD as of this moment and adds a generalised version of event tracking. It does not only track 'seen', it adds 'spoke' by default too. Next to that, it implements the general tools to track any event a library-user may want to track. I'd *love* to hear your comments. bye, Erik. Index: cl-irc.asd =================================================================== RCS file: /project/cl-irc/cvsroot/cl-irc/cl-irc.asd,v retrieving revision 1.2 diff -u -r1.2 cl-irc.asd --- cl-irc.asd 29 Mar 2004 19:07:54 -0000 1.2 +++ cl-irc.asd 6 Jan 2006 21:38:25 -0000 @@ -39,4 +39,6 @@ (:file "command" :depends-on ("protocol")) (:file "event" + :depends-on ("command")) + (:file "track" :depends-on ("command")))) Index: package.lisp =================================================================== RCS file: /project/cl-irc/cvsroot/cl-irc/package.lisp,v retrieving revision 1.8 diff -u -r1.8 package.lisp --- package.lisp 15 Apr 2005 16:01:22 -0000 1.8 +++ package.lisp 6 Jan 2006 21:38:25 -0000 @@ -129,5 +129,11 @@ :users- :wallops :userhost - :ison))) + :ison + ;;; user activity tracking + :record-events + :recorded-event + :seen + :spoke + ))) Index: protocol.lisp =================================================================== RCS file: /project/cl-irc/cvsroot/cl-irc/protocol.lisp,v retrieving revision 1.25 diff -u -r1.25 protocol.lisp --- protocol.lisp 25 Sep 2005 14:55:02 -0000 1.25 +++ protocol.lisp 6 Jan 2006 21:38:25 -0000 @@ -159,7 +159,8 @@ (users :initarg :users :accessor users - :initform (make-hash-table :test #'equal)))) + :initform (make-hash-table :test #'equal)) + (track-db))) (defmethod print-object ((object connection) stream) "Print the object for the Lisp reader." Index: track.lisp =================================================================== RCS file: track.lisp diff -N track.lisp --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ track.lisp 6 Jan 2006 21:38:25 -0000 @@ -0,0 +1,288 @@ +;;; +;;; track.lisp +;;; +;;; Heavily based on seen.lisp +;;; as created on 2004-01-08 by Zach Beane <xach(a)gwi.net> +;;; +;;; Adapted to be part of cl-irc by Erik Huelsmann <e.huelsmann(a)gmx.net> +;;; +;;; + +(in-package :irc) + + +(defclass msg-db () + ((table :reader msg-db-table + :initform (make-hash-table :test 'equalp) + :documentation "A hash table mapping IRC nicknames to + their seen data.") + (file :reader msg-db-file + :initarg :file + :documentation "The file to which seen data will be + saved and updated.") + (compact-threshold :accessor msg-db-compact-threshold + :initarg :compact-threshold + :initform 10000 + :documentation "How many updates to write + to the data file before compacting it.") + (update-count :accessor msg-db-update-count + :initform 0))) + +(defun %file-update (stream key &rest args) + (let ((*print-pretty* nil) + (*print-readably* t)) + (print (cons key args) stream))) + +(defun %table-update (table key &rest args) + (setf (gethash key table) args)) + +(defmethod update-db ((db msg-db) + nick msg-type time &rest rest) + (let ((key (list nick msg-type))) + (with-open-file (out (msg-db-file db) + :direction :output + :if-exists :append + :if-does-not-exist :create) + (apply #'%file-update (append (list out key time) rest))) + (incf (msg-db-update-count db)) + (maybe-compact-db db) + (apply #'%table-update (append (list (msg-db-table db) key time) rest)))) + +(defmethod save-db ((db msg-db)) + (with-open-file (out (msg-db-file db) + :direction :output + :if-exists :supersede + :if-does-not-exist :create) + (maphash #'(lambda (key val) + (apply #'%file-update out key val)) + (msg-db-table db)))) + +(defmethod compact-db ((db msg-db)) + (save-db db) + (setf (msg-db-update-count db) 0)) + +(defmethod maybe-compact-db ((db msg-db)) + (when (> (msg-db-update-count db) + (msg-db-compact-threshold db)) + (compact-db db))) + +(defmethod load-db ((db msg-db)) + (with-open-file (in (msg-db-file db) + :direction :input + :if-does-not-exist :create) + (loop for item = (read in nil nil) + while item + do + (destructuring-bind + (nick &rest rest) + item + (apply #'%table-update (append (list (msg-db-table db) nick) + rest)))))) + + +(defun make-msg-db (&key file (compact-threshold 10000)) + (let ((db (make-instance 'msg-db + :file file + :compact-threshold compact-threshold))) + (load-db db) + (compact-db db) + db)) + + +;;; Producing pretty messages for various events + +(defmacro with-slots-and-args (slots args message &body body) + "Evaluate BODY with the slots of the MESSAGE bound to the + symbols of SLOTS, and the arguments of the message + destructuring-bind'ed to ARGS." + (let ((irc-message (gensym))) + `(let ((,irc-message ,message)) + (with-slots ,slots ,irc-message + (destructuring-bind ,args (arguments ,irc-message) + ,@body))))) + + +;; track-data returns (values): + +;; * a keyword designating the registered event, one of: +;; :joined +;; :left +;; :quit +;; :kicked +;; :nick-changed +;; :unknown +;; * a list of arguments for the given event + + +;; Default events to be recorded + +(defmethod track-data ((message irc-message)) + (values :unknown (list command message))) + +(defmethod track-data ((message irc-kick-message)) + (with-slots-and-args (source trailing-argument) (channel target) + message + (declare (ignore target)) + (values :kicked (list channel source trailing-argument)))) + +(defmethod track-data ((message irc-join-message)) + (values :joined (list (trailing-argument message)))) + +(defmethod track-data ((message irc-quit-message)) + (values :quit (list (trailing-argument message)))) + +(defmethod track-data ((message irc-part-message)) + (with-slots-and-args (trailing-argument) (channel) + message + (values :left (list channel trailing-argument)))) + +(defmethod track-data ((message irc-nick-message)) + (with-slots-and-args (source) (new-nick) + message + (values :nick-changed (list source new-nick)))) + +(defmethod track-data ((message irc-privmsg-message)) + (with-slots-and-args (received-time trailing-argument arguments) + (channel) + message + (values :privmsg (list trailing-argument channel)))) + +(defmethod track-data ((message ctcp-action-message)) + (with-slots-and-args (received-time trailing-argument arguments) + (channel) + message + (values :action (list trailing-argument channel)))) + +;; Most messages have the the source as track-related nick, +;; but there are exceptions. + +(defmethod track-nicks ((message irc-message)) + (list (source message))) + +(defmethod track-nicks ((message irc-kick-message)) + (destructuring-bind (channel target) + (arguments message) + (declare (ignore channel)) + (list target (source message)))) + + + +;; Hook setup + +(defun make-track-hook (connection db data-callback nicks-callback) + (lambda (message) + (let ((time (received-time message)) + (data (multiple-value-list (funcall data-callback message)))) + (dolist (nick (mapcar #'(lambda (x) + (normalize-nickname connection x)) + (funcall nicks-callback message))) + (apply #'update-db + (append (list db nick (type-of message) time) data)))))) + + +(defvar special-message-names + '((:seen irc-kick-message + irc-quit-message + irc-part-message + irc-join-message + irc-nick-message) + (:spoke irc-privmsg-message + ctcp-action-message))) + +(defun map-special-messages (messages) + (mapcan #'(lambda (x) (if (keywordp x) + ;; copy-list is here because + ;; mapcan modifies its lists + (copy-list (cdr (assoc x special-message-names))) + (list x))) + messages)) + +(defun record-events (connection file + &key (data #'track-data) + (nicks #'track-nicks) + (messages '(:seen :spoke))) + "Add hooks to CONNECTION necessary to track event information. +Uses FILE as the event database. + +Returns the database-object used to record events." + (let* ((db (make-msg-db :file file)) + (fun (make-track-hook connection db data nicks))) + (setf (slot-value connection 'track-db) db) + (dolist (class (map-special-messages messages)) + (add-hook connection class fun)) + db)) + +(defmethod recorded-event ((connection connection) nick + &optional (messages '(:seen :spoke))) + (values-list + (reduce #'(lambda (&optional x y) + (cond + ((and x y) + ;; select latest (newest) event + (if (> (first x) (first y)) x y)) + (x x) + (y y))) + (mapcar #'(lambda (x) + (gethash (list nick x) + (msg-db-table + (slot-value connection 'track-db)))) + (map-special-messages messages))))) + +(defmethod seen ((connection connection) nick) + "Returns (values time event-type msg-data ...)" + (recorded-event connection nick '(:seen))) + +(defmethod spoke ((connection connection) nick) + "Returns (values time event-type msg-data ...)" + (recorded-event connection nick '(:spoke))) + + +;; Formatting of default recorded events + +(defmethod fmt-track (stream (action (eql :kicked)) arguments) + (declare (ignore action)) + (destructuring-bind + (channel oper text) + arguments + (format stream "being kicked out of ~A by ~A~@[ (~A)~]" + channel oper text))) + +(defmethod fmt-track (stream (action (eql :joined)) arguments) + (declare (ignore action)) + (destructuring-bind + (channel) + arguments + (format stream "joining ~A" channel))) + +(defmethod fmt-track (stream (action (eql :left)) arguments) + (declare (ignore action)) + (destructuring-bind + (channel text) + arguments + (format stream "leaving ~A~@[ (~A)~]" channel text))) + +(defmethod fmt-track (stream (action (eql :quit)) arguments) + (declare (ignore action)) + (destructuring-bind + (text) + arguments + (format stream "leaving irc~@[ (~A)~]" text))) + +(defmethod fmt-track (stream (action (eql :nick-changed)) arguments) + (declare (ignore action)) + (destructuring-bind + (from-nick to-nick) + arguments + (format stream "changing his nick from ~A to ~A" from-nick to-nick))) + +(defmethod fmt-track (stream (action (eql :privmsg)) arguments) + (declare (ignore action)) + (destructuring-bind + (text channel) + arguments + (format stream "'~A' in ~A" text channel))) + + +(defun format-track-data (stream action arguments) + (fmt-track stream action arguments)) + -- 10 GB Mailbox, 100 FreeSMS/Monat http://www.gmx.net/de/go/topmail +++ GMX - die erste Adresse für Mail, Message, More +++ -- 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 find-or-make-user keep track of usernames/hostmasks
by Andreas Fuchs 24 Sep '05

24 Sep '05

Hi again, here's a patch to make find-or-make-user update the user object with values for username, hostmask and realname as soon as they become available. I think this should also clear rpl_whois and other hooks from doing that themselves. Here's the patch: Cheers, -- Andreas Fuchs, <asf(a)boinkor.net>, asf(a)jabber.at, antifuchs

1 0

[cl-irc-devel] [patch] default-hook for irc-nick-message calls undefined function
by Andreas Fuchs 24 Sep '05

24 Sep '05

Hi, I left beirc running over night again. It looks like the default-hook for irc-nick-messages is using the undefined function find-or-create-user instead of find-or-make-user. This patch should fix that (I copied the find-or-make-user inovcation from the irc-join-message hook; hope that's ok): Cheers, -- Andreas Fuchs, <asf(a)boinkor.net>, asf(a)jabber.at, antifuchs

1 0

[cl-irc-devel] patch to add a :connection-type argument to irc:connect
by Andreas Fuchs 23 Sep '05

23 Sep '05

Hi, as chandler` and I discussed a few minutes ago, the way to handle /all/ irc-messages is to define your own connection class and to define an :around method on read-message. This patch allows cl-irc users to pass that connection class to irc:connect: Thanks, -- Andreas Fuchs, <asf(a)boinkor.net>, asf(a)jabber.at, antifuchs

1 0

[cl-irc-devel] patch to send PASS command at connect time
by Andreas Fuchs 10 Sep '05

10 Sep '05

Hi, cl-irc includes a PASS method already, but it doesn't use it at the right time, that is, when the connection is initiated, before the NICK and USER commands are sent. This patch introduces the :PASSWORD keyword arg to IRC:CONNECT, by default nil, which sends the PASS command at login time. -- Andreas Fuchs, <asf(a)boinkor.net>, asf(a)jabber.at, antifuchs

1 0

[cl-irc-devel] Feedback from a novice
by Ed Symanzik 16 Jul '05

16 Jul '05

I'm new to lisp and even newer to cl-irc. I wanted my bot to take a command to send a message to another user/channel. This works great. (defun msg-hook (message) (let* ((connection (connection message)) (channel (find-channel connection (first (arguments message)))) (source (source message)) (text (trailing-argument message))) (unless (self-message-p message) Then I was thinking, that should be a lot more generic. Why not give it _any_ irc command; join, kick, action, etc. First problem was that there is no action command. *bot wimpers (defmethod action ((connection connection) (target string) (message string)) (send-irc-message connection :privmsg (make-ctcp-message (concatenate 'string "ACTION " message)) target)) (defmethod action ((connection connection) (user user) (message string)) (action connection (nickname user) message)) (defmethod action ((connection connection) (channel channel) (message string)) (action connection (name channel) message)) That works well too. But how to give the bot a generic command and execute it? It looks like (cl-ppcre:register-groups-bind (target string) ("^!(.*)" command) (create-irc-message command)) but how do I send a message? Maybe something like: (defmethod send-irc-message ((connection connection) (message message)) ... Btw, I was surprized to find that the read-message method doesn't just read a string, parse it, and return a message; it also dispatches events. Again, I'm just a noob but I thought I would through in some feedback anyway. I'm hoping I was just clueless and all of this is already in there. *zik waits to be beaten with a stick

2 1

[cl-irc-devel] New release (from pre_mode_tracking tag)?
by Erik Huelsmann 07 May '05

07 May '05

The currently available release is quite old now, so I'm wondering if it isn't time to do a new release. The mode tracking code is too new, although it has been running on my system for a while, so I thought to use the pre_mode_tracking tag to generate a 0.7 release. This brings me to several questions: - What's the numbering scheme? - Is 0.10 deemed acceptable? Or is 0.9 considered to be last before 1.0? - Do the version numbers mean anything wrt guaranteed APIs? (like, for example, in the APR project; see http://apr.apache.org/versioning.html) - What requirements are there for a 1.0 release? Thanks for your reactions! bye, Erik. -- "Happy ProMail" bis 24. M�rz: http://www.gmx.net/de/go/promail Zum 6. Geburtstag gibt's GMX ProMail jetzt 66 Tage kostenlos!

3 4

[cl-irc-devel] Circular references, garbage collection & library implementation
by Erik Huelsmann 22 Mar '05

22 Mar '05

Hi, Although I really want to work on stuff like DCC and writing CTCP helper functions for coloring etc., I think I need to address technical problems first. AFAICT, the current implementation will leak memory (ie won't be garbage collected correctly) if users and channels are not removed (using remove-user and remove-channel) before all references to a connection object are lost/broken. In such cases, although nothing refers to the connection object anymore, the channel may still contain user objects and the users will still hold channel objects in their channel lists. In other words: they won't be gc-able. I'd like to change the library implementation to resolve this issue. It will have some API consequences. The idea is that even though there may be a very large number of users, the number of channels will probably remain limited (several 10.000s max) and that several thousands of hash lookups are fast. [I never run the library with more than 20 channels...] So, I'd like to bring back the one-way hierarchy in the library by eliminating the channels list on the user object, replacing it by a channels method which serves the same purpose, but dynamically collects the result. Most user and channel operations will need a connection object to be passed in to function correcly though. bye, Erik. -- DSL Komplett von GMX +++ Superg�nstig und stressfrei einsteigen! AKTION "Kein Einrichtungspreis" nutzen: http://www.gmx.net/de/go/dsl

2 3

[cl-irc-devel] ANNOUNCE: cl-irc 0.7 release tarball
by Erik Huelsmann 21 Mar '05

21 Mar '05

Ok. So, after yesterdays discussion, I have checked out the pre_mode_tracking tag and created a release for it. I've put up the release tarball at ftp://common-lisp.net/pub/project/cl-irc/ and intend to change the link on cliki.net. I hope you object when you think something is going wrong :-) bye, Erik. -- DSL Komplett von GMX +++ Superg�nstig und stressfrei einsteigen! AKTION "Kein Einrichtungspreis" nutzen: http://www.gmx.net/de/go/dsl

2 2

[cl-irc-devel] MODE tracking (again)
by Erik Huelsmann 21 Mar '05

21 Mar '05

I know I sent a mail about this subject to this list somewhere around september last year. The response was to commit it to CVS, in order to allow review. So, as soon as I finish writing the log message I can commit it (hopefully tonight). Since the last time, I have rewritten most of the code. Below is the document I used to guide my design. I could commit that too, but was not planning to. Comments? ------------------------ Mode tracking 'design' -*- text -*- **** Goal: enabling the cl-irc library to track modes automatically **** Mode tracking requirements for cl-irc: 1) mode tracking for modes as defined by rfc281? 2) conformance with draft rfc on RPL_ISUPPORT 3) mode tracking for arbitrary (but defined) modes (which may have been advertised by RPL_ISUPPORT) 4) keeping channel modes and users list in sync where mode arguments are in fact user objects 5) application side modes to be attached to channels and users (my actual reason to implement it) 6) The application should be able to benefit from any new functions added to parse MODE command arguments. Ad 1 ==== >From a storage perspective there are 3 different kinds of modes in the rfc: - Those that can be 'on' or 'off' (being identified +e on dancer-ircd) - Those that hold a value when assigned (channel user limit and channel keyword come to mind) - Those that hold a list of values (ban and ban-except for example) Interpreting the stored value for 'on/off' modes as generalized boolean values, this leaves two different mode types: those that hold a single value and those that hold a list of values. >From a command perspective there are 4 kinds of modes in the rfc: - Those that take a parameter when (un)set, but which the client can send to the server without parameters in order to query the current setting - Those that always take a parameter, these have two sub-categories A) Those where the parameter is a nickname B) Those where the parameter isn't a nickname - Those that take a parameter when set but not when 'unset' - Those that never take a parameter The library will need to be able to parse each of these four mode types. When used as a client library, the optional argument form is not relevant however. The default hook will ignore that case. Ad 2+3 ====== The server can - through the RPL_ISUPPORT message - advertise which channel modes it supports. Conformance with the draft rfc means that the client needs to be able to parse arbitrary modes with the advertised properties. Next to that, the client may want to define its own modes (which are not automatically tracked). Ad 4 ==== Some of those modes described above may need to be kept in sync with users joining / leaving the channel. This is supposed to be automatic. Ad 5 ==== Yea, ok, well, the system needs to be extensible. **** Implementation decisions & consequences Ad 1+5 ====== The library defines two classes which are used to store modes: one for the single-value modes, the other for multi-value modes. In order to allow extensibility, an application can implement its own classes derived from the superclass `irc-mode' in order to make mode tracking automatic. Ad 2+3 ====== The library needs to be able to create its own mode objects in reaction to server messages setting mode values. For this purpose, it defines a mode-description structure which holds all values required. If applications define their own modes, they need to file such structures with the connection object to allow it to create the modes. The library integrates with the RPL_ISUPPORT framework by parsing the CHANMODES and PREFIX values in that response and creating mode-description structures for those modes itself. While doing so, it concatenates the PREFIX modes to the list from CHANMODES as described by the draft rfc. The modes in the PREFIX string take nicknames as their argument automagically. Ad 4 ==== For the library to be able to automatically maintain the list of properties while user join and leave messages are processed, it needs to know which modes contain users (or user objects) as their value(s). The mode-description structure is used for this purpose too. Ad 6 ==== The library will provide functions to: - Translate the CHANMODES and PREFIX arguments of the RPL_ISUPPORT response into a list of mode-description structures - Interpret the MODE command arguments and return a list of mode-change instructions. - Create custom mode descriptions (in order to create custom modes) - Manipulate and query mode values **** Implementation `decode-mode-command' should be able to process two types of commands: 1) MODE <target> <mode-char>+ 2) MODE <target> ([+|-]<mode-char>+ <mode-parameter>*)+ If the input does not match either pattern, the return value will be nil. The returned values are (values mode-list query-p) where query-p will be non-nil if the mode command matches the first syntax. If it matches the second pattern, the mode-list will be a list of lists describing the mode-changes as follows: ( [#\+|#\-] <mode-char> <mode-value>? ) (DONE) `mode-descs-from-isupport' returns a list of mode-description structures describing the modes in the CHANMODE and PREFIX values. The resulting list can be used for setting up automatic mode tracking for default hooks. (DONE) `parse-mode-arguments' returns a list of mode-change instructions. (DONE) `irc-mode', `single-value-mode' and `multi-value-mode' are classes which are used to track mode values. Applications can define their own derivatives in order to have custom behaviour for self-defined modes. (DONE) `add-mode', `get-mode', `set-mode', `unset-mode' and `remove-mode' operate on channel and user objects to manipulate modes. The effect of `set-mode' and `unset-mode' is determined by the class from which the mode was instantiated. (DONE) `has-mode-p' and `has-mode-value-p' operate on user and channel objects and return non-nil values if the given mode or mode/value are associated with it. More specifically, has-mode-value-p returns whatever `has-value-p' returns when invoked on the mode object (usually its value) and `has-mode-p' returns the mode object itself. (DONE) `mode-description' describes the different options which the application uses or expects over the connection from the server. It has the following fields: - char : character used over the connection to identify this mode - symbol : symbol the application uses to refer to this mode (the default symbols are keywords) - param-on-set-p, param-on-unset-p : indicate whether the library should expect an argument when receiving either on the operations; valid values are: nil (false), :optional, :optional-for-server or any other value (true) - nick-param-p : non-nil when the argument specifies a user (by nickname) - class : specifies the class to instantiate upon creation of a new mode (DONE) -------------------------------- EOF -- DSL Komplett von GMX +++ Superg�nstig und stressfrei einsteigen! AKTION "Kein Einrichtungspreis" nutzen: http://www.gmx.net/de/go/dsl

2 2