From eenge at common-lisp.net Mon Nov 3 17:00:55 2003 From: eenge at common-lisp.net (Erik Enge) Date: Mon, 03 Nov 2003 12:00:55 -0500 Subject: [net-nittin-irc-cvs] CVS update: Module improted: net-nittin-irc Message-ID: Update of /project/net-nittin-irc/cvsroot/net-nittin-irc In directory common-lisp.net:/tmp/cvs-serv25278 Log Message: initial import Status: Vendor Tag: eenge Release Tags: init N net-nittin-irc/LICENSE N net-nittin-irc/package.lisp N net-nittin-irc/CREDITS N net-nittin-irc/Makefile N net-nittin-irc/protocol.lisp N net-nittin-irc/variable.lisp N net-nittin-irc/command.lisp N net-nittin-irc/TODO N net-nittin-irc/utility.lisp N net-nittin-irc/event.lisp N net-nittin-irc/parse-message.lisp N net-nittin-irc/net-nittin-irc.asd No conflicts created by this import Date: Mon Nov 3 12:00:55 2003 Author: eenge New module net-nittin-irc added From eenge at common-lisp.net Mon Nov 3 17:11:17 2003 From: eenge at common-lisp.net (Erik Enge) Date: Mon, 03 Nov 2003 12:11:17 -0500 Subject: [net-nittin-irc-cvs] CVS update: net-nittin-irc/variable.lisp Message-ID: Update of /project/net-nittin-irc/cvsroot/net-nittin-irc In directory common-lisp.net:/tmp/cvs-serv30045 Modified Files: variable.lisp Log Message: turn off debugging by default Date: Mon Nov 3 12:11:17 2003 Author: eenge Index: net-nittin-irc/variable.lisp diff -u net-nittin-irc/variable.lisp:1.1.1.1 net-nittin-irc/variable.lisp:1.2 --- net-nittin-irc/variable.lisp:1.1.1.1 Mon Nov 3 12:00:54 2003 +++ net-nittin-irc/variable.lisp Mon Nov 3 12:11:17 2003 @@ -1,11 +1,11 @@ -;;;; $Id: variable.lisp,v 1.1.1.1 2003/11/03 17:00:54 eenge Exp $ +;;;; $Id: variable.lisp,v 1.2 2003/11/03 17:11:17 eenge Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/variable.lisp,v $ ;;;; See the LICENSE file for licensing information. (in-package :irc) -(defvar *debug-p* t) +(defvar *debug-p* nil) (defvar *debug-stream* t) (defconstant +soh+ #.(code-char 1)) From eenge at common-lisp.net Mon Nov 3 17:14:54 2003 From: eenge at common-lisp.net (Erik Enge) Date: Mon, 03 Nov 2003 12:14:54 -0500 Subject: [net-nittin-irc-cvs] CVS update: net-nittin-irc/README Message-ID: Update of /project/net-nittin-irc/cvsroot/net-nittin-irc In directory common-lisp.net:/tmp/cvs-serv31963 Added Files: README Log Message: adding file Date: Mon Nov 3 12:14:54 2003 Author: eenge From eenge at common-lisp.net Mon Nov 3 17:25:48 2003 From: eenge at common-lisp.net (Erik Enge) Date: Mon, 03 Nov 2003 12:25:48 -0500 Subject: [net-nittin-irc-cvs] CVS update: net-nittin-irc/protocol.lisp Message-ID: Update of /project/net-nittin-irc/cvsroot/net-nittin-irc In directory common-lisp.net:/tmp/cvs-serv4704 Modified Files: protocol.lisp Log Message: con -> connection typo Date: Mon Nov 3 12:25:48 2003 Author: eenge Index: net-nittin-irc/protocol.lisp diff -u net-nittin-irc/protocol.lisp:1.1.1.1 net-nittin-irc/protocol.lisp:1.2 --- net-nittin-irc/protocol.lisp:1.1.1.1 Mon Nov 3 12:00:54 2003 +++ net-nittin-irc/protocol.lisp Mon Nov 3 12:25:48 2003 @@ -1,4 +1,4 @@ -;;;; $Id: protocol.lisp,v 1.1.1.1 2003/11/03 17:00:54 eenge Exp $ +;;;; $Id: protocol.lisp,v 1.2 2003/11/03 17:25:48 eenge Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/protocol.lisp,v $ ;;;; See LICENSE for licensing information. @@ -119,7 +119,7 @@ raw-message)) (defmethod all-users ((connection connection)) - (let ((user-list (dangling-users con))) + (let ((user-list (dangling-users connection))) (dolist (channel (channels connection)) (maphash #'(lambda (key value) (declare (ignore key)) From eenge at common-lisp.net Mon Nov 3 17:28:12 2003 From: eenge at common-lisp.net (Erik Enge) Date: Mon, 03 Nov 2003 12:28:12 -0500 Subject: [net-nittin-irc-cvs] CVS update: net-nittin-irc/TODO Message-ID: Update of /project/net-nittin-irc/cvsroot/net-nittin-irc In directory common-lisp.net:/tmp/cvs-serv5180 Modified Files: TODO Log Message: *** empty log message *** Date: Mon Nov 3 12:28:12 2003 Author: eenge Index: net-nittin-irc/TODO diff -u net-nittin-irc/TODO:1.1.1.1 net-nittin-irc/TODO:1.2 --- net-nittin-irc/TODO:1.1.1.1 Mon Nov 3 12:00:54 2003 +++ net-nittin-irc/TODO Mon Nov 3 12:28:12 2003 @@ -5,3 +5,5 @@ - Add DCC + - Add CTCP sending commands (version, time, etc.) + From eenge at common-lisp.net Mon Nov 3 20:54:10 2003 From: eenge at common-lisp.net (Erik Enge) Date: Mon, 03 Nov 2003 15:54:10 -0500 Subject: [net-nittin-irc-cvs] CVS update: net-nittin-irc/event.lisp Message-ID: Update of /project/net-nittin-irc/cvsroot/net-nittin-irc In directory common-lisp.net:/tmp/cvs-serv10524 Modified Files: event.lisp Log Message: calling apply-to-hooks on every irc-message-event Date: Mon Nov 3 15:54:10 2003 Author: eenge Index: net-nittin-irc/event.lisp diff -u net-nittin-irc/event.lisp:1.1.1.1 net-nittin-irc/event.lisp:1.2 --- net-nittin-irc/event.lisp:1.1.1.1 Mon Nov 3 12:00:54 2003 +++ net-nittin-irc/event.lisp Mon Nov 3 15:54:10 2003 @@ -1,4 +1,4 @@ -;;;; $Id: event.lisp,v 1.1.1.1 2003/11/03 17:00:54 eenge Exp $ +;;;; $Id: event.lisp,v 1.2 2003/11/03 20:54:10 eenge Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/event.lisp,v $ ;;;; See LICENSE for licensing information. @@ -11,245 +11,325 @@ message.")) (defmethod irc-message-event ((message irc-message)) + (apply-to-hooks message) (client-log (connection message) message "UNHANLDED-EVENT:")) (defmethod irc-message-event ((message irc-error-reply)) + (apply-to-hooks message) (let* ((connection (connection message)) (stream (client-stream connection))) (client-log connection message))) (defmethod irc-message-event ((message irc-rpl_welcome-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-rpl_yourhost-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-rpl_created-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-rpl_myinfo-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-rpl_bounce-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-rpl_tracelink-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-rpl_traceconnecting-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-rpl_tracehandshake-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-rpl_traceunknown-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-rpl_traceoperator-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-rpl_traceuser-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-rpl_traceservice-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-rpl_tracenewtype-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-rpl_traceclass-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-rpl_tracereconnect-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-rpl_statslinkinfo-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-rpl_statscommands-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-rpl_statscline-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-rpl_statsnline-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-rpl_statsiline-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-rpl_statskline-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-rpl_statsqline-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-rpl_statsyline-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-rpl_endofstats-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-rpl_umodeis-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-rpl_statsdline-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-rpl_option-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-rpl_endoptions-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-rpl_serviceinfo-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-rpl_endofservices-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-rpl_service-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-rpl_servlist-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-rpl_servlistend-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-rpl_statsvline-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-rpl_statslline-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-rpl_statsonline-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-rpl_statshline-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-rpl_statssline-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-rpl_statsping-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-rpl_statsbline-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-rpl_statsuline-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-rpl_statsdebug-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-rpl_luserclient-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-rpl_luserop-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-rpl_luserunknown-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-rpl_luserchannels-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-rpl_luserme-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-rpl_adminme-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-rpl_adminloc1-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-rpl_adminloc2-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-rpl_adminemail-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-rpl_tracelog-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-rpl_traceend-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-rpl_tryagain-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-rpl_localusers-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-rpl_globalusers-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-rpl_mode-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-rpl_endmode-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-rpl_sitelist-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-rpl_clientcapab-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-rpl_noservicehost-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-rpl_none-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-rpl_away-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-rpl_userhost-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-rpl_ison-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-rpl_unaway-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-rpl_noaway-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-rpl_whoisuser-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-rpl_whoisserver-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-rpl_whoisoperator-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-rpl_whowasuser-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-rpl_endofwho-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-rpl_whoischanop-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-rpl_whoisidle-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-rpl_endofwhois-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-rpl_whoischannels-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-rpl_liststart-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-rpl_list-message)) + (apply-to-hooks message) (let ((connection (connection message)) (channel (second (arguments message))) (user-count (parse-integer (or (third (arguments message)) "0"))) @@ -261,59 +341,77 @@ (channel-list connection)))) (defmethod irc-message-event ((message irc-rpl_listend-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-rpl_channelmodeis-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-rpl_uniqopis-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-rpl_whoisoperprivs-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-rpl_whoisrealhost-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-rpl_creationtime-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-rpl_notopic-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-rpl_topic-message)) + (apply-to-hooks message) (setf (topic (find-channel (connection message) (second (arguments message)))) (trailing-argument message))) (defmethod irc-message-event ((message irc-rpl_topicwhotime-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-rpl_inviting-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-rpl_summoning-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-rpl_invitelist-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-rpl_endofinvitelist-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-rpl_exceptlist-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-rpl_endofexceptlist-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-rpl_version-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-rpl_whoreply-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-rpl_namreply-message)) + (apply-to-hooks message) (let ((channel (find-channel (connection message) (car (last (arguments message)))))) (dolist (nickname (tokenize-string (trailing-argument message))) (add-user channel @@ -323,87 +421,115 @@ :hostname (host message)))))) (defmethod irc-message-event ((message irc-rpl_killdone-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-rpl_closing-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-rpl_closeend-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-rpl_endofnames-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-rpl_links-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-rpl_endoflinks-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-rpl_banlist-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-rpl_endofbanlist-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-rpl_endofwhowas-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-rpl_info-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-rpl_motd-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-rpl_infostart-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-rpl_endofinfo-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-rpl_motdstart-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-rpl_endofmotd-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-rpl_map-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-rpl_endofmap-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-rpl_forward-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-rpl_youreoper-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-rpl_rehashing-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-rpl_yourservice-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-rpl_myportis-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-rpl_time-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-rpl_usersstart-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-rpl_users-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-rpl_endofusers-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-rpl_nousers-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-rpl_message-message)) + (apply-to-hooks message) (client-log (connection message) message)) ;; @@ -411,217 +537,288 @@ ;; (defmethod irc-message-event ((message irc-err_nosuchnick-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-err_nosuchserver-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-err_nosuchchannel-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-err_cannotsendtochan-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-err_toomanychannels-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-err_wasnosuchnick-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-err_nosuchservice-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-err_noorigin-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-err_services_offline-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-err_norecipient-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-err_notexttosend-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-err_notoplevel-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-err_wildtoplevel-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-err_badmask-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-err_unknowncommand-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-err_nomotd-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-err_noadmininfo-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-err_fileerror-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-err_nonicknamegiven-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-err_erroneusnickname-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-err_nicknameinuse-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-err_nickcollision-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-err_unavailresource-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-err_bannickchange-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-err_usernotinchannel-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-err_notonchannel-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-err_useronchannel-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-err_nologin-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-err_summondisabled-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-err_userdisabled-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-err_targetninvite-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-err_sourceninvite-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-err_notregistered-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-err_needmoreparams-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-err_alreadyregistered-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-err_nopermforhost-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-err_passwdmismatch-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-err_yourebannedcreep-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-err_youwillbebanned-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-err_keyset-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-err_channelisfull-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-err_unknownmode-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-err_inviteonlychan-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-err_bannedfromchan-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-err_badchannelkey-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-err_badchanmask-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-err_nochanmodes-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-err_banlistfull-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-err_badchanname-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-err_throttled-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-err_noprivileges-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-err_chanoprivsneeded-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-err_cantkillserver-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-err_restricted-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-err_uniqopprivsneeded-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-err_no_op_split-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-err_need_umode-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-err_nooperhost-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-err_umodeunknownflag-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-err_usersdontmatch-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-err_ghostedclient-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-err_blocking_notid-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-err_sitelistfull-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-err_maxmapnodes-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-err_maxforwarding-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-err_noforwarding-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-err_nounidentified-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-err_last_err_msg-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-ping-message)) + (apply-to-hooks message) (client-log (connection message) message) (pong (trailing-argument message) (connection message))) (defmethod irc-message-event ((message irc-error-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-join-message)) + (apply-to-hooks message) (client-log (connection message) message) (let* ((connection (connection message)) (user (find-or-make-user @@ -636,12 +833,14 @@ (add-user channel user)))) (defmethod irc-message-event ((message irc-topic-message)) + (apply-to-hooks message) (client-log (connection message) message) (setf (topic (find-channel (connection message) (first (arguments message)))) (trailing-argument message))) (defmethod irc-message-event ((message irc-part-message)) + (apply-to-hooks message) (client-log (connection message) message) (let* ((connection (connection message)) (channel (find-channel connection (first (arguments message)))) @@ -651,10 +850,12 @@ (remove-user channel user)))) (defmethod irc-message-event ((message irc-quit-message)) + (apply-to-hooks message) (let ((connection (connection message))) (remove-user-everywhere connection (find-user connection (source message))))) (defmethod irc-message-event ((message irc-nick-message)) + (apply-to-hooks message) (when (self-message-p message) (setf (nickname (user (connection message))) (trailing-argument message))) @@ -666,18 +867,22 @@ (source message)))))) (defmethod irc-message-event ((message irc-notice-message)) + (apply-to-hooks message) (client-log (connection message) message)) ;; if we don't know about the user, we should probably add him here to ;; the dangling-users as he is messaging us without being on a channel ;; we are. (defmethod irc-message-event ((message irc-privmsg-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-mode-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message irc-kick-message)) + (apply-to-hooks message) (client-log (connection message) message) (let* ((connection (connection message)) (channel (find-channel connection (first (arguments message)))) @@ -691,6 +896,7 @@ ;; (defmethod irc-message-event ((message ctcp-time-message)) + (apply-to-hooks message) (client-log (connection message) message) (multiple-value-bind (second minute hour date month year day) (get-decoded-time) (send-irc-message @@ -701,9 +907,11 @@ (source message)))) (defmethod irc-message-event ((message ctcp-action-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message ctcp-source-message)) + (apply-to-hooks message) (client-log (connection message) message) (send-irc-message (connection message) @@ -715,6 +923,7 @@ (source message))) (defmethod irc-message-event ((message ctcp-finger-message)) + (apply-to-hooks message) (client-log (connection message) message) (let* ((user (user (connection message))) (finger-info (if (not (zerop (length (realname user)))) @@ -727,6 +936,7 @@ (source message)))) (defmethod irc-message-event ((message ctcp-version-message)) + (apply-to-hooks message) (client-log (connection message) message) (send-irc-message (connection message) @@ -738,6 +948,7 @@ (client-log (connection message) message)) (defmethod irc-message-event ((message ctcp-ping-message)) + (apply-to-hooks message) (client-log (connection message) message) (send-irc-message (connection message) From eenge at common-lisp.net Mon Nov 3 20:55:08 2003 From: eenge at common-lisp.net (Erik Enge) Date: Mon, 03 Nov 2003 15:55:08 -0500 Subject: [net-nittin-irc-cvs] CVS update: net-nittin-irc/protocol.lisp Message-ID: Update of /project/net-nittin-irc/cvsroot/net-nittin-irc In directory common-lisp.net:/tmp/cvs-serv10663 Modified Files: protocol.lisp Log Message: adding add-hook, remove-hook, get-hooks and apply-to-hook Date: Mon Nov 3 15:55:05 2003 Author: eenge Index: net-nittin-irc/protocol.lisp diff -u net-nittin-irc/protocol.lisp:1.2 net-nittin-irc/protocol.lisp:1.3 --- net-nittin-irc/protocol.lisp:1.2 Mon Nov 3 12:25:48 2003 +++ net-nittin-irc/protocol.lisp Mon Nov 3 15:55:00 2003 @@ -1,4 +1,4 @@ -;;;; $Id: protocol.lisp,v 1.2 2003/11/03 17:25:48 eenge Exp $ +;;;; $Id: protocol.lisp,v 1.3 2003/11/03 20:55:00 eenge Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/protocol.lisp,v $ ;;;; See LICENSE for licensing information. @@ -48,6 +48,10 @@ :initform nil :documentation "A list of channels known to this server as recorded by the LIST command.") + (hooks + :initarg :hooks + :accessor hooks + :initform (make-hash-table :test #'equal)) (dangling-users :initarg :dangling-users :accessor dangling-users @@ -67,15 +71,19 @@ (client-stream t) (channels nil) (dangling-users nil) + (hooks nil) (channel-list nil)) - (make-instance 'connection - :user user - :server-name server-name - :server-stream server-stream - :client-stream client-stream - :channels channels - :dangling-users dangling-users - :channel-list channel-list)) + (let ((connection (make-instance 'connection + :user user + :server-name server-name + :server-stream server-stream + :client-stream client-stream + :channels channels + :dangling-users dangling-users + :channel-list channel-list))) + (dolist (hook hooks) + (add-hook connection (car hook) (cadr hook))) + connection)) (defmethod client-raw-log ((connection connection) message) (let ((stream (client-stream connection))) @@ -131,6 +139,22 @@ (dolist (channel (channels connection)) (push channel channel-list)) channel-list)) + +(defmethod get-hooks ((connection connection) (class symbol)) + (gethash class (hooks connection))) + +(defmethod add-hook ((connection connection) class hook) + (setf (gethash class (hooks connection)) + (pushnew hook (gethash class (hooks connection))))) + +(defmethod remove-hook ((connection connection) class hook) + (setf (gethash class (hooks connection)) + (delete hook (gethash class (hooks connection))))) + +(defmethod apply-to-hooks ((message irc-message)) + (let ((connection (connection message))) + (dolist (hook (get-hooks connection (class-name (class-of message)))) + (funcall hook message)))) ;; ;; Channel From eenge at common-lisp.net Mon Nov 3 20:56:19 2003 From: eenge at common-lisp.net (Erik Enge) Date: Mon, 03 Nov 2003 15:56:19 -0500 Subject: [net-nittin-irc-cvs] CVS update: net-nittin-irc/package.lisp Message-ID: Update of /project/net-nittin-irc/cvsroot/net-nittin-irc In directory common-lisp.net:/tmp/cvs-serv12198 Modified Files: package.lisp Log Message: exporting add-hook, remove-hook and get-hooks Date: Mon Nov 3 15:56:19 2003 Author: eenge Index: net-nittin-irc/package.lisp diff -u net-nittin-irc/package.lisp:1.1.1.1 net-nittin-irc/package.lisp:1.2 --- net-nittin-irc/package.lisp:1.1.1.1 Mon Nov 3 12:00:54 2003 +++ net-nittin-irc/package.lisp Mon Nov 3 15:56:18 2003 @@ -1,4 +1,4 @@ -;;;; $Id: package.lisp,v 1.1.1.1 2003/11/03 17:00:54 eenge Exp $ +;;;; $Id: package.lisp,v 1.2 2003/11/03 20:56:18 eenge Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/package.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -12,6 +12,9 @@ (:export :read-message-loop :read-message :send-irc-message + :add-hook + :remove-hook + :get-hooks :make-user :make-connection :make-channel From eenge at common-lisp.net Mon Nov 3 20:57:52 2003 From: eenge at common-lisp.net (Erik Enge) Date: Mon, 03 Nov 2003 15:57:52 -0500 Subject: [net-nittin-irc-cvs] CVS update: net-nittin-irc/protocol.lisp Message-ID: Update of /project/net-nittin-irc/cvsroot/net-nittin-irc In directory common-lisp.net:/tmp/cvs-serv12512 Modified Files: protocol.lisp Log Message: move below irc-message.... *sigh* Date: Mon Nov 3 15:57:52 2003 Author: eenge Index: net-nittin-irc/protocol.lisp diff -u net-nittin-irc/protocol.lisp:1.3 net-nittin-irc/protocol.lisp:1.4 --- net-nittin-irc/protocol.lisp:1.3 Mon Nov 3 15:55:00 2003 +++ net-nittin-irc/protocol.lisp Mon Nov 3 15:57:52 2003 @@ -1,4 +1,4 @@ -;;;; $Id: protocol.lisp,v 1.3 2003/11/03 20:55:00 eenge Exp $ +;;;; $Id: protocol.lisp,v 1.4 2003/11/03 20:57:52 eenge Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/protocol.lisp,v $ ;;;; See LICENSE for licensing information. @@ -151,11 +151,6 @@ (setf (gethash class (hooks connection)) (delete hook (gethash class (hooks connection))))) -(defmethod apply-to-hooks ((message irc-message)) - (let ((connection (connection message))) - (dolist (hook (get-hooks connection (class-name (class-of message)))) - (funcall hook message)))) - ;; ;; Channel ;; @@ -373,6 +368,11 @@ (arguments message) (trailing-argument message)) (force-output stream))) + +(defmethod apply-to-hooks ((message irc-message)) + (let ((connection (connection message))) + (dolist (hook (get-hooks connection (class-name (class-of message)))) + (funcall hook message)))) ;; ;; CTCP Message From eenge at common-lisp.net Mon Nov 3 21:04:48 2003 From: eenge at common-lisp.net (Erik Enge) Date: Mon, 03 Nov 2003 16:04:48 -0500 Subject: [net-nittin-irc-cvs] CVS update: net-nittin-irc/event.lisp Message-ID: Update of /project/net-nittin-irc/cvsroot/net-nittin-irc In directory common-lisp.net:/tmp/cvs-serv16539 Modified Files: event.lisp Log Message: adding client-log on those methods that didn't have it Date: Mon Nov 3 16:04:43 2003 Author: eenge Index: net-nittin-irc/event.lisp diff -u net-nittin-irc/event.lisp:1.2 net-nittin-irc/event.lisp:1.3 --- net-nittin-irc/event.lisp:1.2 Mon Nov 3 15:54:10 2003 +++ net-nittin-irc/event.lisp Mon Nov 3 16:04:41 2003 @@ -1,4 +1,4 @@ -;;;; $Id: event.lisp,v 1.2 2003/11/03 20:54:10 eenge Exp $ +;;;; $Id: event.lisp,v 1.3 2003/11/03 21:04:41 eenge Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/event.lisp,v $ ;;;; See LICENSE for licensing information. @@ -330,6 +330,7 @@ (defmethod irc-message-event ((message irc-rpl_list-message)) (apply-to-hooks message) + (client-log (connection message) message) (let ((connection (connection message)) (channel (second (arguments message))) (user-count (parse-integer (or (third (arguments message)) "0"))) @@ -370,6 +371,7 @@ (defmethod irc-message-event ((message irc-rpl_topic-message)) (apply-to-hooks message) + (client-log (connection message) message) (setf (topic (find-channel (connection message) (second (arguments message)))) (trailing-argument message))) @@ -412,6 +414,7 @@ (defmethod irc-message-event ((message irc-rpl_namreply-message)) (apply-to-hooks message) + (client-log (connection message) message) (let ((channel (find-channel (connection message) (car (last (arguments message)))))) (dolist (nickname (tokenize-string (trailing-argument message))) (add-user channel @@ -851,11 +854,13 @@ (defmethod irc-message-event ((message irc-quit-message)) (apply-to-hooks message) + (client-log (connection message) message) (let ((connection (connection message))) (remove-user-everywhere connection (find-user connection (source message))))) (defmethod irc-message-event ((message irc-nick-message)) (apply-to-hooks message) + (client-log (connection message) message) (when (self-message-p message) (setf (nickname (user (connection message))) (trailing-argument message))) From eenge at common-lisp.net Mon Nov 3 21:09:16 2003 From: eenge at common-lisp.net (Erik Enge) Date: Mon, 03 Nov 2003 16:09:16 -0500 Subject: [net-nittin-irc-cvs] CVS update: net-nittin-irc/TODO Message-ID: Update of /project/net-nittin-irc/cvsroot/net-nittin-irc In directory common-lisp.net:/tmp/cvs-serv18441 Modified Files: TODO Log Message: hooks are now done Date: Mon Nov 3 16:09:16 2003 Author: eenge Index: net-nittin-irc/TODO diff -u net-nittin-irc/TODO:1.2 net-nittin-irc/TODO:1.3 --- net-nittin-irc/TODO:1.2 Mon Nov 3 12:28:12 2003 +++ net-nittin-irc/TODO Mon Nov 3 16:09:14 2003 @@ -1,9 +1,8 @@ - Modes needs to be updated for users and channels. - - Add hook concept so users hook into event dispatching. - - Add DCC - - Add CTCP sending commands (version, time, etc.) + - Add CTCP sending commands (version, time, etc.); receiving + commands are in place. From eenge at common-lisp.net Mon Nov 3 22:16:47 2003 From: eenge at common-lisp.net (Erik Enge) Date: Mon, 03 Nov 2003 17:16:47 -0500 Subject: [net-nittin-irc-cvs] CVS update: net-nittin-irc/README Message-ID: Update of /project/net-nittin-irc/cvsroot/net-nittin-irc In directory common-lisp.net:/tmp/cvs-serv19065 Modified Files: README Log Message: more info on hooks Date: Mon Nov 3 17:16:47 2003 Author: eenge Index: net-nittin-irc/README diff -u net-nittin-irc/README:1.1 net-nittin-irc/README:1.2 --- net-nittin-irc/README:1.1 Mon Nov 3 12:14:54 2003 +++ net-nittin-irc/README Mon Nov 3 17:16:47 2003 @@ -7,12 +7,12 @@ * (in-package :irc) - * (setf connection (connect)) + * (setf connection (connect :nickname "mynick" + :server "irc.somewhere.org")) * (read-message-loop connection) -That's it. Although you might want to check out the connect function -and its keyword arguments. Interrupt the read-message-loop and do: +That's it. Interrupt the read-message-loop and do: * (join connection "#lisp") @@ -20,6 +20,16 @@ command, you need to get back on the feed: * (read-message-loop connection) + +If you need to do something on every join, do: + + * (defun my-hook (message) + ) + + * (add-hook connection 'irc-join-message #'my-hook) + +and it will be run next time the library receives an irc-join-message. +For a full list of messages you can hook into, look at event.lisp. Erik Enge, erik at nittin.net From eenge at common-lisp.net Mon Nov 3 22:22:18 2003 From: eenge at common-lisp.net (Erik Enge) Date: Mon, 03 Nov 2003 17:22:18 -0500 Subject: [net-nittin-irc-cvs] CVS update: net-nittin-irc/README Message-ID: Update of /project/net-nittin-irc/cvsroot/net-nittin-irc In directory common-lisp.net:/tmp/cvs-serv21270 Modified Files: README Log Message: information on connection objects Date: Mon Nov 3 17:22:18 2003 Author: eenge Index: net-nittin-irc/README diff -u net-nittin-irc/README:1.2 net-nittin-irc/README:1.3 --- net-nittin-irc/README:1.2 Mon Nov 3 17:16:47 2003 +++ net-nittin-irc/README Mon Nov 3 17:22:18 2003 @@ -31,5 +31,9 @@ and it will be run next time the library receives an irc-join-message. For a full list of messages you can hook into, look at event.lisp. +Your connection object will get updated by the library with regards to +users joining/parting channels, you joining/parting channels, etc. +Look at protocol.lisp's connection object for slots and methods. + Erik Enge, erik at nittin.net From eenge at common-lisp.net Mon Nov 3 22:23:34 2003 From: eenge at common-lisp.net (Erik Enge) Date: Mon, 03 Nov 2003 17:23:34 -0500 Subject: [net-nittin-irc-cvs] CVS update: net-nittin-irc/TODO Message-ID: Update of /project/net-nittin-irc/cvsroot/net-nittin-irc In directory common-lisp.net:/tmp/cvs-serv21527 Modified Files: TODO Log Message: didn't realize, but I've already added a CTCP method in command.lisp Date: Mon Nov 3 17:23:33 2003 Author: eenge Index: net-nittin-irc/TODO diff -u net-nittin-irc/TODO:1.3 net-nittin-irc/TODO:1.4 --- net-nittin-irc/TODO:1.3 Mon Nov 3 16:09:14 2003 +++ net-nittin-irc/TODO Mon Nov 3 17:23:33 2003 @@ -2,7 +2,3 @@ - Modes needs to be updated for users and channels. - Add DCC - - - Add CTCP sending commands (version, time, etc.); receiving - commands are in place. - From eenge at common-lisp.net Wed Nov 5 13:56:38 2003 From: eenge at common-lisp.net (Erik Enge) Date: Wed, 05 Nov 2003 08:56:38 -0500 Subject: [net-nittin-irc-cvs] CVS update: Module improted: public_html Message-ID: Update of /project/net-nittin-irc/cvsroot/public_html In directory common-lisp.net:/tmp/cvs-serv7166 Log Message: initial import Status: Vendor Tag: eenge Release Tags: init N public_html/index.html No conflicts created by this import Date: Wed Nov 5 08:56:33 2003 Author: eenge New module public_html added From eenge at common-lisp.net Wed Nov 5 14:00:47 2003 From: eenge at common-lisp.net (Erik Enge) Date: Wed, 05 Nov 2003 09:00:47 -0500 Subject: [net-nittin-irc-cvs] CVS update: public_html/index.html Message-ID: Update of /project/net-nittin-irc/cvsroot/public_html In directory common-lisp.net:/home/eenge/tmp/net-nittin-irc-public_html Modified Files: index.html Log Message: fixing email address Date: Wed Nov 5 09:00:45 2003 Author: eenge Index: public_html/index.html diff -u public_html/index.html:1.1.1.1 public_html/index.html:1.2 --- public_html/index.html:1.1.1.1 Wed Nov 5 08:56:24 2003 +++ public_html/index.html Wed Nov 5 09:00:44 2003 @@ -30,7 +30,7 @@ client and that therefore much of the code is copyright him.

-
Erik Enge
+
Erik Enge
Last modified: Wed Nov 5 08:58:01 EST 2003 From eenge at common-lisp.net Fri Nov 7 13:43:08 2003 From: eenge at common-lisp.net (Erik Enge) Date: Fri, 07 Nov 2003 08:43:08 -0500 Subject: [net-nittin-irc-cvs] CVS update: net-nittin-irc/command.lisp net-nittin-irc/event.lisp net-nittin-irc/net-nittin-irc.asd net-nittin-irc/package.lisp net-nittin-irc/parse-message.lisp net-nittin-irc/protocol.lisp net-nittin-irc/utility.lisp net-nittin-irc/variable.lisp Message-ID: Update of /project/net-nittin-irc/cvsroot/net-nittin-irc In directory common-lisp.net:/tmp/cvs-serv3226 Modified Files: command.lisp event.lisp net-nittin-irc.asd package.lisp parse-message.lisp protocol.lisp utility.lisp variable.lisp Log Message: - the beginnings of DCC support - I entirely rewrote the parsing functions and we should now have much more maintainable code. The new code might be a tad slower but until someone can prove they need the speed or have a patch that doesn't impact maintainability too much I don't see a reason for optimizing it any. Date: Fri Nov 7 08:43:06 2003 Author: eenge Index: net-nittin-irc/command.lisp diff -u net-nittin-irc/command.lisp:1.1.1.1 net-nittin-irc/command.lisp:1.2 --- net-nittin-irc/command.lisp:1.1.1.1 Mon Nov 3 12:00:54 2003 +++ net-nittin-irc/command.lisp Fri Nov 7 08:43:06 2003 @@ -1,4 +1,4 @@ -;;;; $Id: command.lisp,v 1.1.1.1 2003/11/03 17:00:54 eenge Exp $ +;;;; $Id: command.lisp,v 1.2 2003/11/07 13:43:06 eenge Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/command.lisp,v $ ;;;; See LICENSE for licensing information. @@ -190,7 +190,9 @@ :element-type 'character) #+allegro (socket:make-socket :remote-host server :remote-port port) #+sbcl (connect-to-server-socket server port)) - (user (make-user :nickname nickname)) + (user (make-user :nickname nickname + :username username + :realname realname)) (connection (make-connection :server-stream stream :user user :server-name server))) @@ -272,6 +274,27 @@ (defmethod ison ((connection connection) (user user)) (ison connection (nickname user))) -;; utility function not part of the RFC +;; utility functions not part of the RFC (defmethod ctcp ((connection connection) target message) - (send-irc-message connection :privmsg (make-ctcp-message message) target)) \ No newline at end of file + (send-irc-message connection :privmsg (make-ctcp-message message) target)) + +(defmethod ctcp-chat-initiate ((connection connection) (nickname string)) + (let ((socket (sb-bsd-sockets:make-inet-socket :stream :tcp)) + (port 44347)) + (sb-bsd-sockets:socket-bind socket #(127 0 0 1) port) ; arbitrary port + (sb-bsd-sockets:socket-listen socket 1) ; accept one connection + (ctcp connection nickname + (format nil "DCC CHAT chat ~A ~A" + ; the use of hostname here is incorrect (it could be a firewall's IP) + (host-byte-order (hostname (user connection))) port)) + (make-dcc-connection :user (find-user connection nickname) + :input-stream t + :output-stream (sb-bsd-sockets:socket-make-stream socket :input t :output t :buffering :none) + :socket socket))) + +(defmethod ctcp-chat-accept ((connection connection) nickname hostname port) + (let ((socket (sb-bsd-sockets:make-inet-socket :stream :tcp))) + (sb-bsd-sockets:socket-connect socket hostname port) + (make-dcc-connection :user (find-user connection nickname) + :stream (sb-bsd-sockets:socket-make-stream socket :input t :output t :buffering :none) + :socket socket))) \ No newline at end of file Index: net-nittin-irc/event.lisp diff -u net-nittin-irc/event.lisp:1.3 net-nittin-irc/event.lisp:1.4 --- net-nittin-irc/event.lisp:1.3 Mon Nov 3 16:04:41 2003 +++ net-nittin-irc/event.lisp Fri Nov 7 08:43:06 2003 @@ -1,4 +1,4 @@ -;;;; $Id: event.lisp,v 1.3 2003/11/03 21:04:41 eenge Exp $ +;;;; $Id: event.lisp,v 1.4 2003/11/07 13:43:06 eenge Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/event.lisp,v $ ;;;; See LICENSE for licensing information. @@ -290,7 +290,14 @@ (defmethod irc-message-event ((message irc-rpl_whoisuser-message)) (apply-to-hooks message) - (client-log (connection message) message)) + (client-log (connection message) message) + (let ((user (find-user (connection message) (second (arguments message)))) + (realname (trailing-argument message)) + (username (third (arguments message))) + (hostname (fourth (arguments message)))) + (setf (realname user) realname) + (setf (username user) username) + (setf (hostname user) hostname))) (defmethod irc-message-event ((message irc-rpl_whoisserver-message)) (apply-to-hooks message) @@ -814,7 +821,7 @@ (defmethod irc-message-event ((message irc-ping-message)) (apply-to-hooks message) (client-log (connection message) message) - (pong (trailing-argument message) (connection message))) + (pong (connection message) (trailing-argument message) )) (defmethod irc-message-event ((message irc-error-message)) (apply-to-hooks message) Index: net-nittin-irc/net-nittin-irc.asd diff -u net-nittin-irc/net-nittin-irc.asd:1.1.1.1 net-nittin-irc/net-nittin-irc.asd:1.2 --- net-nittin-irc/net-nittin-irc.asd:1.1.1.1 Mon Nov 3 12:00:54 2003 +++ net-nittin-irc/net-nittin-irc.asd Fri Nov 7 08:43:06 2003 @@ -1,4 +1,4 @@ -;;;; $Id: net-nittin-irc.asd,v 1.1.1.1 2003/11/03 17:00:54 eenge Exp $ +;;;; $Id: net-nittin-irc.asd,v 1.2 2003/11/07 13:43:06 eenge Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/net-nittin-irc.asd,v $ ;;;; See the LICENSE file for licensing information. @@ -16,7 +16,8 @@ :version "0.1.0" :licence "MIT" :description "Common Lisp interface to the IRC protocol" - #+sbcl :depends-on (:sb-bsd-sockets) + #+sbcl :depends-on (:sb-bsd-sockets :split-sequence) + :depends-on (:split-sequence) :components ((:file "package") (:file "variable" :depends-on ("package")) Index: net-nittin-irc/package.lisp diff -u net-nittin-irc/package.lisp:1.2 net-nittin-irc/package.lisp:1.3 --- net-nittin-irc/package.lisp:1.2 Mon Nov 3 15:56:18 2003 +++ net-nittin-irc/package.lisp Fri Nov 7 08:43:06 2003 @@ -1,4 +1,4 @@ -;;;; $Id: package.lisp,v 1.2 2003/11/03 20:56:18 eenge Exp $ +;;;; $Id: package.lisp,v 1.3 2003/11/07 13:43:06 eenge Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/package.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -11,9 +11,10 @@ (:nicknames :irc) (:export :read-message-loop :read-message - :send-irc-message + :send-message :add-hook :remove-hook + :remove-hooks :get-hooks :make-user :make-connection Index: net-nittin-irc/parse-message.lisp diff -u net-nittin-irc/parse-message.lisp:1.1.1.1 net-nittin-irc/parse-message.lisp:1.2 --- net-nittin-irc/parse-message.lisp:1.1.1.1 Mon Nov 3 12:00:54 2003 +++ net-nittin-irc/parse-message.lisp Fri Nov 7 08:43:06 2003 @@ -1,4 +1,4 @@ -;;;; $Id: parse-message.lisp,v 1.1.1.1 2003/11/03 17:00:54 eenge Exp $ +;;;; $Id: parse-message.lisp,v 1.2 2003/11/07 13:43:06 eenge Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/parse-message.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -14,89 +14,53 @@ 'no-such-reply :reply-number reply-number) :unknown-reply)))) -(declaim (inline parse-irc-message-1)) -(defun parse-irc-message-1 (raw-message-string) - (let ((index 0)) - (macrolet ((accept-char (char) - `(when (eql (char raw-message-string index) ,char) - (incf index) - ,char)) - (accept-to-chars (&rest chars) - `(let ((start index) - (end (position-if (lambda (char) (find char ',chars)) raw-message-string - :start index))) - (when end - (setf index end) - (subseq raw-message-string start end))))) - (labels ((accept-source () - (and (accept-char #\:) (accept-to-chars #\! #\space))) - (accept-user () - (and (accept-char #\!) (accept-to-chars #\@ #\space))) - (accept-host () - (and (accept-char #\@) (accept-to-chars #\space))) - (accept-command () - (or (and (accept-char #\space) (accept-to-chars #\space)) - (accept-to-chars #\space))) - (accept-arguments () - (tokenize-string (or (accept-to-chars #\:) (subseq raw-message-string index)) - :delimiters " ")) - (accept-trailing-argument () - ;; A line in the IRC Protocol ends in CRLF => - ;; Unix READ-LINE reads until a Linefeed occurs: "...CR"LF - ;; Win32 READ-LINE reads until a CR followed by a Linefeed occurs: "..."CRLF - ;; MacOS READ-LINE reads until a Carriage Return occurs: "..."CRLF - (and (accept-char #\:) - #+unix (accept-to-chars #\Return) - #-unix (subseq raw-message-string index))) - (irc-message (&aux source user host command arguments trailing-argument) - (if (and (or (and (setf source (accept-source)) - (setf user (accept-user)) - (setf host (accept-host))) - t) - (setf command (accept-command)) - (or (setf arguments (accept-arguments)) t) - (or (setf trailing-argument (accept-trailing-argument)) t)) - (values source user host command arguments trailing-argument) - (error "IRC Message parse error - source: ~A - user: ~A - host: ~A - command: ~A - arguments: ~A - trailing-argument: ~A~%" source user host command arguments trailing-argument)))) - (irc-message))))) - -(defun parse-irc-message (raw-message-string) - (multiple-value-bind (source user host command arguments trailing-argument) - (parse-irc-message-1 raw-message-string) - (let ((ctcp (parse-ctcp-message trailing-argument)) - (class (cond ((every #'digit-char-p command) - (case (char command 0) - ((#\4 #\5) (setf command (find-reply-name (parse-integer command))) - 'irc-error-reply) - (otherwise - (find-irc-message-class - (setf command (find-reply-name (parse-integer command))))))) - (t (find-irc-message-class - (setf command (intern (string-upcase command) - (find-package :keyword)))))))) - (let ((msg (make-instance class - :source source - :user user - :host host - :command command - :arguments arguments - :connection nil - :trailing-argument trailing-argument - :received-time (get-universal-time) - :raw-message-string raw-message-string))) - (when ctcp - #-cmu(change-class msg (find-ctcp-message-class ctcp) :ctcp-command ctcp) - #+cmu - (progn - (change-class msg (find-ctcp-message-class ctcp)) - (reinitialize-instance msg :ctcp-command ctcp))) - msg)))) +(defun return-source (string &key (start 0)) + (cut-between string #\: '(#\! #\Space) :start start)) + +(defun return-user (string &key (start 0)) + (cut-between string #\! '(#\@ #\Space) :start start)) + +(defun return-host (string &key (start 0)) + (cut-between string #\@ '(#\Space) :start start)) + +(defun return-command (string &key (start 0)) + (if (eql (char string start) #\Space) + (cut-between string #\Space '(#\Space) :start start) + (cut-between string nil '(#\Space) :start start :cut-extra nil))) + +(defun return-arguments (string &key (start 0)) + (multiple-value-bind (end-position return-argument) + (cut-between string nil '(#\:) :start start) + (values end-position (tokenize-string return-argument + :delimiters '(#\Space))))) + +(defun return-trailing-argument (string &key (start 0)) + (cut-between string #\: '(#\Return) :start start)) + +(defun parse-raw-message (string &key (start 0)) + (let ((index start) + (returns nil)) + (dolist (function '(return-source + return-user + return-host + return-command + return-arguments + return-trailing-argument)) + (multiple-value-bind (return-index return-string) + (funcall function string :start index) + (setf index return-index) + (push return-string returns))) + (apply #'values (reverse returns)))) + +(defun irc-error-reply-p (string) + (unless (zerop (length string)) + (if (and (every #'digit-char-p string) + (member (char string 0) '(#\4 #\5))) + t + nil))) + +(defun numeric-reply-p (string) + (every #'digit-char-p string)) (defun ctcp-type-p (string type) "What type of CTCP message is this?" @@ -122,3 +86,38 @@ (#\U (ctcp-type-p string :userinfo)) (otherwise nil)))) +(defun create-irc-message (string) + (multiple-value-bind (source user host command arguments trailing-argument) + (parse-raw-message string) + (let ((class 'irc-message) + (ctcp (parse-ctcp-message trailing-argument))) + (when command + (cond + ((irc-error-reply-p command) + (progn + (setf command (find-reply-name (parse-integer command))) + (setf class 'irc-error-reply))) + ((numeric-reply-p command) + (progn + (setf command (find-reply-name (parse-integer command))) + (setf class (find-irc-message-class command)))) + (t + (progn + (setf command (intern (string-upcase command) + (find-package :keyword))) + (setf class (find-irc-message-class command)))))) + (when ctcp + (setf class (find-ctcp-message-class ctcp))) + (let ((instance (make-instance class + :source source + :user user + :host host + :command command + :arguments arguments + :connection nil + :trailing-argument trailing-argument + :received-time (get-universal-time) + :raw-message-string string))) + (when ctcp + (setf (ctcp-command instance) ctcp)) + instance)))) Index: net-nittin-irc/protocol.lisp diff -u net-nittin-irc/protocol.lisp:1.4 net-nittin-irc/protocol.lisp:1.5 --- net-nittin-irc/protocol.lisp:1.4 Mon Nov 3 15:57:52 2003 +++ net-nittin-irc/protocol.lisp Fri Nov 7 08:43:06 2003 @@ -1,4 +1,4 @@ -;;;; $Id: protocol.lisp,v 1.4 2003/11/03 20:57:52 eenge Exp $ +;;;; $Id: protocol.lisp,v 1.5 2003/11/07 13:43:06 eenge Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/protocol.lisp,v $ ;;;; See LICENSE for licensing information. @@ -112,13 +112,13 @@ (defmethod read-irc-message ((connection connection)) "Read an IRC-message from the connection." - (let ((message (parse-irc-message + (let ((message (create-irc-message (read-line (server-stream connection) t)))) (setf (connection message) connection) message)) (defmethod send-irc-message ((connection connection) command - trailing-argument &rest arguments) + trailing-argument &rest arguments) (let ((raw-message (make-irc-message command :arguments arguments :trailing-argument trailing-argument))) @@ -128,6 +128,7 @@ (defmethod all-users ((connection connection)) (let ((user-list (dangling-users connection))) + (push (user connection) user-list) (dolist (channel (channels connection)) (maphash #'(lambda (key value) (declare (ignore key)) @@ -151,6 +152,63 @@ (setf (gethash class (hooks connection)) (delete hook (gethash class (hooks connection))))) +(defmethod remove-hooks ((connection connection) class) + (setf (gethash class (hooks connection)) nil)) + +;; +;; DCC Connection +;; + +(defclass dcc-connection () + ((user + :initarg :user + :accessor user + :documentation "The user at the other end of this connection. The +user at this end can be reached via your normal connection object.") + (stream + :initarg :stream + :accessor stream) + (socket + :initarg :socket + :accessor socket + :documentation "The actual socket object for the connection +between the two users."))) + +(defmethod print-object ((object dcc-connection) stream) + "Print the object for the Lisp reader." + (print-unreadable-object (object stream :type t :identity t) + (if (user object) + (format stream "with ~A@~A" + (nickname (user object)) + (hostname (user object))) + + ""))) + +(defun make-dcc-connection (&key (user nil) + (socket nil) + (stream nil)) + (let ((connection (make-instance 'dcc-connection + :user user + :stream stream + :socket socket))) + connection)) + +(defmethod read-message ((connection dcc-connection)) + (read-line (stream connection))) + +(defmethod read-message-loop ((connection dcc-connection)) + (loop while (read-message connection))) + +(defmethod send-dcc-message ((connection dcc-connection) message) + (format (stream connection) "~A~%" message)) + +;; argh. I want to name this quit but that gives me issues with +;; generic functions. need to resolve. +(defmethod dcc-close ((connection dcc-connection)) + (close (stream connection)) + (setf (user connection) nil) + (sb-bsd-sockets:socket-close (socket connection))) + ;; ;; Channel ;; @@ -402,17 +460,6 @@ (defmethod find-ctcp-message-class (type) (find-class 'standard-ctcp-message)) - -(defmethod update-instance-for-different-class :before - ((previous irc-message) (current ctcp-mixin) - &rest initargs &key &allow-other-keys) - "Convert a general IRC-MESSAGE to a CTCP message." - (let* ((text (trailing-argument previous)) - (start (position #\space text))) - (setf (trailing-argument current) - (if (and start (< start (length text))) - (subseq text (1+ start) (position +soh+ text :from-end t)) - "")))) (defmethod client-log ((connection connection) (message ctcp-mixin) &optional (prefix "")) (let ((stream (client-stream connection))) Index: net-nittin-irc/utility.lisp diff -u net-nittin-irc/utility.lisp:1.1.1.1 net-nittin-irc/utility.lisp:1.2 --- net-nittin-irc/utility.lisp:1.1.1.1 Mon Nov 3 12:00:54 2003 +++ net-nittin-irc/utility.lisp Fri Nov 7 08:43:06 2003 @@ -1,4 +1,4 @@ -;;;; $Id: utility.lisp,v 1.1.1.1 2003/11/03 17:00:54 eenge Exp $ +;;;; $Id: utility.lisp,v 1.2 2003/11/07 13:43:06 eenge Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/utility.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -79,25 +79,54 @@ (format nil "~A~A~A" +soh+ message +soh+)) (defun tokenize-string (string &key - (delimiters '(#\Space #\Return #\Linefeed #\Newline)) - (test (lambda (c) (find c delimiters))) - (start 0) - (end (length string)) - (omit-delimiters t)) - (flet ((get-token (start) - (if (< start end) - (let* ((delimiterp (funcall test (char string start))) - (end-of-token (funcall (if delimiterp - #'position-if-not - #'position-if) - test string :start start))) - (values (subseq string start end-of-token) end-of-token delimiterp)) - (values nil nil nil)))) - (let ((tokens nil) - token delimiterp) - (loop (multiple-value-setq (token start delimiterp) (get-token start)) - (unless (and delimiterp omit-delimiters) - (push token tokens)) - (unless start - (return-from tokenize-string (nreverse tokens))))))) - + (delimiters '(#\Space #\Return #\Linefeed #\Newline))) + "Split string into a list, splitting on delimiters and removing any +empty subsequences." + (split-sequence:split-sequence-if #'(lambda (character) + (member character delimiters)) + string :remove-empty-subseqs t)) + +(defun list-of-strings-to-integers (list) + "Take a list of strings and return a new list of integers (from +parse-integer) on each of the string elements." + (let ((new-list nil)) + (dolist (element (reverse list)) + (push (parse-integer element) new-list)) + new-list)) + +(defun host-byte-order (string) + "Convert a string, such as 192.168.1.1, to host-byte-order, such as +3232235777." + (let ((list (list-of-strings-to-integers (split-sequence:split-sequence #\. string)))) + (+ (* (first list) 256 256 256) (* (second list) 256 256) + (* (third list) 256) (fourth list)))) + +(defun hbo-to-dotted-quad (integer) + "Host-byte-order integer to dotted-quad string conversion utility." + (let ((first (ldb (byte 8 24) integer)) + (second (ldb (byte 8 16) integer)) + (third (ldb (byte 8 8) integer)) + (fourth (ldb (byte 8 0) integer))) + (format nil "~A.~A.~A.~A" first second third fourth))) + +(defun cut-between (string start-char end-chars &key (start 0) (cut-extra t)) + "If start-char is not nil, cut string between start-char and any of +the end-chars, from start. If start-char is nil, cut from start until +any of the end-chars. + +If cut-extra is t, we will cut from start + 1 instead of just start." + (let ((end-position (position-if #'(lambda (char) + (member char end-chars)) + string :start (1+ start))) + (cut-from (if cut-extra + (1+ start) + start))) + (if (and end-position start-char) + (if (eql (char string start) start-char) + (values end-position + (subseq string cut-from end-position)) + (values start nil)) + (if end-position + (values end-position + (subseq string cut-from end-position)) + (values start nil))))) Index: net-nittin-irc/variable.lisp diff -u net-nittin-irc/variable.lisp:1.2 net-nittin-irc/variable.lisp:1.3 --- net-nittin-irc/variable.lisp:1.2 Mon Nov 3 12:11:17 2003 +++ net-nittin-irc/variable.lisp Fri Nov 7 08:43:06 2003 @@ -1,4 +1,4 @@ -;;;; $Id: variable.lisp,v 1.2 2003/11/03 17:11:17 eenge Exp $ +;;;; $Id: variable.lisp,v 1.3 2003/11/07 13:43:06 eenge Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/variable.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -25,8 +25,6 @@ (defvar *default-irc-server-port* 6667) (defvar *default-quit-message* "Common Lisp IRC library - http://common-lisp.net/project/net-nittin-irc") - -(defvar *event-hooks* nil) (defparameter *reply-names* '((1 :rpl_welcome) From eenge at common-lisp.net Fri Nov 7 13:43:20 2003 From: eenge at common-lisp.net (Erik Enge) Date: Fri, 07 Nov 2003 08:43:20 -0500 Subject: [net-nittin-irc-cvs] CVS update: Directory change: net-nittin-irc/test Message-ID: Update of /project/net-nittin-irc/cvsroot/net-nittin-irc/test In directory common-lisp.net:/tmp/cvs-serv3492/test Log Message: Directory /project/net-nittin-irc/cvsroot/net-nittin-irc/test added to the repository Date: Fri Nov 7 08:43:20 2003 Author: eenge New directory net-nittin-irc/test added From eenge at common-lisp.net Fri Nov 7 13:43:56 2003 From: eenge at common-lisp.net (Erik Enge) Date: Fri, 07 Nov 2003 08:43:56 -0500 Subject: [net-nittin-irc-cvs] CVS update: net-nittin-irc/test/irc-messages.txt Message-ID: Update of /project/net-nittin-irc/cvsroot/net-nittin-irc/test In directory common-lisp.net:/tmp/cvs-serv3554/test Added Files: irc-messages.txt Log Message: adding file with several test messages from a dancer ircd server Date: Fri Nov 7 08:43:56 2003 Author: eenge From eenge at common-lisp.net Fri Nov 7 15:40:19 2003 From: eenge at common-lisp.net (Erik Enge) Date: Fri, 07 Nov 2003 10:40:19 -0500 Subject: [net-nittin-irc-cvs] CVS update: net-nittin-irc/TODO net-nittin-irc/command.lisp net-nittin-irc/event.lisp net-nittin-irc/parse-message.lisp net-nittin-irc/protocol.lisp net-nittin-irc/utility.lisp net-nittin-irc/variable.lisp Message-ID: Update of /project/net-nittin-irc/cvsroot/net-nittin-irc In directory common-lisp.net:/tmp/cvs-serv19942 Modified Files: TODO command.lisp event.lisp parse-message.lisp protocol.lisp utility.lisp variable.lisp Log Message: the library now knows how to accept DCC CHAT requests and how to make dcc-connections, read from them and talk to them. Date: Fri Nov 7 10:40:19 2003 Author: eenge Index: net-nittin-irc/TODO diff -u net-nittin-irc/TODO:1.4 net-nittin-irc/TODO:1.5 --- net-nittin-irc/TODO:1.4 Mon Nov 3 17:23:33 2003 +++ net-nittin-irc/TODO Fri Nov 7 10:40:19 2003 @@ -2,3 +2,15 @@ - Modes needs to be updated for users and channels. - Add DCC + + - From RFC 2812: + + Because of IRC's Scandinavian origin, the characters {}|^ are + considered to be the lower case equivalents of the characters + []\~, respectively. This is a critical issue when determining the + equivalence of two nicknames or channel names. + + So when we do FIND-USER etc. we need to be mindful of this fact. + + - Make it so that the user can choose whether to automatically + accept DCC CHAT requests or not. Index: net-nittin-irc/command.lisp diff -u net-nittin-irc/command.lisp:1.2 net-nittin-irc/command.lisp:1.3 --- net-nittin-irc/command.lisp:1.2 Fri Nov 7 08:43:06 2003 +++ net-nittin-irc/command.lisp Fri Nov 7 10:40:19 2003 @@ -1,4 +1,4 @@ -;;;; $Id: command.lisp,v 1.2 2003/11/07 13:43:06 eenge Exp $ +;;;; $Id: command.lisp,v 1.3 2003/11/07 15:40:19 eenge Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/command.lisp,v $ ;;;; See LICENSE for licensing information. @@ -291,10 +291,3 @@ :input-stream t :output-stream (sb-bsd-sockets:socket-make-stream socket :input t :output t :buffering :none) :socket socket))) - -(defmethod ctcp-chat-accept ((connection connection) nickname hostname port) - (let ((socket (sb-bsd-sockets:make-inet-socket :stream :tcp))) - (sb-bsd-sockets:socket-connect socket hostname port) - (make-dcc-connection :user (find-user connection nickname) - :stream (sb-bsd-sockets:socket-make-stream socket :input t :output t :buffering :none) - :socket socket))) \ No newline at end of file Index: net-nittin-irc/event.lisp diff -u net-nittin-irc/event.lisp:1.4 net-nittin-irc/event.lisp:1.5 --- net-nittin-irc/event.lisp:1.4 Fri Nov 7 08:43:06 2003 +++ net-nittin-irc/event.lisp Fri Nov 7 10:40:19 2003 @@ -1,4 +1,4 @@ -;;;; $Id: event.lisp,v 1.4 2003/11/07 13:43:06 eenge Exp $ +;;;; $Id: event.lisp,v 1.5 2003/11/07 15:40:19 eenge Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/event.lisp,v $ ;;;; See LICENSE for licensing information. @@ -957,6 +957,7 @@ (source message))) (defmethod irc-message-event ((message ctcp-userinfo-message)) + (apply-to-hooks message) (client-log (connection message) message)) (defmethod irc-message-event ((message ctcp-ping-message)) @@ -967,3 +968,20 @@ :notice (make-ctcp-message (format nil "PING ~A" (trailing-argument message))) (source message))) + +;; +;; DCC events (which are a variant of CTCP events) +;; + +(defmethod irc-message-event ((message ctcp-dcc-chat-request-message)) + (apply-to-hooks message) + (client-log (connection message) message) + (let* ((user (find-user (connection message) (source message))) + (args (tokenize-string (trailing-argument message))) + (remote-address (hbo-to-vector-quad (parse-integer (fourth args)))) + (remote-port (parse-integer (fifth args) :junk-allowed t))) + (push (make-dcc-connection :user user + :remote-address remote-address + :remote-port remote-port) + *dcc-connections*))) + Index: net-nittin-irc/parse-message.lisp diff -u net-nittin-irc/parse-message.lisp:1.2 net-nittin-irc/parse-message.lisp:1.3 --- net-nittin-irc/parse-message.lisp:1.2 Fri Nov 7 08:43:06 2003 +++ net-nittin-irc/parse-message.lisp Fri Nov 7 10:40:19 2003 @@ -1,4 +1,4 @@ -;;;; $Id: parse-message.lisp,v 1.2 2003/11/07 13:43:06 eenge Exp $ +;;;; $Id: parse-message.lisp,v 1.3 2003/11/07 15:40:19 eenge Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/parse-message.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -70,6 +70,13 @@ type nil)) +(defun dcc-type-p (string type) + (case type + (:dcc-chat-request + (when (string-equal (char string 5) #\C) + :dcc-chat-request)) + (otherwise nil))) + (defun parse-ctcp-message (string) (if (or (not (stringp string)) (zerop (length string)) @@ -78,12 +85,14 @@ (case (char string 1) (#\A (ctcp-type-p string :action)) (#\C (ctcp-type-p string :clientinfo)) + (#\D + (dcc-type-p string :dcc-chat-request)) + (#\F (ctcp-type-p string :finger)) (#\P (ctcp-type-p string :ping)) (#\S (ctcp-type-p string :source)) - (#\F (ctcp-type-p string :finger)) - (#\V (ctcp-type-p string :version)) (#\T (ctcp-type-p string :time)) (#\U (ctcp-type-p string :userinfo)) + (#\V (ctcp-type-p string :version)) (otherwise nil)))) (defun create-irc-message (string) Index: net-nittin-irc/protocol.lisp diff -u net-nittin-irc/protocol.lisp:1.5 net-nittin-irc/protocol.lisp:1.6 --- net-nittin-irc/protocol.lisp:1.5 Fri Nov 7 08:43:06 2003 +++ net-nittin-irc/protocol.lisp Fri Nov 7 10:40:19 2003 @@ -1,4 +1,4 @@ -;;;; $Id: protocol.lisp,v 1.5 2003/11/07 13:43:06 eenge Exp $ +;;;; $Id: protocol.lisp,v 1.6 2003/11/07 15:40:19 eenge Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/protocol.lisp,v $ ;;;; See LICENSE for licensing information. @@ -168,6 +168,10 @@ (stream :initarg :stream :accessor stream) + (output-stream + :initarg :output-stream + :accessor output-stream + :initform t) (socket :initarg :socket :accessor socket @@ -185,16 +189,21 @@ ""))) (defun make-dcc-connection (&key (user nil) - (socket nil) - (stream nil)) - (let ((connection (make-instance 'dcc-connection - :user user - :stream stream - :socket socket))) - connection)) + (remote-address nil) + (remote-port nil) + (output-stream t)) + (let ((socket (sb-bsd-sockets:make-inet-socket :stream :tcp))) + (sb-bsd-sockets:socket-connect socket remote-address remote-port) + (make-instance 'dcc-connection + :user user + :stream (sb-bsd-sockets:socket-make-stream socket :input t :output t :buffering :none) + :socket socket + :output-stream t))) (defmethod read-message ((connection dcc-connection)) - (read-line (stream connection))) + (format (output-stream connection) "~A~%" (read-line (stream connection))) + (force-output (output-stream connection)) + t) (defmethod read-message-loop ((connection dcc-connection)) (loop while (read-message connection))) @@ -207,8 +216,14 @@ (defmethod dcc-close ((connection dcc-connection)) (close (stream connection)) (setf (user connection) nil) + (setf *dcc-connections* (remove connection *dcc-connections*)) (sb-bsd-sockets:socket-close (socket connection))) +(defmethod connectedp ((connection dcc-connection)) + (let ((stream (stream connection))) + (and (streamp stream) + (open-stream-p stream)))) + ;; ;; Channel ;; @@ -456,7 +471,7 @@ ;; should perhaps wrap this in an eval-when? (create-ctcp-message-classes '(:action :source :finger :ping - :version :userinfo :time)) + :version :userinfo :time :dcc-chat-request)) (defmethod find-ctcp-message-class (type) (find-class 'standard-ctcp-message)) Index: net-nittin-irc/utility.lisp diff -u net-nittin-irc/utility.lisp:1.2 net-nittin-irc/utility.lisp:1.3 --- net-nittin-irc/utility.lisp:1.2 Fri Nov 7 08:43:06 2003 +++ net-nittin-irc/utility.lisp Fri Nov 7 10:40:19 2003 @@ -1,4 +1,4 @@ -;;;; $Id: utility.lisp,v 1.2 2003/11/07 13:43:06 eenge Exp $ +;;;; $Id: utility.lisp,v 1.3 2003/11/07 15:40:19 eenge Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/utility.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -108,6 +108,14 @@ (third (ldb (byte 8 8) integer)) (fourth (ldb (byte 8 0) integer))) (format nil "~A.~A.~A.~A" first second third fourth))) + +(defun hbo-to-vector-quad (integer) + "Host-byte-order integer to dotted-quad string conversion utility." + (let ((first (ldb (byte 8 24) integer)) + (second (ldb (byte 8 16) integer)) + (third (ldb (byte 8 8) integer)) + (fourth (ldb (byte 8 0) integer))) + (vector first second third fourth))) (defun cut-between (string start-char end-chars &key (start 0) (cut-extra t)) "If start-char is not nil, cut string between start-char and any of Index: net-nittin-irc/variable.lisp diff -u net-nittin-irc/variable.lisp:1.3 net-nittin-irc/variable.lisp:1.4 --- net-nittin-irc/variable.lisp:1.3 Fri Nov 7 08:43:06 2003 +++ net-nittin-irc/variable.lisp Fri Nov 7 10:40:19 2003 @@ -1,4 +1,4 @@ -;;;; $Id: variable.lisp,v 1.3 2003/11/07 13:43:06 eenge Exp $ +;;;; $Id: variable.lisp,v 1.4 2003/11/07 15:40:19 eenge Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/variable.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -25,6 +25,8 @@ (defvar *default-irc-server-port* 6667) (defvar *default-quit-message* "Common Lisp IRC library - http://common-lisp.net/project/net-nittin-irc") + +(defvar *dcc-connections* nil) (defparameter *reply-names* '((1 :rpl_welcome) From eenge at common-lisp.net Mon Nov 10 17:25:39 2003 From: eenge at common-lisp.net (Erik Enge) Date: Mon, 10 Nov 2003 12:25:39 -0500 Subject: [net-nittin-irc-cvs] CVS update: net-nittin-irc/TODO net-nittin-irc/event.lisp net-nittin-irc/package.lisp net-nittin-irc/parse-message.lisp net-nittin-irc/protocol.lisp Message-ID: Update of /project/net-nittin-irc/cvsroot/net-nittin-irc In directory common-lisp.net:/tmp/cvs-serv2300 Modified Files: TODO event.lisp package.lisp parse-message.lisp protocol.lisp Log Message: many fixes, exports and partial DCC SEND/CHAT implementation Date: Mon Nov 10 12:25:38 2003 Author: eenge Index: net-nittin-irc/TODO diff -u net-nittin-irc/TODO:1.5 net-nittin-irc/TODO:1.6 --- net-nittin-irc/TODO:1.5 Fri Nov 7 10:40:19 2003 +++ net-nittin-irc/TODO Mon Nov 10 12:25:38 2003 @@ -11,6 +11,3 @@ equivalence of two nicknames or channel names. So when we do FIND-USER etc. we need to be mindful of this fact. - - - Make it so that the user can choose whether to automatically - accept DCC CHAT requests or not. Index: net-nittin-irc/event.lisp diff -u net-nittin-irc/event.lisp:1.5 net-nittin-irc/event.lisp:1.6 --- net-nittin-irc/event.lisp:1.5 Fri Nov 7 10:40:19 2003 +++ net-nittin-irc/event.lisp Mon Nov 10 12:25:38 2003 @@ -1,4 +1,4 @@ -;;;; $Id: event.lisp,v 1.5 2003/11/07 15:40:19 eenge Exp $ +;;;; $Id: event.lisp,v 1.6 2003/11/10 17:25:38 eenge Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/event.lisp,v $ ;;;; See LICENSE for licensing information. @@ -976,12 +976,30 @@ (defmethod irc-message-event ((message ctcp-dcc-chat-request-message)) (apply-to-hooks message) (client-log (connection message) message) - (let* ((user (find-user (connection message) (source message))) - (args (tokenize-string (trailing-argument message))) - (remote-address (hbo-to-vector-quad (parse-integer (fourth args)))) - (remote-port (parse-integer (fifth args) :junk-allowed t))) - (push (make-dcc-connection :user user - :remote-address remote-address - :remote-port remote-port) - *dcc-connections*))) + (when (automatically-accept-dcc-connections (configuration (connection message))) + (let* ((user (find-user (connection message) (source message))) + (args (tokenize-string (trailing-argument message))) + (remote-address (hbo-to-vector-quad (parse-integer (fourth args)))) + (remote-port (parse-integer (fifth args) :junk-allowed t))) + (push (make-dcc-connection :user user + :remote-address remote-address + :remote-port remote-port) + *dcc-connections*)))) + +(defmethod irc-message-event ((message ctcp-dcc-send-request-message)) + (apply-to-hooks message) + (client-log (connection message) message) + (when (automatically-accept-dcc-downloads (configuration (connection message))) + (let* ((user (find-user (connection message) (source message))) + (args (tokenize-string (trailing-argument message))) + (filename (third args)) + (remote-address (hbo-to-vector-quad (parse-integer (fourth args)))) + (remote-port (parse-integer (fifth args))) + (filesize (parse-integer (sixth args) :junk-allowed t))) + (let ((dcc-connection (make-dcc-connection :user user + :remote-address remote-address + :remote-port remote-port))) + (with-open-file (stream filename :direction :output + :if-exists :supersede) + (write-sequence (read-message-loop dcc-connection) stream)))))) Index: net-nittin-irc/package.lisp diff -u net-nittin-irc/package.lisp:1.3 net-nittin-irc/package.lisp:1.4 --- net-nittin-irc/package.lisp:1.3 Fri Nov 7 08:43:06 2003 +++ net-nittin-irc/package.lisp Mon Nov 10 12:25:38 2003 @@ -1,4 +1,4 @@ -;;;; $Id: package.lisp,v 1.3 2003/11/07 13:43:06 eenge Exp $ +;;;; $Id: package.lisp,v 1.4 2003/11/10 17:25:38 eenge Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/package.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -12,6 +12,15 @@ (:export :read-message-loop :read-message :send-message + :server-name + :server-stream + :client-stream + :channels + :configuration + :all-users + :all-channels + :dangling-users + :channel-list :add-hook :remove-hook :remove-hooks Index: net-nittin-irc/parse-message.lisp diff -u net-nittin-irc/parse-message.lisp:1.3 net-nittin-irc/parse-message.lisp:1.4 --- net-nittin-irc/parse-message.lisp:1.3 Fri Nov 7 10:40:19 2003 +++ net-nittin-irc/parse-message.lisp Mon Nov 10 12:25:38 2003 @@ -1,4 +1,4 @@ -;;;; $Id: parse-message.lisp,v 1.3 2003/11/07 15:40:19 eenge Exp $ +;;;; $Id: parse-message.lisp,v 1.4 2003/11/10 17:25:38 eenge Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/parse-message.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -75,6 +75,9 @@ (:dcc-chat-request (when (string-equal (char string 5) #\C) :dcc-chat-request)) + (:dcc-send-request + (when (string-equal (char string 5) #\S) + :dcc-send-request)) (otherwise nil))) (defun parse-ctcp-message (string) @@ -86,7 +89,8 @@ (#\A (ctcp-type-p string :action)) (#\C (ctcp-type-p string :clientinfo)) (#\D - (dcc-type-p string :dcc-chat-request)) + (or (dcc-type-p string :dcc-chat-request) + (dcc-type-p string :dcc-send-request))) (#\F (ctcp-type-p string :finger)) (#\P (ctcp-type-p string :ping)) (#\S (ctcp-type-p string :source)) Index: net-nittin-irc/protocol.lisp diff -u net-nittin-irc/protocol.lisp:1.6 net-nittin-irc/protocol.lisp:1.7 --- net-nittin-irc/protocol.lisp:1.6 Fri Nov 7 10:40:19 2003 +++ net-nittin-irc/protocol.lisp Mon Nov 10 12:25:38 2003 @@ -1,4 +1,4 @@ -;;;; $Id: protocol.lisp,v 1.6 2003/11/07 15:40:19 eenge Exp $ +;;;; $Id: protocol.lisp,v 1.7 2003/11/10 17:25:38 eenge Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/protocol.lisp,v $ ;;;; See LICENSE for licensing information. @@ -52,6 +52,11 @@ :initarg :hooks :accessor hooks :initform (make-hash-table :test #'equal)) + (configuration + :initarg :configuration + :accessor configuration + :documentation "A CONFIGURATION object which would dictate much of +the behaviour of the library towards the connection object.") (dangling-users :initarg :dangling-users :accessor dangling-users @@ -72,15 +77,19 @@ (channels nil) (dangling-users nil) (hooks nil) - (channel-list nil)) - (let ((connection (make-instance 'connection - :user user - :server-name server-name - :server-stream server-stream - :client-stream client-stream - :channels channels - :dangling-users dangling-users - :channel-list channel-list))) + (channel-list nil) + (configuration nil)) + (let* ((configuration (or configuration + (make-configuration))) + (connection (make-instance 'connection + :user user + :server-name server-name + :server-stream server-stream + :client-stream client-stream + :channels channels + :dangling-users dangling-users + :channel-list channel-list + :configuration configuration))) (dolist (hook hooks) (add-hook connection (car hook) (cadr hook))) connection)) @@ -156,6 +165,33 @@ (setf (gethash class (hooks connection)) nil)) ;; +;; Configuration +;; + +(defclass configuration () + ((automatically-accept-dcc-connections + :initarg :automatically-accept-dcc-connections + :accessor automatically-accept-dcc-connections + :initform t) + (automatically-accept-dcc-downloads + :initarg :automatically-accept-dcc-downloads + :accessor automatically-accept-dcc-downloads + :initform t) + (dcc-download-directory + :initarg :dcc-download-directory + :accessor dcc-download-directory + :initform (user-homedir-pathname)))) + +(defun make-configuration (&key + (automatically-accept-dcc-connections t) + (automatically-accept-dcc-downloads t) + (dcc-download-directory (user-homedir-pathname))) + (make-instance 'configuration + :automatically-accept-dcc-connections automatically-accept-dcc-connections + :automatically-accept-dcc-downloads automatically-accept-dcc-downloads + :dcc-download-directory dcc-download-directory)) + +;; ;; DCC Connection ;; @@ -201,9 +237,10 @@ :output-stream t))) (defmethod read-message ((connection dcc-connection)) - (format (output-stream connection) "~A~%" (read-line (stream connection))) - (force-output (output-stream connection)) - t) + (let ((message (read-line (stream connection)))) + (format (output-stream connection) "~A~%" message) + (force-output (output-stream connection)) + message)) (defmethod read-message-loop ((connection dcc-connection)) (loop while (read-message connection))) @@ -412,12 +449,14 @@ (defclass irc-error-reply (irc-message) ()) -(defmacro define-irc-message (command) - (let ((name (intern (format nil "IRC-~A-MESSAGE" command)))) - `(progn - (defmethod find-irc-message-class ((type (eql ,command))) - (find-class ',name)) - (defclass ,name (irc-message) ())))) +(let ((*print-case* :upcase)) + (defmacro define-irc-message (command) + (let ((name (intern (format nil "IRC-~A-MESSAGE" command)))) + `(progn + (defmethod find-irc-message-class ((type (eql ,command))) + (find-class ',name)) + (export ',name) + (defclass ,name (irc-message) ()))))) (defun create-irc-message-classes (class-list) (dolist (class class-list) @@ -458,12 +497,14 @@ (defclass standard-ctcp-message (ctcp-mixin message) ()) -(defmacro define-ctcp-message (ctcp-command) - (let ((name (intern (format nil "CTCP-~A-MESSAGE" ctcp-command)))) - `(progn - (defmethod find-ctcp-message-class ((type (eql ,ctcp-command))) - (find-class ',name)) - (defclass ,name (ctcp-mixin irc-message) ())))) +(let ((*print-case* :upcase)) + (defmacro define-ctcp-message (ctcp-command) + (let ((name (intern (format nil "CTCP-~A-MESSAGE" ctcp-command)))) + `(progn + (defmethod find-ctcp-message-class ((type (eql ,ctcp-command))) + (find-class ',name)) + (export ',name) + (defclass ,name (ctcp-mixin irc-message) ()))))) (defun create-ctcp-message-classes (class-list) (dolist (class class-list) @@ -471,7 +512,8 @@ ;; should perhaps wrap this in an eval-when? (create-ctcp-message-classes '(:action :source :finger :ping - :version :userinfo :time :dcc-chat-request)) + :version :userinfo :time :dcc-chat-request + :dcc-send-request)) (defmethod find-ctcp-message-class (type) (find-class 'standard-ctcp-message)) From eenge at common-lisp.net Tue Nov 11 13:33:36 2003 From: eenge at common-lisp.net (Erik Enge) Date: Tue, 11 Nov 2003 08:33:36 -0500 Subject: [net-nittin-irc-cvs] CVS update: public_html/style.css public_html/valid-xhtml11.png public_html/vcss.png public_html/index.html Message-ID: Update of /project/net-nittin-irc/cvsroot/public_html In directory common-lisp.net:/tmp/cvs-serv11633 Modified Files: index.html Added Files: style.css valid-xhtml11.png vcss.png Log Message: new website (thanks to Nikodemus' Osicat) Date: Tue Nov 11 08:33:36 2003 Author: eenge Index: public_html/index.html diff -u public_html/index.html:1.2 public_html/index.html:1.3 --- public_html/index.html:1.2 Wed Nov 5 09:00:44 2003 +++ public_html/index.html Tue Nov 11 08:33:36 2003 @@ -1,39 +1,115 @@ - - - - net-nittin-irc - + + + net-nittin-irc + -

net-nittin-irc, a Common Lisp IRC library

+
+

net-nittin-irc 0.3.0

+
+
+ +

net-nittin-irc is a Common Lisp IRC client library that + features DCC, CTCP and all relevant commands from the IRC RFCs + (RFC2810, RFC2811 and RFC2812). It + uses ASDF and has been tested mostly on SBCL but should work for + other implementations with little or no extra code.

+ +

The code is released under an MIT-style + license. I need to mention that Jochen Schmidt laid the + groundwork for this library with his Weird-IRC IRC + client and that therefore some of the code is copyright him.

+ +

Features

+
+
    +
  • implements all commands in the RFCs
    • +
  • extra convenience commands such as op/deop, ban, ignore, etc.
    • +
  • DCC SEND/CHAT support
    • +
  • event driven model with hooks makes interfacing easy
    • +
  • the user can keep multiple connections
    • +
  • all CTCP commands
    • +
+
+ +

Installation

+
+

If you have + asdf-install, just: +

+ 
$ asdf-install net-nittin-irc
+ +

net-nittin-irc can manually be downloaded from here: + + net-nittin-irc_latest.tar.gz + .

+ +

There is also anonymous CVS + and + ViewCVS + . +

+
+ +

Contact

+
+

Questions, feature requests, and bug-reports are welcome on + + net-nittin-net-devel at common-lisp.net.

+
+ +

Sample usage

+
+ 
+  * (require :net-nittin-irc)
+
+  * (in-package :irc)
+
+  * (setf connection (connect :nickname "mynick"
+                              :server "irc.somewhere.org"))
+
+  * (read-message-loop connection)
+
+;; That's it.  Interrupt the read-message-loop and do:
+
+  * (join connection "#lisp")
+
+;; etc. (look at command.lisp) to operate the library.  After issuing
+;; a command, you need to get back on the feed:
+
+  * (read-message-loop connection)
+
+;; If you need to do something on every join, do:
+
+  * (defun my-hook (message)
+     <do-something>)
+
+  * (add-hook connection 'irc-join-message #'my-hook)
+
+;; and it will be run next time the library receives an
+;; irc-join-message.  For a full list of messages you can hook into,
+;; look at event.lisp.
+
+;; Your connection object will get updated by the library with regards
+;; to users joining/parting channels, you joining/parting channels,
+;; etc.  Look at protocol.lisp's connection object for slots and
+;; methods.
+
+
+ +
+ +
+ + Valid XHTML 1.1! + + + Valid CSS! +
-

net-nittin-irc is a Common Lisp IRC client library that - features DCC, CTCP and all relevant commands from the IRC RFCs (RFC2810, RFC2811 and RFC2812). It - uses ASDF and has been tested mostly on SBCL but should work for - other implementations with little or no extra code.

- -

For more information and some examples on how to use it, check out - the README - file. If you want to handle the code, use ViewCVS - or check out the code and hack away. - Contributions gratefully accepted.

- -

The code is released under an MIT-style license. I need to - mention that Jochen Schmidt laid the groundwork for this library - with his Weird-IRC IRC - client and that therefore much of the code is copyright him.

- -
-
Erik Enge
- - -Last modified: Wed Nov 5 08:58:01 EST 2003 - - - +
+ \ No newline at end of file From eenge at common-lisp.net Tue Nov 11 13:35:16 2003 From: eenge at common-lisp.net (Erik Enge) Date: Tue, 11 Nov 2003 08:35:16 -0500 Subject: [net-nittin-irc-cvs] CVS update: public_html/index.html Message-ID: Update of /project/net-nittin-irc/cvsroot/public_html In directory common-lisp.net:/tmp/cvs-serv13276 Modified Files: index.html Log Message: using my own license Date: Tue Nov 11 08:35:15 2003 Author: eenge Index: public_html/index.html diff -u public_html/index.html:1.3 public_html/index.html:1.4 --- public_html/index.html:1.3 Tue Nov 11 08:33:36 2003 +++ public_html/index.html Tue Nov 11 08:35:15 2003 @@ -18,7 +18,7 @@ other implementations with little or no extra code.

The code is released under an MIT-style + href="http://common-lisp.net/cgi-bin/viewcvs.cgi/net-nittin-irc/LICENSE?rev=HEAD&cvsroot=net-nittin-irc&content-type=text/vnd.viewcvs-markup">MIT-style license. I need to mention that Jochen Schmidt laid the groundwork for this library with his Weird-IRC IRC From eenge at common-lisp.net Tue Nov 11 13:35:41 2003 From: eenge at common-lisp.net (Erik Enge) Date: Tue, 11 Nov 2003 08:35:41 -0500 Subject: [net-nittin-irc-cvs] CVS update: net-nittin-irc/LICENSE Message-ID: Update of /project/net-nittin-irc/cvsroot/net-nittin-irc In directory common-lisp.net:/tmp/cvs-serv13372 Modified Files: LICENSE Log Message: adding me as copyright holder Date: Tue Nov 11 08:35:41 2003 Author: eenge Index: net-nittin-irc/LICENSE diff -u net-nittin-irc/LICENSE:1.1.1.1 net-nittin-irc/LICENSE:1.2 --- net-nittin-irc/LICENSE:1.1.1.1 Mon Nov 3 12:00:54 2003 +++ net-nittin-irc/LICENSE Tue Nov 11 08:35:41 2003 @@ -1,4 +1,5 @@ Copyright (c) 2002 Jochen Schmidt +Copyright (c) 2003 Erik Enge Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions From eenge at common-lisp.net Tue Nov 11 14:01:51 2003 From: eenge at common-lisp.net (Erik Enge) Date: Tue, 11 Nov 2003 09:01:51 -0500 Subject: [net-nittin-irc-cvs] CVS update: public_html/index.html Message-ID: Update of /project/net-nittin-irc/cvsroot/public_html In directory common-lisp.net:/tmp/cvs-serv24548 Modified Files: index.html Log Message: removing validating links Date: Tue Nov 11 09:01:50 2003 Author: eenge Index: public_html/index.html diff -u public_html/index.html:1.4 public_html/index.html:1.5 --- public_html/index.html:1.4 Tue Nov 11 08:35:15 2003 +++ public_html/index.html Tue Nov 11 09:01:50 2003 @@ -101,15 +101,6 @@ -

- -
- - Valid XHTML 1.1! - - - Valid CSS! -
From eenge at common-lisp.net Wed Nov 12 14:51:08 2003 From: eenge at common-lisp.net (Erik Enge) Date: Wed, 12 Nov 2003 09:51:08 -0500 Subject: [net-nittin-irc-cvs] CVS update: public_html/index.html Message-ID: Update of /project/net-nittin-irc/cvsroot/public_html In directory common-lisp.net:/tmp/cvs-serv12404 Modified Files: index.html Log Message: oops, only partial DCC support Date: Wed Nov 12 09:51:08 2003 Author: eenge Index: public_html/index.html diff -u public_html/index.html:1.5 public_html/index.html:1.6 --- public_html/index.html:1.5 Tue Nov 11 09:01:50 2003 +++ public_html/index.html Wed Nov 12 09:51:07 2003 @@ -10,8 +10,9 @@

net-nittin-irc is a Common Lisp IRC client library that - features DCC, CTCP and all relevant commands from the IRC RFCs - (RFC2810, RFC2810, RFC2811 and RFC2812). It uses ASDF and has been tested mostly on SBCL but should work for @@ -29,7 +30,7 @@

  • implements all commands in the RFCs
  • extra convenience commands such as op/deop, ban, ignore, etc.
    • -
  • DCC SEND/CHAT support
    • +
  • partial DCC SEND/CHAT support
  • event driven model with hooks makes interfacing easy
  • the user can keep multiple connections
  • all CTCP commands
    • From eenge at common-lisp.net Wed Nov 12 19:32:00 2003 From: eenge at common-lisp.net (Erik Enge) Date: Wed, 12 Nov 2003 14:32:00 -0500 Subject: [net-nittin-irc-cvs] CVS update: public_html/index.html Message-ID: Update of /project/net-nittin-irc/cvsroot/public_html In directory common-lisp.net:/tmp/cvs-serv5918 Modified Files: index.html Log Message: fixing link for mailinglist Date: Wed Nov 12 14:32:00 2003 Author: eenge Index: public_html/index.html diff -u public_html/index.html:1.6 public_html/index.html:1.7 --- public_html/index.html:1.6 Wed Nov 12 09:51:07 2003 +++ public_html/index.html Wed Nov 12 14:31:59 2003 @@ -59,8 +59,8 @@

    Contact

    Questions, feature requests, and bug-reports are welcome on - - net-nittin-net-devel at common-lisp.net.

    + + net-nittin-irc-devel at common-lisp.net.

    Sample usage

    From eenge at common-lisp.net Fri Nov 14 16:13:22 2003 From: eenge at common-lisp.net (Erik Enge) Date: Fri, 14 Nov 2003 11:13:22 -0500 Subject: [net-nittin-irc-cvs] CVS update: net-nittin-irc/TODO net-nittin-irc/event.lisp net-nittin-irc/package.lisp net-nittin-irc/protocol.lisp net-nittin-irc/variable.lisp Message-ID: Update of /project/net-nittin-irc/cvsroot/net-nittin-irc In directory common-lisp.net:/tmp/cvs-serv27042 Modified Files: TODO event.lisp package.lisp protocol.lisp variable.lisp Log Message: adding support for return code 320 from dancerd fixing a bug related to nickname changes that would leave the connection object in an inconsistent state Date: Fri Nov 14 11:13:22 2003 Author: eenge Index: net-nittin-irc/TODO diff -u net-nittin-irc/TODO:1.6 net-nittin-irc/TODO:1.7 --- net-nittin-irc/TODO:1.6 Mon Nov 10 12:25:38 2003 +++ net-nittin-irc/TODO Fri Nov 14 11:13:21 2003 @@ -11,3 +11,13 @@ equivalence of two nicknames or channel names. So when we do FIND-USER etc. we need to be mindful of this fact. + + - Need to optimize the user approach. When joining ten high-volume + (2000+ users total) channels there seems to be O(n) or somesuch + performance because of, I'm guessing, the way FIND-USER works. + + - If a message (as in PRIVMSG) is longer than 512 characters + (including carriage return and linefeed) we should probably split + the message into several on behalf of the user. + + - Add ignore Index: net-nittin-irc/event.lisp diff -u net-nittin-irc/event.lisp:1.6 net-nittin-irc/event.lisp:1.7 --- net-nittin-irc/event.lisp:1.6 Mon Nov 10 12:25:38 2003 +++ net-nittin-irc/event.lisp Fri Nov 14 11:13:21 2003 @@ -1,4 +1,4 @@ -;;;; $Id: event.lisp,v 1.6 2003/11/10 17:25:38 eenge Exp $ +;;;; $Id: event.lisp,v 1.7 2003/11/14 16:13:21 eenge Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/event.lisp,v $ ;;;; See LICENSE for licensing information. @@ -868,15 +868,15 @@ (defmethod irc-message-event ((message irc-nick-message)) (apply-to-hooks message) (client-log (connection message) message) - (when (self-message-p message) - (setf (nickname (user (connection message))) - (trailing-argument message))) - (let ((user (find-user (connection message) (source message)))) - (if user - (setf (nickname user) (trailing-argument message)) - (client-raw-log (connection message) - (format nil "Could not find user with nick ~A~%" - (source message)))))) + (if (self-message-p message) + (change-nickname (connection message) (user (connection message)) + (trailing-argument message)) + (let ((user (find-user (connection message) (source message)))) + (if user + (change-nickname (connection message) user (trailing-argument message)) + (client-raw-log (connection message) + (format nil "Could not find user with nick ~A~%" + (source message))))))) (defmethod irc-message-event ((message irc-notice-message)) (apply-to-hooks message) Index: net-nittin-irc/package.lisp diff -u net-nittin-irc/package.lisp:1.4 net-nittin-irc/package.lisp:1.5 --- net-nittin-irc/package.lisp:1.4 Mon Nov 10 12:25:38 2003 +++ net-nittin-irc/package.lisp Fri Nov 14 11:13:21 2003 @@ -1,4 +1,4 @@ -;;;; $Id: package.lisp,v 1.4 2003/11/10 17:25:38 eenge Exp $ +;;;; $Id: package.lisp,v 1.5 2003/11/14 16:13:21 eenge Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/package.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -26,6 +26,7 @@ :remove-hooks :get-hooks :make-user + :change-nickname :make-connection :make-channel :client-log Index: net-nittin-irc/protocol.lisp diff -u net-nittin-irc/protocol.lisp:1.7 net-nittin-irc/protocol.lisp:1.8 --- net-nittin-irc/protocol.lisp:1.7 Mon Nov 10 12:25:38 2003 +++ net-nittin-irc/protocol.lisp Fri Nov 14 11:13:21 2003 @@ -1,4 +1,4 @@ -;;;; $Id: protocol.lisp,v 1.7 2003/11/10 17:25:38 eenge Exp $ +;;;; $Id: protocol.lisp,v 1.8 2003/11/14 16:13:21 eenge Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/protocol.lisp,v $ ;;;; See LICENSE for licensing information. @@ -323,7 +323,7 @@ (setf (channels connection) (remove channel (channels connection)))) (defmethod remove-users ((channel channel)) - (setf (users channel) (make-hash-table :test #'equal))) + (clrhash (users channel))) ;; ;; User @@ -388,7 +388,7 @@ (remhash (nickname user) (users channel))) (defmethod remove-user-everywhere ((connection connection) (user user)) - (dolist (channel (all-channels connection)) + (dolist (channel (channels connection)) (remove-user channel user))) (defmethod find-or-make-user ((connection connection) nickname &key (username "") @@ -398,6 +398,16 @@ :username username :hostname hostname :realname realname))) + +(defmethod change-nickname ((connection connection) (user user) new-nickname) + (dolist (channel (channels connection)) + (let ((old-user (gethash (nickname user) (users channel)))) + (when old-user + (remhash (nickname user) (users channel)) + (setf (nickname user) new-nickname) + (add-user channel user)))) + (when (equal user (user connection)) + (setf (nickname user) new-nickname))) ;; IRC Message ;; Index: net-nittin-irc/variable.lisp diff -u net-nittin-irc/variable.lisp:1.4 net-nittin-irc/variable.lisp:1.5 --- net-nittin-irc/variable.lisp:1.4 Fri Nov 7 10:40:19 2003 +++ net-nittin-irc/variable.lisp Fri Nov 14 11:13:21 2003 @@ -1,4 +1,4 @@ -;;;; $Id: variable.lisp,v 1.4 2003/11/07 15:40:19 eenge Exp $ +;;;; $Id: variable.lisp,v 1.5 2003/11/14 16:13:21 eenge Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/variable.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -110,6 +110,7 @@ (317 :rpl_whoisidle) (318 :rpl_endofwhois) (319 :rpl_whoischannels) + (320 :rpl_whoisidentified) ; Seen in dancer ircd source (321 :rpl_liststart) (322 :rpl_list) (323 :rpl_listend) From bmastenbrook at common-lisp.net Fri Nov 14 19:28:01 2003 From: bmastenbrook at common-lisp.net (Brian Mastenbrook) Date: Fri, 14 Nov 2003 14:28:01 -0500 Subject: [net-nittin-irc-cvs] CVS update: net-nittin-irc/command.lisp net-nittin-irc/package.lisp net-nittin-irc/protocol.lisp Message-ID: Update of /project/net-nittin-irc/cvsroot/net-nittin-irc In directory common-lisp.net:/tmp/cvs-serv15254 Modified Files: command.lisp package.lisp protocol.lisp Log Message: Add asynchronous message handling on SBCL Date: Fri Nov 14 14:28:01 2003 Author: bmastenbrook Index: net-nittin-irc/command.lisp diff -u net-nittin-irc/command.lisp:1.3 net-nittin-irc/command.lisp:1.4 --- net-nittin-irc/command.lisp:1.3 Fri Nov 7 10:40:19 2003 +++ net-nittin-irc/command.lisp Fri Nov 14 14:28:00 2003 @@ -1,4 +1,4 @@ -;;;; $Id: command.lisp,v 1.3 2003/11/07 15:40:19 eenge Exp $ +;;;; $Id: command.lisp,v 1.4 2003/11/14 19:28:00 bmastenbrook Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/command.lisp,v $ ;;;; See LICENSE for licensing information. @@ -170,11 +170,15 @@ :protocol :tcp))) (sb-bsd-sockets:socket-connect s (car (sb-bsd-sockets:host-ent-addresses (sb-bsd-sockets:get-host-by-name host))) port) - (sb-bsd-sockets:socket-make-stream s - :element-type 'character - :input t - :output t - :buffering :none))) + s)) + +#+sbcl +(defun socket-stream (socket) + (sb-bsd-sockets:socket-make-stream socket + :element-type 'character + :input t + :output t + :buffering :none)) (defun connect (&key (nickname *default-nickname*) (username nil) @@ -183,17 +187,20 @@ (server *default-irc-server*) (port *default-irc-server-port*)) "Connect to server and return a connection object." - (let* ((stream #+lispworks (comm:open-tcp-stream server port :errorp t) + (let* ((socket #+sbcl (connect-to-server-socket server port) + #-sbcl nil) + (stream #+lispworks (comm:open-tcp-stream server port :errorp t) #+cmu (sys:make-fd-stream (ext:connect-to-inet-socket server port) :input t :output t :element-type 'character) #+allegro (socket:make-socket :remote-host server :remote-port port) - #+sbcl (connect-to-server-socket server port)) + #+sbcl (socket-stream socket)) (user (make-user :nickname nickname :username username :realname realname)) - (connection (make-connection :server-stream stream + (connection (make-connection :server-socket socket + :server-stream stream :user user :server-name server))) (nick connection nickname) Index: net-nittin-irc/package.lisp diff -u net-nittin-irc/package.lisp:1.5 net-nittin-irc/package.lisp:1.6 --- net-nittin-irc/package.lisp:1.5 Fri Nov 14 11:13:21 2003 +++ net-nittin-irc/package.lisp Fri Nov 14 14:28:00 2003 @@ -1,4 +1,4 @@ -;;;; $Id: package.lisp,v 1.5 2003/11/14 16:13:21 eenge Exp $ +;;;; $Id: package.lisp,v 1.6 2003/11/14 19:28:00 bmastenbrook Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/package.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -11,6 +11,7 @@ (:nicknames :irc) (:export :read-message-loop :read-message + :add-asynchronous-message-handler :send-message :server-name :server-stream Index: net-nittin-irc/protocol.lisp diff -u net-nittin-irc/protocol.lisp:1.8 net-nittin-irc/protocol.lisp:1.9 --- net-nittin-irc/protocol.lisp:1.8 Fri Nov 14 11:13:21 2003 +++ net-nittin-irc/protocol.lisp Fri Nov 14 14:28:00 2003 @@ -1,4 +1,4 @@ -;;;; $Id: protocol.lisp,v 1.8 2003/11/14 16:13:21 eenge Exp $ +;;;; $Id: protocol.lisp,v 1.9 2003/11/14 19:28:00 bmastenbrook Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/protocol.lisp,v $ ;;;; See LICENSE for licensing information. @@ -28,6 +28,10 @@ :initarg :server-name :accessor server-name :initform "Unknown server") + (server-socket + :initarg :server-socket + :accessor server-socket + :documentation "Socket used to talk to the IRC server.") (server-stream :initarg :server-stream :accessor server-stream @@ -72,6 +76,7 @@ (defun make-connection (&key (user nil) (server-name "") + (server-socket nil) (server-stream nil) (client-stream t) (channels nil) @@ -84,6 +89,7 @@ (connection (make-instance 'connection :user user :server-name server-name + :server-socket server-socket :server-stream server-stream :client-stream client-stream :channels channels @@ -103,6 +109,16 @@ (let ((stream (server-stream connection))) (and (streamp stream) (open-stream-p stream)))) + +(defmethod add-asynchronous-message-handler ((connection connection)) + #+sbcl + (sb-sys:add-fd-handler (sb-bsd-sockets:socket-file-descriptor + (server-socket connection)) + (lambda (fd) + (declare (ignore fd)) + (read-messsage connection))) + #-sbcl + (error "add-asynchronous-message-handler is not supported now on non-SBCL")) (defmethod read-message ((connection connection)) (let ((read-more-p t)) From bmastenbrook at common-lisp.net Fri Nov 14 19:29:50 2003 From: bmastenbrook at common-lisp.net (Brian Mastenbrook) Date: Fri, 14 Nov 2003 14:29:50 -0500 Subject: [net-nittin-irc-cvs] CVS update: Directory change: net-nittin-irc/example Message-ID: Update of /project/net-nittin-irc/cvsroot/net-nittin-irc/example In directory common-lisp.net:/tmp/cvs-serv16506/example Log Message: Directory /project/net-nittin-irc/cvsroot/net-nittin-irc/example added to the repository Date: Fri Nov 14 14:29:50 2003 Author: bmastenbrook New directory net-nittin-irc/example added From bmastenbrook at common-lisp.net Fri Nov 14 19:37:05 2003 From: bmastenbrook at common-lisp.net (Brian Mastenbrook) Date: Fri, 14 Nov 2003 14:37:05 -0500 Subject: [net-nittin-irc-cvs] CVS update: net-nittin-irc/example/Mop_Sym.txt net-nittin-irc/example/clhs.lisp Message-ID: Update of /project/net-nittin-irc/cvsroot/net-nittin-irc/example In directory common-lisp.net:/tmp/cvs-serv19401 Added Files: Mop_Sym.txt clhs.lisp Log Message: Added a sample IRC bot named clhs. Date: Fri Nov 14 14:37:05 2003 Author: bmastenbrook From bmastenbrook at common-lisp.net Fri Nov 14 20:12:16 2003 From: bmastenbrook at common-lisp.net (Brian Mastenbrook) Date: Fri, 14 Nov 2003 15:12:16 -0500 Subject: [net-nittin-irc-cvs] CVS update: net-nittin-irc/protocol.lisp Message-ID: Update of /project/net-nittin-irc/cvsroot/net-nittin-irc In directory common-lisp.net:/tmp/cvs-serv2599 Modified Files: protocol.lisp Log Message: Move *print-case* let to right place Date: Fri Nov 14 15:12:13 2003 Author: bmastenbrook Index: net-nittin-irc/protocol.lisp diff -u net-nittin-irc/protocol.lisp:1.9 net-nittin-irc/protocol.lisp:1.10 --- net-nittin-irc/protocol.lisp:1.9 Fri Nov 14 14:28:00 2003 +++ net-nittin-irc/protocol.lisp Fri Nov 14 15:12:12 2003 @@ -1,4 +1,4 @@ -;;;; $Id: protocol.lisp,v 1.9 2003/11/14 19:28:00 bmastenbrook Exp $ +;;;; $Id: protocol.lisp,v 1.10 2003/11/14 20:12:12 bmastenbrook Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/protocol.lisp,v $ ;;;; See LICENSE for licensing information. @@ -475,14 +475,14 @@ (defclass irc-error-reply (irc-message) ()) -(let ((*print-case* :upcase)) - (defmacro define-irc-message (command) +(defmacro define-irc-message (command) + (let ((*print-case* :upcase)) (let ((name (intern (format nil "IRC-~A-MESSAGE" 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) ()))))) (defun create-irc-message-classes (class-list) (dolist (class class-list) @@ -523,14 +523,14 @@ (defclass standard-ctcp-message (ctcp-mixin message) ()) -(let ((*print-case* :upcase)) - (defmacro define-ctcp-message (ctcp-command) +(defmacro define-ctcp-message (ctcp-command) + (let ((*print-case* :upcase)) (let ((name (intern (format nil "CTCP-~A-MESSAGE" 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) ()))))) (defun create-ctcp-message-classes (class-list) (dolist (class class-list) From bmastenbrook at common-lisp.net Fri Nov 14 20:23:53 2003 From: bmastenbrook at common-lisp.net (Brian Mastenbrook) Date: Fri, 14 Nov 2003 15:23:53 -0500 Subject: [net-nittin-irc-cvs] CVS update: net-nittin-irc/command.lisp net-nittin-irc/package.lisp Message-ID: Update of /project/net-nittin-irc/cvsroot/net-nittin-irc In directory common-lisp.net:/tmp/cvs-serv6743 Modified Files: command.lisp package.lisp Log Message: Added logging-stream to connect; exported irc-message class and slots. Date: Fri Nov 14 15:23:53 2003 Author: bmastenbrook Index: net-nittin-irc/command.lisp diff -u net-nittin-irc/command.lisp:1.4 net-nittin-irc/command.lisp:1.5 --- net-nittin-irc/command.lisp:1.4 Fri Nov 14 14:28:00 2003 +++ net-nittin-irc/command.lisp Fri Nov 14 15:23:53 2003 @@ -1,4 +1,4 @@ -;;;; $Id: command.lisp,v 1.4 2003/11/14 19:28:00 bmastenbrook Exp $ +;;;; $Id: command.lisp,v 1.5 2003/11/14 20:23:53 bmastenbrook Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/command.lisp,v $ ;;;; See LICENSE for licensing information. @@ -185,7 +185,8 @@ (realname nil) (mode 0) (server *default-irc-server*) - (port *default-irc-server-port*)) + (port *default-irc-server-port*) + (logging-stream t)) "Connect to server and return a connection object." (let* ((socket #+sbcl (connect-to-server-socket server port) #-sbcl nil) @@ -201,6 +202,7 @@ :realname realname)) (connection (make-connection :server-socket socket :server-stream stream + :client-stream logging-stream :user user :server-name server))) (nick connection nickname) Index: net-nittin-irc/package.lisp diff -u net-nittin-irc/package.lisp:1.6 net-nittin-irc/package.lisp:1.7 --- net-nittin-irc/package.lisp:1.6 Fri Nov 14 14:28:00 2003 +++ net-nittin-irc/package.lisp Fri Nov 14 15:23:53 2003 @@ -1,4 +1,4 @@ -;;;; $Id: package.lisp,v 1.6 2003/11/14 19:28:00 bmastenbrook Exp $ +;;;; $Id: package.lisp,v 1.7 2003/11/14 20:23:53 bmastenbrook Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/package.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -28,6 +28,16 @@ :get-hooks :make-user :change-nickname + :irc-message + :source + :user + :host + :command + :arguments + :trailing-argument + :connection + :received-time + :raw-message-string :make-connection :make-channel :client-log From bmastenbrook at common-lisp.net Fri Nov 14 20:24:40 2003 From: bmastenbrook at common-lisp.net (Brian Mastenbrook) Date: Fri, 14 Nov 2003 15:24:40 -0500 Subject: [net-nittin-irc-cvs] CVS update: net-nittin-irc/protocol.lisp Message-ID: Update of /project/net-nittin-irc/cvsroot/net-nittin-irc In directory common-lisp.net:/tmp/cvs-serv8324 Modified Files: protocol.lisp Log Message: Fix a bug. Date: Fri Nov 14 15:24:40 2003 Author: bmastenbrook Index: net-nittin-irc/protocol.lisp diff -u net-nittin-irc/protocol.lisp:1.10 net-nittin-irc/protocol.lisp:1.11 --- net-nittin-irc/protocol.lisp:1.10 Fri Nov 14 15:12:12 2003 +++ net-nittin-irc/protocol.lisp Fri Nov 14 15:24:39 2003 @@ -1,4 +1,4 @@ -;;;; $Id: protocol.lisp,v 1.10 2003/11/14 20:12:12 bmastenbrook Exp $ +;;;; $Id: protocol.lisp,v 1.11 2003/11/14 20:24:39 bmastenbrook Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/protocol.lisp,v $ ;;;; See LICENSE for licensing information. @@ -114,9 +114,9 @@ #+sbcl (sb-sys:add-fd-handler (sb-bsd-sockets:socket-file-descriptor (server-socket connection)) - (lambda (fd) - (declare (ignore fd)) - (read-messsage connection))) + :input (lambda (fd) + (declare (ignore fd)) + (read-messsage connection))) #-sbcl (error "add-asynchronous-message-handler is not supported now on non-SBCL")) From bmastenbrook at common-lisp.net Fri Nov 14 20:35:03 2003 From: bmastenbrook at common-lisp.net (Brian Mastenbrook) Date: Fri, 14 Nov 2003 15:35:03 -0500 Subject: [net-nittin-irc-cvs] CVS update: net-nittin-irc/command.lisp net-nittin-irc/package.lisp net-nittin-irc/protocol.lisp Message-ID: Update of /project/net-nittin-irc/cvsroot/net-nittin-irc In directory common-lisp.net:/tmp/cvs-serv12718 Modified Files: command.lisp package.lisp protocol.lisp Log Message: Untabify files, per kire. Date: Fri Nov 14 15:35:01 2003 Author: bmastenbrook Index: net-nittin-irc/command.lisp diff -u net-nittin-irc/command.lisp:1.5 net-nittin-irc/command.lisp:1.6 --- net-nittin-irc/command.lisp:1.5 Fri Nov 14 15:23:53 2003 +++ net-nittin-irc/command.lisp Fri Nov 14 15:35:01 2003 @@ -1,4 +1,4 @@ -;;;; $Id: command.lisp,v 1.5 2003/11/14 20:23:53 bmastenbrook Exp $ +;;;; $Id: command.lisp,v 1.6 2003/11/14 20:35:01 bmastenbrook Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/command.lisp,v $ ;;;; See LICENSE for licensing information. @@ -175,10 +175,10 @@ #+sbcl (defun socket-stream (socket) (sb-bsd-sockets:socket-make-stream socket - :element-type 'character - :input t - :output t - :buffering :none)) + :element-type 'character + :input t + :output t + :buffering :none)) (defun connect (&key (nickname *default-nickname*) (username nil) @@ -186,11 +186,11 @@ (mode 0) (server *default-irc-server*) (port *default-irc-server-port*) - (logging-stream t)) + (logging-stream t)) "Connect to server and return a connection object." (let* ((socket #+sbcl (connect-to-server-socket server port) - #-sbcl nil) - (stream #+lispworks (comm:open-tcp-stream server port :errorp t) + #-sbcl nil) + (stream #+lispworks (comm:open-tcp-stream server port :errorp t) #+cmu (sys:make-fd-stream (ext:connect-to-inet-socket server port) :input t :output t @@ -201,8 +201,8 @@ :username username :realname realname)) (connection (make-connection :server-socket socket - :server-stream stream - :client-stream logging-stream + :server-stream stream + :client-stream logging-stream :user user :server-name server))) (nick connection nickname) Index: net-nittin-irc/package.lisp diff -u net-nittin-irc/package.lisp:1.7 net-nittin-irc/package.lisp:1.8 --- net-nittin-irc/package.lisp:1.7 Fri Nov 14 15:23:53 2003 +++ net-nittin-irc/package.lisp Fri Nov 14 15:35:01 2003 @@ -1,4 +1,4 @@ -;;;; $Id: package.lisp,v 1.7 2003/11/14 20:23:53 bmastenbrook Exp $ +;;;; $Id: package.lisp,v 1.8 2003/11/14 20:35:01 bmastenbrook Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/package.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -11,7 +11,7 @@ (:nicknames :irc) (:export :read-message-loop :read-message - :add-asynchronous-message-handler + :add-asynchronous-message-handler :send-message :server-name :server-stream @@ -28,16 +28,16 @@ :get-hooks :make-user :change-nickname - :irc-message - :source - :user - :host - :command - :arguments - :trailing-argument - :connection - :received-time - :raw-message-string + :irc-message + :source + :user + :host + :command + :arguments + :trailing-argument + :connection + :received-time + :raw-message-string :make-connection :make-channel :client-log Index: net-nittin-irc/protocol.lisp diff -u net-nittin-irc/protocol.lisp:1.11 net-nittin-irc/protocol.lisp:1.12 --- net-nittin-irc/protocol.lisp:1.11 Fri Nov 14 15:24:39 2003 +++ net-nittin-irc/protocol.lisp Fri Nov 14 15:35:01 2003 @@ -1,4 +1,4 @@ -;;;; $Id: protocol.lisp,v 1.11 2003/11/14 20:24:39 bmastenbrook Exp $ +;;;; $Id: protocol.lisp,v 1.12 2003/11/14 20:35:01 bmastenbrook Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/protocol.lisp,v $ ;;;; See LICENSE for licensing information. @@ -76,7 +76,7 @@ (defun make-connection (&key (user nil) (server-name "") - (server-socket nil) + (server-socket nil) (server-stream nil) (client-stream t) (channels nil) @@ -89,7 +89,7 @@ (connection (make-instance 'connection :user user :server-name server-name - :server-socket server-socket + :server-socket server-socket :server-stream server-stream :client-stream client-stream :channels channels @@ -113,10 +113,10 @@ (defmethod add-asynchronous-message-handler ((connection connection)) #+sbcl (sb-sys:add-fd-handler (sb-bsd-sockets:socket-file-descriptor - (server-socket connection)) - :input (lambda (fd) - (declare (ignore fd)) - (read-messsage connection))) + (server-socket connection)) + :input (lambda (fd) + (declare (ignore fd)) + (read-message connection))) #-sbcl (error "add-asynchronous-message-handler is not supported now on non-SBCL")) @@ -479,10 +479,10 @@ (let ((*print-case* :upcase)) (let ((name (intern (format nil "IRC-~A-MESSAGE" 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) ()))))) (defun create-irc-message-classes (class-list) (dolist (class class-list) @@ -527,10 +527,10 @@ (let ((*print-case* :upcase)) (let ((name (intern (format nil "CTCP-~A-MESSAGE" 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) ()))))) (defun create-ctcp-message-classes (class-list) (dolist (class class-list) From bmastenbrook at common-lisp.net Fri Nov 14 20:35:22 2003 From: bmastenbrook at common-lisp.net (Brian Mastenbrook) Date: Fri, 14 Nov 2003 15:35:22 -0500 Subject: [net-nittin-irc-cvs] CVS update: net-nittin-irc/example/clhs.lisp Message-ID: Update of /project/net-nittin-irc/cvsroot/net-nittin-irc/example In directory common-lisp.net:/tmp/cvs-serv13083 Modified Files: clhs.lisp Log Message: Untabify, per kire. Date: Fri Nov 14 15:35:22 2003 Author: bmastenbrook Index: net-nittin-irc/example/clhs.lisp diff -u net-nittin-irc/example/clhs.lisp:1.1 net-nittin-irc/example/clhs.lisp:1.2 --- net-nittin-irc/example/clhs.lisp:1.1 Fri Nov 14 14:37:05 2003 +++ net-nittin-irc/example/clhs.lisp Fri Nov 14 15:35:22 2003 @@ -1,4 +1,4 @@ -;;;; $Id: clhs.lisp,v 1.1 2003/11/14 19:37:05 bmastenbrook Exp $ +;;;; $Id: clhs.lisp,v 1.2 2003/11/14 20:35:22 bmastenbrook Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/example/clhs.lisp,v $ ;;;; clhs.lisp - an example IRC bot for net-nittin-irc @@ -32,10 +32,10 @@ (defparameter *mop-map-file* #p"Mop_Sym.txt") (defparameter *mop-root* "http://www.alu.org/mop/") - + (defun add-clhs-section-to-table (&rest numbers) (let ((key (format nil "~{~d~^.~}" numbers)) - (target (concatenate 'string *hyperspec-root* (format nil "Body/~2,'0d_~(~{~36r~}~).htm" (car numbers) (mapcar #'(lambda (x) (+ x 9)) (cdr numbers)))))) + (target (concatenate 'string *hyperspec-root* (format nil "Body/~2,'0d_~(~{~36r~}~).htm" (car numbers) (mapcar #'(lambda (x) (+ x 9)) (cdr numbers)))))) (setf (gethash key *table*) target))) (defun valid-target (&rest numbers) @@ -47,85 +47,85 @@ ;; populate the table with the symbols from the Map file ;; this bit is easy and portable. (do ((symbol-name (read-line s nil s) (read-line s nil s)) - (url (read-line s nil s) (read-line s nil s))) - ((eq url s) 'done) + (url (read-line s nil s) (read-line s nil s))) + ((eq url s) 'done) (setf (gethash symbol-name *table*) (concatenate 'string *hyperspec-root* (subseq url 3)))) ;; add in section references. (let ((*default-pathname-defaults* *hyperspec-pathname*)) ;; Yuk. I know. Fixes welcome. (loop for section from 0 to 27 - do (add-clhs-section-to-table section) - do (loop named s for s1 from 1 to 17 - unless (valid-target section s1) - do (return-from s nil) - do (add-clhs-section-to-table section s1) - do (loop named ss for s2 from 1 to 17 - unless (valid-target section s1 s2) - do (return-from ss nil) - do (add-clhs-section-to-table section s1 s2) - do (loop named sss for s3 from 1 to 17 - unless (valid-target section s1 s2 s3) - do (return-from sss nil) - do (add-clhs-section-to-table section s1 s2 s3) - do (loop named ssss for s4 from 1 to 17 - unless (valid-target section s1 s2 s3 s4) - do (return-from ssss nil) - do (add-clhs-section-to-table section s1 s2 s3 s4) - do (loop named sssss for s5 from 1 to 17 - unless (valid-target section s1 s2 s3 s4 s5) - do (return-from sssss nil) - do (add-clhs-section-to-table section s1 s2 s3 s4 s5)))))))) + do (add-clhs-section-to-table section) + do (loop named s for s1 from 1 to 17 + unless (valid-target section s1) + do (return-from s nil) + do (add-clhs-section-to-table section s1) + do (loop named ss for s2 from 1 to 17 + unless (valid-target section s1 s2) + do (return-from ss nil) + do (add-clhs-section-to-table section s1 s2) + do (loop named sss for s3 from 1 to 17 + unless (valid-target section s1 s2 s3) + do (return-from sss nil) + do (add-clhs-section-to-table section s1 s2 s3) + do (loop named ssss for s4 from 1 to 17 + unless (valid-target section s1 s2 s3 s4) + do (return-from ssss nil) + do (add-clhs-section-to-table section s1 s2 s3 s4) + do (loop named sssss for s5 from 1 to 17 + unless (valid-target section s1 s2 s3 s4 s5) + do (return-from sssss nil) + do (add-clhs-section-to-table section s1 s2 s3 s4 s5)))))))) ;; format directives (loop for code from 32 to 127 - do (setf (gethash (format nil "format:~A" (code-char code)) *table*) - (concatenate 'string - *hyperspec-root* - (case (code-char code) - ((#\c #\C) "Body/22_caa.htm") - ((#\%) "Body/22_cab.htm") - ((#\&) "Body/22_cac.htm") - ((#\|) "Body/22_cad.htm") - ((#\~) "Body/22_cae.htm") - ((#\r #\R) "Body/22_cba.htm") - ((#\d #\D) "Body/22_cbb.htm") - ((#\b #\B) "Body/22_cbc.htm") - ((#\o #\O) "Body/22_cbd.htm") - ((#\x #\X) "Body/22_cbe.htm") - ((#\f #\F) "Body/22_cca.htm") - ((#\e #\E) "Body/22_ccb.htm") - ((#\g #\G) "Body/22_ccc.htm") - ((#\$) "Body/22_ccd.htm") - ((#\a #\A) "Body/22_cda.htm") - ((#\s #\S) "Body/22_cdb.htm") - ((#\w #\W) "Body/22_cdc.htm") - ((#\_) "Body/22_cea.htm") - ((#\<) "Body/22_ceb.htm") - ((#\i #\I) "Body/22_cec.htm") - ((#\/) "Body/22_ced.htm") - ((#\t #\T) "Body/22_cfa.htm") - ;; FIXME - ((#\<) "Body/22_cfb.htm") - ((#\>) "Body/22_cfc.htm") - ((#\*) "Body/22_cga.htm") - ((#\[) "Body/22_cgb.htm") - ((#\]) "Body/22_cgc.htm") - ((#\{) "Body/22_cgd.htm") - ((#\}) "Body/22_cge.htm") - ((#\?) "Body/22_cgf.htm") - ((#\() "Body/22_cha.htm") - ((#\)) "Body/22_chb.htm") - ((#\p #\P) "Body/22_chc.htm") - ((#\;) "Body/22_cia.htm") - ((#\^) "Body/22_cib.htm") - ((#\Newline) "Body/22_cic.htm") - (t "Body/22_c.htm"))))) + do (setf (gethash (format nil "format:~A" (code-char code)) *table*) + (concatenate 'string + *hyperspec-root* + (case (code-char code) + ((#\c #\C) "Body/22_caa.htm") + ((#\%) "Body/22_cab.htm") + ((#\&) "Body/22_cac.htm") + ((#\|) "Body/22_cad.htm") + ((#\~) "Body/22_cae.htm") + ((#\r #\R) "Body/22_cba.htm") + ((#\d #\D) "Body/22_cbb.htm") + ((#\b #\B) "Body/22_cbc.htm") + ((#\o #\O) "Body/22_cbd.htm") + ((#\x #\X) "Body/22_cbe.htm") + ((#\f #\F) "Body/22_cca.htm") + ((#\e #\E) "Body/22_ccb.htm") + ((#\g #\G) "Body/22_ccc.htm") + ((#\$) "Body/22_ccd.htm") + ((#\a #\A) "Body/22_cda.htm") + ((#\s #\S) "Body/22_cdb.htm") + ((#\w #\W) "Body/22_cdc.htm") + ((#\_) "Body/22_cea.htm") + ((#\<) "Body/22_ceb.htm") + ((#\i #\I) "Body/22_cec.htm") + ((#\/) "Body/22_ced.htm") + ((#\t #\T) "Body/22_cfa.htm") + ;; FIXME + ((#\<) "Body/22_cfb.htm") + ((#\>) "Body/22_cfc.htm") + ((#\*) "Body/22_cga.htm") + ((#\[) "Body/22_cgb.htm") + ((#\]) "Body/22_cgc.htm") + ((#\{) "Body/22_cgd.htm") + ((#\}) "Body/22_cge.htm") + ((#\?) "Body/22_cgf.htm") + ((#\() "Body/22_cha.htm") + ((#\)) "Body/22_chb.htm") + ((#\p #\P) "Body/22_chc.htm") + ((#\;) "Body/22_cia.htm") + ((#\^) "Body/22_cib.htm") + ((#\Newline) "Body/22_cic.htm") + (t "Body/22_c.htm"))))) ;; glossary. ) ;; MOP (with-open-file (s *mop-map-file*) (do ((symbol-name (read-line s nil s) (read-line s nil s)) - (url (read-line s nil s) (read-line s nil s))) - ((eq url s) 'done) + (url (read-line s nil s) (read-line s nil s))) + ((eq url s) 'done) (setf (gethash (concatenate 'string "MOP:" symbol-name) *table*) (concatenate 'string *mop-root* url))))) (defvar *clhs-connection*) @@ -135,7 +135,7 @@ `(let ((it ,test)) (if it ,conseq (symbol-macrolet ((it ,test)) - ,else)))) + ,else)))) (defun spec-lookup (str) (aif (gethash str *table*) @@ -147,10 +147,10 @@ (defun msg-hook (message) (if (string-equal (first (arguments message)) *clhs-nickname*) (if (eql (search *clhs-attention-prefix* (trailing-argument message) :test #'char-equal) 0) - (privmsg *clhs-connection* (source message) (spec-lookup (subseq (trailing-argument message) (length *clhs-attention-prefix*)))) - (privmsg *clhs-connection* (source message) (spec-lookup (trailing-argument message)))) + (privmsg *clhs-connection* (source message) (spec-lookup (subseq (trailing-argument message) (length *clhs-attention-prefix*)))) + (privmsg *clhs-connection* (source message) (spec-lookup (trailing-argument message)))) (if (search *clhs-attention-prefix* (trailing-argument message) :test #'char-equal) - (privmsg *clhs-connection* (first (arguments message)) (spec-lookup (subseq (trailing-argument message) (length *clhs-attention-prefix*))))))) + (privmsg *clhs-connection* (first (arguments message)) (spec-lookup (subseq (trailing-argument message) (length *clhs-attention-prefix*))))))) (defun start-clhs-bot (nick server &rest channels) (populate-table) From bmastenbrook at common-lisp.net Mon Nov 17 14:04:28 2003 From: bmastenbrook at common-lisp.net (Brian Mastenbrook) Date: Mon, 17 Nov 2003 09:04:28 -0500 Subject: [net-nittin-irc-cvs] CVS update: net-nittin-irc/example/clhs.lisp Message-ID: Update of /project/net-nittin-irc/cvsroot/net-nittin-irc/example In directory common-lisp.net:/tmp/cvs-serv8784 Modified Files: clhs.lisp Log Message: Bugfixen Date: Mon Nov 17 09:04:28 2003 Author: bmastenbrook Index: net-nittin-irc/example/clhs.lisp diff -u net-nittin-irc/example/clhs.lisp:1.2 net-nittin-irc/example/clhs.lisp:1.3 --- net-nittin-irc/example/clhs.lisp:1.2 Fri Nov 14 15:35:22 2003 +++ net-nittin-irc/example/clhs.lisp Mon Nov 17 09:04:28 2003 @@ -1,4 +1,4 @@ -;;;; $Id: clhs.lisp,v 1.2 2003/11/14 20:35:22 bmastenbrook Exp $ +;;;; $Id: clhs.lisp,v 1.3 2003/11/17 14:04:28 bmastenbrook Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/example/clhs.lisp,v $ ;;;; clhs.lisp - an example IRC bot for net-nittin-irc @@ -19,12 +19,10 @@ (defpackage :clhs (:use :common-lisp :irc)) (in-package :clhs) -(defparameter *table* (make-hash-table :test 'equalp)) - ;;; CLHS. This will be the default lookup. -(defparameter *hyperspec-map-file* #p"HyperSpec/Data/Map_Sym.txt") +(defparameter *hyperspec-pathname* #p"/home/chandler/public_html/HyperSpec/") -(defparameter *hyperspec-pathname* #p"HyperSpec/") +(defparameter *hyperspec-map-file* (merge-pathnames "Data/Map_Sym.txt" *hyperspec-pathname*)) (defparameter *hyperspec-root* "http://www.lispworks.com/reference/HyperSpec/") @@ -32,6 +30,8 @@ (defparameter *mop-map-file* #p"Mop_Sym.txt") (defparameter *mop-root* "http://www.alu.org/mop/") + +(defparameter *table* (make-hash-table :test 'equalp)) (defun add-clhs-section-to-table (&rest numbers) (let ((key (format nil "~{~d~^.~}" numbers)) @@ -144,12 +144,17 @@ (defparameter *clhs-attention-prefix* "clhs ") +(defun valid-clhs-message (message) + (if (eql (search *clhs-attention-prefix* (trailing-argument message) :test #'char-equal) 0) + (not (find #\space (trailing-argument message) :start (length *clhs-attention-prefix*))) + nil)) + (defun msg-hook (message) (if (string-equal (first (arguments message)) *clhs-nickname*) - (if (eql (search *clhs-attention-prefix* (trailing-argument message) :test #'char-equal) 0) + (if (valid-clhs-message message) (privmsg *clhs-connection* (source message) (spec-lookup (subseq (trailing-argument message) (length *clhs-attention-prefix*)))) (privmsg *clhs-connection* (source message) (spec-lookup (trailing-argument message)))) - (if (search *clhs-attention-prefix* (trailing-argument message) :test #'char-equal) + (if (valid-clhs-message message) (privmsg *clhs-connection* (first (arguments message)) (spec-lookup (subseq (trailing-argument message) (length *clhs-attention-prefix*))))))) (defun start-clhs-bot (nick server &rest channels) @@ -159,4 +164,8 @@ (mapcar #'(lambda (channel) (join *clhs-connection* channel)) channels) (add-hook *clhs-connection* 'irc::irc-privmsg-message #'msg-hook) #+sbcl (add-asynchronous-message-handler *clhs-connection*) - #-sbcl (read-message-loop *clhs-connection*)) \ No newline at end of file + #-sbcl (read-message-loop *clhs-connection*)) + +(defun shuffle-hooks () + (irc::remove-hooks *clhs-connection* 'irc::irc-privmsg-message) + (add-hook *clhs-connection* 'irc::irc-privmsg-message #'msg-hook)) From eenge at common-lisp.net Sat Nov 22 18:40:37 2003 From: eenge at common-lisp.net (Erik Enge) Date: Sat, 22 Nov 2003 13:40:37 -0500 Subject: [net-nittin-irc-cvs] CVS update: net-nittin-irc/CREDITS Message-ID: Update of /project/net-nittin-irc/cvsroot/net-nittin-irc In directory common-lisp.net:/tmp/cvs-serv26157 Modified Files: CREDITS Log Message: adding brian to CREDITS file Date: Sat Nov 22 13:40:36 2003 Author: eenge Index: net-nittin-irc/CREDITS diff -u net-nittin-irc/CREDITS:1.1.1.1 net-nittin-irc/CREDITS:1.2 --- net-nittin-irc/CREDITS:1.1.1.1 Mon Nov 3 12:00:54 2003 +++ net-nittin-irc/CREDITS Sat Nov 22 13:40:36 2003 @@ -1,2 +1,3 @@ +Erik Enge +Brian Mastenbrook Jochen Schmidt -Erik Enge \ No newline at end of file From eenge at common-lisp.net Sat Nov 22 18:41:03 2003 From: eenge at common-lisp.net (Erik Enge) Date: Sat, 22 Nov 2003 13:41:03 -0500 Subject: [net-nittin-irc-cvs] CVS update: net-nittin-irc/LICENSE Message-ID: Update of /project/net-nittin-irc/cvsroot/net-nittin-irc In directory common-lisp.net:/tmp/cvs-serv26235 Modified Files: LICENSE Log Message: removing Jochens address Date: Sat Nov 22 13:41:03 2003 Author: eenge Index: net-nittin-irc/LICENSE diff -u net-nittin-irc/LICENSE:1.2 net-nittin-irc/LICENSE:1.3 --- net-nittin-irc/LICENSE:1.2 Tue Nov 11 08:35:41 2003 +++ net-nittin-irc/LICENSE Sat Nov 22 13:41:03 2003 @@ -22,9 +22,4 @@ For further details contact the authors of this software. - Jochen Schmidt - Zuckmantelstr. 11 - 91616 Neusitz - Germany - Erik Enge, erik at nittin.net From eenge at common-lisp.net Sat Nov 22 18:55:54 2003 From: eenge at common-lisp.net (Erik Enge) Date: Sat, 22 Nov 2003 13:55:54 -0500 Subject: [net-nittin-irc-cvs] CVS update: net-nittin-irc/event.lisp Message-ID: Update of /project/net-nittin-irc/cvsroot/net-nittin-irc In directory common-lisp.net:/tmp/cvs-serv32206 Modified Files: event.lisp Log Message: removing all those methods with basically no content Date: Sat Nov 22 13:55:53 2003 Author: eenge Index: net-nittin-irc/event.lisp diff -u net-nittin-irc/event.lisp:1.7 net-nittin-irc/event.lisp:1.8 --- net-nittin-irc/event.lisp:1.7 Fri Nov 14 11:13:21 2003 +++ net-nittin-irc/event.lisp Sat Nov 22 13:55:53 2003 @@ -1,4 +1,4 @@ -;;;; $Id: event.lisp,v 1.7 2003/11/14 16:13:21 eenge Exp $ +;;;; $Id: event.lisp,v 1.8 2003/11/22 18:55:53 eenge Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/event.lisp,v $ ;;;; See LICENSE for licensing information. @@ -20,813 +20,53 @@ (stream (client-stream connection))) (client-log connection message))) -(defmethod irc-message-event ((message irc-rpl_welcome-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_yourhost-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_created-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_myinfo-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_bounce-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_tracelink-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_traceconnecting-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_tracehandshake-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_traceunknown-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_traceoperator-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_traceuser-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_traceservice-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_tracenewtype-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_traceclass-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_tracereconnect-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_statslinkinfo-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_statscommands-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_statscline-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_statsnline-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_statsiline-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_statskline-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_statsqline-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_statsyline-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_endofstats-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_umodeis-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_statsdline-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_option-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_endoptions-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_serviceinfo-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_endofservices-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_service-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_servlist-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_servlistend-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_statsvline-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_statslline-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_statsonline-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_statshline-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_statssline-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_statsping-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_statsbline-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_statsuline-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_statsdebug-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_luserclient-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_luserop-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_luserunknown-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_luserchannels-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_luserme-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_adminme-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_adminloc1-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_adminloc2-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_adminemail-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_tracelog-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_traceend-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_tryagain-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_localusers-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_globalusers-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_mode-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_endmode-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_sitelist-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_clientcapab-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_noservicehost-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_none-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_away-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_userhost-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_ison-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_unaway-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_noaway-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_whoisuser-message)) - (apply-to-hooks message) - (client-log (connection message) message) - (let ((user (find-user (connection message) (second (arguments message)))) - (realname (trailing-argument message)) - (username (third (arguments message))) - (hostname (fourth (arguments message)))) - (setf (realname user) realname) - (setf (username user) username) - (setf (hostname user) hostname))) - -(defmethod irc-message-event ((message irc-rpl_whoisserver-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_whoisoperator-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_whowasuser-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_endofwho-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_whoischanop-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_whoisidle-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_endofwhois-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_whoischannels-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_liststart-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_list-message)) - (apply-to-hooks message) - (client-log (connection message) message) - (let ((connection (connection message)) - (channel (second (arguments message))) - (user-count (parse-integer (or (third (arguments message)) "0"))) - (topic (trailing-argument message))) - (pushnew (or (find-channel connection channel) - (make-channel :name channel - :topic topic - :user-count user-count)) - (channel-list connection)))) - -(defmethod irc-message-event ((message irc-rpl_listend-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_channelmodeis-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_uniqopis-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_whoisoperprivs-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_whoisrealhost-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_creationtime-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_notopic-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_topic-message)) - (apply-to-hooks message) - (client-log (connection message) message) - (setf (topic (find-channel (connection message) - (second (arguments message)))) - (trailing-argument message))) - -(defmethod irc-message-event ((message irc-rpl_topicwhotime-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_inviting-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_summoning-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_invitelist-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_endofinvitelist-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_exceptlist-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_endofexceptlist-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_version-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_whoreply-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_namreply-message)) - (apply-to-hooks message) - (client-log (connection message) message) - (let ((channel (find-channel (connection message) (car (last (arguments message)))))) - (dolist (nickname (tokenize-string (trailing-argument message))) - (add-user channel - (find-or-make-user (connection message) - (canonicalize-nickname nickname) - :username (user message) - :hostname (host message)))))) - -(defmethod irc-message-event ((message irc-rpl_killdone-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_closing-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_closeend-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_endofnames-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_links-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_endoflinks-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_banlist-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_endofbanlist-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_endofwhowas-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_info-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_motd-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_infostart-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_endofinfo-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_motdstart-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_endofmotd-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_map-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_endofmap-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_forward-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_youreoper-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_rehashing-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_yourservice-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_myportis-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_time-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_usersstart-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_users-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_endofusers-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_nousers-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_message-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -;; -;; Error events -;; - -(defmethod irc-message-event ((message irc-err_nosuchnick-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_nosuchserver-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_nosuchchannel-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_cannotsendtochan-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_toomanychannels-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_wasnosuchnick-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_nosuchservice-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_noorigin-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_services_offline-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_norecipient-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_notexttosend-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_notoplevel-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_wildtoplevel-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_badmask-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_unknowncommand-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_nomotd-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_noadmininfo-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_fileerror-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_nonicknamegiven-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_erroneusnickname-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_nicknameinuse-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_nickcollision-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_unavailresource-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_bannickchange-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_usernotinchannel-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_notonchannel-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_useronchannel-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_nologin-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_summondisabled-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_userdisabled-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_targetninvite-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_sourceninvite-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_notregistered-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_needmoreparams-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_alreadyregistered-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_nopermforhost-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_passwdmismatch-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_yourebannedcreep-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_youwillbebanned-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_keyset-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_channelisfull-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_unknownmode-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_inviteonlychan-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_bannedfromchan-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_badchannelkey-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_badchanmask-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_nochanmodes-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_banlistfull-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_badchanname-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_throttled-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_noprivileges-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_chanoprivsneeded-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_cantkillserver-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_restricted-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_uniqopprivsneeded-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_no_op_split-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_need_umode-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_nooperhost-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_umodeunknownflag-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_usersdontmatch-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_ghostedclient-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_blocking_notid-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_sitelistfull-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_maxmapnodes-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_maxforwarding-message)) +(defmethod irc-message-event ((message irc-rpl_whoisuser-message)) (apply-to-hooks message) - (client-log (connection message) message)) + (client-log (connection message) message) + (let ((user (find-user (connection message) (second (arguments message)))) + (realname (trailing-argument message)) + (username (third (arguments message))) + (hostname (fourth (arguments message)))) + (setf (realname user) realname) + (setf (username user) username) + (setf (hostname user) hostname))) -(defmethod irc-message-event ((message irc-err_noforwarding-message)) +(defmethod irc-message-event ((message irc-rpl_list-message)) (apply-to-hooks message) - (client-log (connection message) message)) + (client-log (connection message) message) + (let ((connection (connection message)) + (channel (second (arguments message))) + (user-count (parse-integer (or (third (arguments message)) "0"))) + (topic (trailing-argument message))) + (pushnew (or (find-channel connection channel) + (make-channel :name channel + :topic topic + :user-count user-count)) + (channel-list connection)))) -(defmethod irc-message-event ((message irc-err_nounidentified-message)) +(defmethod irc-message-event ((message irc-rpl_topic-message)) (apply-to-hooks message) - (client-log (connection message) message)) + (client-log (connection message) message) + (setf (topic (find-channel (connection message) + (second (arguments message)))) + (trailing-argument message))) -(defmethod irc-message-event ((message irc-err_last_err_msg-message)) +(defmethod irc-message-event ((message irc-rpl_namreply-message)) (apply-to-hooks message) - (client-log (connection message) message)) + (client-log (connection message) message) + (let ((channel (find-channel (connection message) (car (last (arguments message)))))) + (dolist (nickname (tokenize-string (trailing-argument message))) + (add-user channel + (find-or-make-user (connection message) + (canonicalize-nickname nickname) + :username (user message) + :hostname (host message)))))) (defmethod irc-message-event ((message irc-ping-message)) (apply-to-hooks message) (client-log (connection message) message) (pong (connection message) (trailing-argument message) )) -(defmethod irc-message-event ((message irc-error-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - (defmethod irc-message-event ((message irc-join-message)) (apply-to-hooks message) (client-log (connection message) message) @@ -878,10 +118,6 @@ (format nil "Could not find user with nick ~A~%" (source message))))))) -(defmethod irc-message-event ((message irc-notice-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - ;; if we don't know about the user, we should probably add him here to ;; the dangling-users as he is messaging us without being on a channel ;; we are. @@ -889,10 +125,6 @@ (apply-to-hooks message) (client-log (connection message) message)) -(defmethod irc-message-event ((message irc-mode-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - (defmethod irc-message-event ((message irc-kick-message)) (apply-to-hooks message) (client-log (connection message) message) @@ -903,10 +135,6 @@ (remove-channel connection channel) (remove-user channel user)))) -;; -;; CTCP events -;; - (defmethod irc-message-event ((message ctcp-time-message)) (apply-to-hooks message) (client-log (connection message) message) @@ -918,10 +146,6 @@ (make-time-message second minute hour date month year day))) (source message)))) -(defmethod irc-message-event ((message ctcp-action-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - (defmethod irc-message-event ((message ctcp-source-message)) (apply-to-hooks message) (client-log (connection message) message) @@ -956,10 +180,6 @@ (format nil "VERSION ~A" *ctcp-version*)) (source message))) -(defmethod irc-message-event ((message ctcp-userinfo-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - (defmethod irc-message-event ((message ctcp-ping-message)) (apply-to-hooks message) (client-log (connection message) message) @@ -968,10 +188,6 @@ :notice (make-ctcp-message (format nil "PING ~A" (trailing-argument message))) (source message))) - -;; -;; DCC events (which are a variant of CTCP events) -;; (defmethod irc-message-event ((message ctcp-dcc-chat-request-message)) (apply-to-hooks message) From eenge at common-lisp.net Sat Nov 22 18:57:14 2003 From: eenge at common-lisp.net (Erik Enge) Date: Sat, 22 Nov 2003 13:57:14 -0500 Subject: [net-nittin-irc-cvs] CVS update: net-nittin-irc/net-nittin-irc.asd Message-ID: Update of /project/net-nittin-irc/cvsroot/net-nittin-irc In directory common-lisp.net:/tmp/cvs-serv32580 Modified Files: net-nittin-irc.asd Log Message: adding properties for albert Date: Sat Nov 22 13:57:14 2003 Author: eenge Index: net-nittin-irc/net-nittin-irc.asd diff -u net-nittin-irc/net-nittin-irc.asd:1.2 net-nittin-irc/net-nittin-irc.asd:1.3 --- net-nittin-irc/net-nittin-irc.asd:1.2 Fri Nov 7 08:43:06 2003 +++ net-nittin-irc/net-nittin-irc.asd Sat Nov 22 13:57:14 2003 @@ -1,4 +1,4 @@ -;;;; $Id: net-nittin-irc.asd,v 1.2 2003/11/07 13:43:06 eenge Exp $ +;;;; $Id: net-nittin-irc.asd,v 1.3 2003/11/22 18:57:14 eenge Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/net-nittin-irc.asd,v $ ;;;; See the LICENSE file for licensing information. @@ -18,6 +18,13 @@ :description "Common Lisp interface to the IRC protocol" #+sbcl :depends-on (:sb-bsd-sockets :split-sequence) :depends-on (:split-sequence) + :properties ((#:author-email . "net-nittin-irc-devel at common-lisp.net") + (#:date . "$Date: 2003/11/22 18:57:14 $") + ((#:albert #:output-dir) . "doc/api-doc/") + ((#:albert #:formats) . ("docbook")) + ((#:albert #:docbook #:template) . "book") + ((#:albert #:docbook #:bgcolor) . "white") + ((#:albert #:docbook #:textcolor) . "black")) :components ((:file "package") (:file "variable" :depends-on ("package")) From eenge at common-lisp.net Sat Nov 22 19:07:16 2003 From: eenge at common-lisp.net (Erik Enge) Date: Sat, 22 Nov 2003 14:07:16 -0500 Subject: [net-nittin-irc-cvs] CVS update: net-nittin-irc/utility.lisp Message-ID: Update of /project/net-nittin-irc/cvsroot/net-nittin-irc In directory common-lisp.net:/tmp/cvs-serv4404 Modified Files: utility.lisp Log Message: adding better docstring for cut-between Date: Sat Nov 22 14:07:16 2003 Author: eenge Index: net-nittin-irc/utility.lisp diff -u net-nittin-irc/utility.lisp:1.3 net-nittin-irc/utility.lisp:1.4 --- net-nittin-irc/utility.lisp:1.3 Fri Nov 7 10:40:19 2003 +++ net-nittin-irc/utility.lisp Sat Nov 22 14:07:16 2003 @@ -1,4 +1,4 @@ -;;;; $Id: utility.lisp,v 1.3 2003/11/07 15:40:19 eenge Exp $ +;;;; $Id: utility.lisp,v 1.4 2003/11/22 19:07:16 eenge Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/utility.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -118,11 +118,16 @@ (vector first second third fourth))) (defun cut-between (string start-char end-chars &key (start 0) (cut-extra t)) - "If start-char is not nil, cut string between start-char and any of -the end-chars, from start. If start-char is nil, cut from start until -any of the end-chars. - -If cut-extra is t, we will cut from start + 1 instead of just start." + "If `start-char' is not nil, cut string between `start-char' and any +of the `end-chars', from `start'. If `start-char' is nil, cut from +`start' until any of the `end-chars'. + +If `cut-extra' is t, we will cut from start + 1 instead of just +`start'. + +When there is no string matching the input parameters `start' and nil +will be returned, otherwise `end-position' and the string are +returned." (let ((end-position (position-if #'(lambda (char) (member char end-chars)) string :start (1+ start))) From eenge at common-lisp.net Sat Nov 22 19:21:33 2003 From: eenge at common-lisp.net (Erik Enge) Date: Sat, 22 Nov 2003 14:21:33 -0500 Subject: [net-nittin-irc-cvs] CVS update: net-nittin-irc/parse-message.lisp Message-ID: Update of /project/net-nittin-irc/cvsroot/net-nittin-irc In directory common-lisp.net:/tmp/cvs-serv10244 Modified Files: parse-message.lisp Log Message: adding better docstrings Date: Sat Nov 22 14:21:33 2003 Author: eenge Index: net-nittin-irc/parse-message.lisp diff -u net-nittin-irc/parse-message.lisp:1.4 net-nittin-irc/parse-message.lisp:1.5 --- net-nittin-irc/parse-message.lisp:1.4 Mon Nov 10 12:25:38 2003 +++ net-nittin-irc/parse-message.lisp Sat Nov 22 14:21:33 2003 @@ -1,4 +1,4 @@ -;;;; $Id: parse-message.lisp,v 1.4 2003/11/10 17:25:38 eenge Exp $ +;;;; $Id: parse-message.lisp,v 1.5 2003/11/22 19:21:33 eenge Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/parse-message.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -6,6 +6,11 @@ (in-package :irc) (defun find-reply-name (reply-number &key (reply-names *reply-names*)) + "Numeric replies in the IRC RFCs have more meaningful names. Given +a numeric reply (`reply-number') this function will either return the +symbol representing the reply or raise a continuable error +(`no-such-reply') which gives you the opportunity to ignore the +situation." (let ((name (assoc reply-number reply-names))) (if name (cadr name) @@ -15,29 +20,58 @@ :unknown-reply)))) (defun return-source (string &key (start 0)) + "Assuming `string' is a valid IRC message this function returns the +source part of the message. Returns nil if the source part is not +present." (cut-between string #\: '(#\! #\Space) :start start)) (defun return-user (string &key (start 0)) + "Assuming `string' is a valid IRC message this function returns the +user part of the message. Returns nil if the user part is not +present." (cut-between string #\! '(#\@ #\Space) :start start)) (defun return-host (string &key (start 0)) + "Assuming `string' is a valid IRC message this function returns the +host part of the message. Returns nil if the host part is not +present." (cut-between string #\@ '(#\Space) :start start)) (defun return-command (string &key (start 0)) + "Assuming `string' is a valid IRC message this function returns the +command part of the message. Returns nil if the command part is not +present." (if (eql (char string start) #\Space) (cut-between string #\Space '(#\Space) :start start) (cut-between string nil '(#\Space) :start start :cut-extra nil))) (defun return-arguments (string &key (start 0)) + "Assuming `string' is a valid IRC message this function returns the +arguments part of the message as a list. Returns nil if the arguments +part is not present." (multiple-value-bind (end-position return-argument) (cut-between string nil '(#\:) :start start) (values end-position (tokenize-string return-argument :delimiters '(#\Space))))) (defun return-trailing-argument (string &key (start 0)) + "Assuming `string' is a valid IRC message this function returns the +trailing-argument part of the message. Returns nil if the +trailing-argument part is not present." (cut-between string #\: '(#\Return) :start start)) (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: + + - source + - user + - host + - command + - arguments + - trailing-argument + +Any values not present will be represented as nil." (let ((index start) (returns nil)) (dolist (function '(return-source @@ -53,6 +87,8 @@ (apply #'values (reverse returns)))) (defun irc-error-reply-p (string) + "Returns t if `string' is a string-representation of an IRC error +reply message, nil otherwise." (unless (zerop (length string)) (if (and (every #'digit-char-p string) (member (char string 0) '(#\4 #\5))) @@ -60,17 +96,20 @@ nil))) (defun numeric-reply-p (string) + "Returns t if `string' is a string-representation of an IRC number +reply, nil otherwise." (every #'digit-char-p string)) (defun ctcp-type-p (string type) - "What type of CTCP message is this?" - (if (string-equal (subseq string 1 (min (length string) - (1+ (length (symbol-name type))))) + "Is the `string' actually a representation of the CTCP `type'?" + (if (string-equal (subseq string 1 (min (length string) + (1+ (length (symbol-name type))))) type) type nil)) (defun dcc-type-p (string type) + "Is the `string' actually a representation of the DCC `type'?" (case type (:dcc-chat-request (when (string-equal (char string 5) #\C) @@ -80,7 +119,10 @@ :dcc-send-request)) (otherwise nil))) -(defun parse-ctcp-message (string) +(defun ctcp-message-p (string) + "If `string' is a CTCP message, return the type of the message or +nil if this is a) not a CTCP message or b) a CTCP message we don't +know about." (if (or (not (stringp string)) (zerop (length string)) (not (eql (char string 0) +soh+))) @@ -100,10 +142,13 @@ (otherwise nil)))) (defun create-irc-message (string) + "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) (parse-raw-message string) (let ((class 'irc-message) - (ctcp (parse-ctcp-message trailing-argument))) + (ctcp (ctcp-message-type trailing-argument))) (when command (cond ((irc-error-reply-p command) From eenge at common-lisp.net Sat Nov 22 19:24:13 2003 From: eenge at common-lisp.net (Erik Enge) Date: Sat, 22 Nov 2003 14:24:13 -0500 Subject: [net-nittin-irc-cvs] CVS update: net-nittin-irc/protocol.lisp Message-ID: Update of /project/net-nittin-irc/cvsroot/net-nittin-irc In directory common-lisp.net:/tmp/cvs-serv11616 Modified Files: protocol.lisp Log Message: adding a few better docstrings Date: Sat Nov 22 14:24:13 2003 Author: eenge Index: net-nittin-irc/protocol.lisp diff -u net-nittin-irc/protocol.lisp:1.12 net-nittin-irc/protocol.lisp:1.13 --- net-nittin-irc/protocol.lisp:1.12 Fri Nov 14 15:35:01 2003 +++ net-nittin-irc/protocol.lisp Sat Nov 22 14:24:13 2003 @@ -1,4 +1,4 @@ -;;;; $Id: protocol.lisp,v 1.12 2003/11/14 20:35:01 bmastenbrook Exp $ +;;;; $Id: protocol.lisp,v 1.13 2003/11/22 19:24:13 eenge Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/protocol.lisp,v $ ;;;; See LICENSE for licensing information. @@ -106,6 +106,8 @@ (force-output stream))) (defmethod connectedp ((connection connection)) + "Returns t if `connection' is connected to a server and is ready for +input." (let ((stream (server-stream connection))) (and (streamp stream) (open-stream-p stream)))) @@ -129,14 +131,16 @@ (when *debug-p* (format *debug-stream* "~A" (describe message))) (irc-message-event message) - message))) ; needed because of the "loop while" in read-meesage-loop + message))) ; needed because of the "loop while" in read-message-loop (stream-error () (setf read-more-p nil))))) (defmethod read-message-loop ((connection connection)) + "Read messages from the `connection', parse them and dispatch +irc-message-event on them." (loop while (read-message connection))) (defmethod read-irc-message ((connection connection)) - "Read an IRC-message from the connection." + "Read and parse an IRC-message from the `connection'." (let ((message (create-irc-message (read-line (server-stream connection) t)))) (setf (connection message) connection) From eenge at common-lisp.net Sun Nov 23 22:39:19 2003 From: eenge at common-lisp.net (Erik Enge) Date: Sun, 23 Nov 2003 17:39:19 -0500 Subject: [net-nittin-irc-cvs] CVS update: net-nittin-irc/README net-nittin-irc/command.lisp net-nittin-irc/event.lisp net-nittin-irc/net-nittin-irc.asd net-nittin-irc/package.lisp net-nittin-irc/parse-message.lisp net-nittin-irc/protocol.lisp net-nittin-irc/utility.lisp Message-ID: Update of /project/net-nittin-irc/cvsroot/net-nittin-irc In directory common-lisp.net:/tmp/cvs-serv11001 Modified Files: README command.lisp event.lisp net-nittin-irc.asd package.lisp parse-message.lisp protocol.lisp utility.lisp Log Message: removing configuration details removing unused irc-message-event methods some renamings Date: Sun Nov 23 17:39:17 2003 Author: eenge Index: net-nittin-irc/README diff -u net-nittin-irc/README:1.3 net-nittin-irc/README:1.4 --- net-nittin-irc/README:1.3 Mon Nov 3 17:22:18 2003 +++ net-nittin-irc/README Sun Nov 23 17:39:15 2003 @@ -1,5 +1,5 @@ net-nittin-irc: A Common Lisp interface to the client-part of the IRC -protocol. +protocol; RFCs 2810, 2811 and 2812. Quick demo: Index: net-nittin-irc/command.lisp diff -u net-nittin-irc/command.lisp:1.6 net-nittin-irc/command.lisp:1.7 --- net-nittin-irc/command.lisp:1.6 Fri Nov 14 15:35:01 2003 +++ net-nittin-irc/command.lisp Sun Nov 23 17:39:15 2003 @@ -1,4 +1,4 @@ -;;;; $Id: command.lisp,v 1.6 2003/11/14 20:35:01 bmastenbrook Exp $ +;;;; $Id: command.lisp,v 1.7 2003/11/23 22:39:15 eenge Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/command.lisp,v $ ;;;; See LICENSE for licensing information. @@ -6,6 +6,21 @@ (in-package :irc) (defmethod pass ((connection connection) (password string)) + "A \"PASS\" command is not required for a client connection to be +registered, but it MUST precede the latter of the NICK/USER +combination (for a user connection) or the SERVICE command (for a +service connection). The RECOMMENDED order for a client to register is +as follows: + + 1. Pass message + 2. Nick message 2. Service message + 3. User message + +Upon success, the client will receive an RPL_WELCOME (for users) or +RPL_YOURESERVICE (for services) message indicating that the connection +is now registered and known the to the entire IRC network. The reply +message MUST contain the full client identifier upon which it was +registered." (send-irc-message connection :pass nil password)) (defmethod nick ((connection connection) (new-nickname string)) Index: net-nittin-irc/event.lisp diff -u net-nittin-irc/event.lisp:1.8 net-nittin-irc/event.lisp:1.9 --- net-nittin-irc/event.lisp:1.8 Sat Nov 22 13:55:53 2003 +++ net-nittin-irc/event.lisp Sun Nov 23 17:39:15 2003 @@ -1,4 +1,4 @@ -;;;; $Id: event.lisp,v 1.8 2003/11/22 18:55:53 eenge Exp $ +;;;; $Id: event.lisp,v 1.9 2003/11/23 22:39:15 eenge Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/event.lisp,v $ ;;;; See LICENSE for licensing information. @@ -191,31 +191,31 @@ (defmethod irc-message-event ((message ctcp-dcc-chat-request-message)) (apply-to-hooks message) - (client-log (connection message) message) - (when (automatically-accept-dcc-connections (configuration (connection message))) - (let* ((user (find-user (connection message) (source message))) - (args (tokenize-string (trailing-argument message))) - (remote-address (hbo-to-vector-quad (parse-integer (fourth args)))) - (remote-port (parse-integer (fifth args) :junk-allowed t))) - (push (make-dcc-connection :user user - :remote-address remote-address - :remote-port remote-port) - *dcc-connections*)))) + (client-log (connection message) message)) +; (when (automatically-accept-dcc-connections (configuration (connection message))) +; (let* ((user (find-user (connection message) (source message))) +; (args (tokenize-string (trailing-argument message))) +; (remote-address (hbo-to-vector-quad (parse-integer (fourth args)))) +; (remote-port (parse-integer (fifth args) :junk-allowed t))) +; (push (make-dcc-connection :user user +; :remote-address remote-address +; :remote-port remote-port) +; *dcc-connections*)))) (defmethod irc-message-event ((message ctcp-dcc-send-request-message)) (apply-to-hooks message) - (client-log (connection message) message) - (when (automatically-accept-dcc-downloads (configuration (connection message))) - (let* ((user (find-user (connection message) (source message))) - (args (tokenize-string (trailing-argument message))) - (filename (third args)) - (remote-address (hbo-to-vector-quad (parse-integer (fourth args)))) - (remote-port (parse-integer (fifth args))) - (filesize (parse-integer (sixth args) :junk-allowed t))) - (let ((dcc-connection (make-dcc-connection :user user - :remote-address remote-address - :remote-port remote-port))) - (with-open-file (stream filename :direction :output - :if-exists :supersede) - (write-sequence (read-message-loop dcc-connection) stream)))))) + (client-log (connection message) message)) +; (when (automatically-accept-dcc-downloads (configuration (connection message))) +; (let* ((user (find-user (connection message) (source message))) +; (args (tokenize-string (trailing-argument message))) +; (filename (third args)) +; (remote-address (hbo-to-vector-quad (parse-integer (fourth args)))) +; (remote-port (parse-integer (fifth args))) +; (filesize (parse-integer (sixth args) :junk-allowed t))) +; (let ((dcc-connection (make-dcc-connection :user user +; :remote-address remote-address +; :remote-port remote-port))) +; (with-open-file (stream filename :direction :output +; :if-exists :supersede) +; (write-sequence (read-message-loop dcc-connection) stream)))))) Index: net-nittin-irc/net-nittin-irc.asd diff -u net-nittin-irc/net-nittin-irc.asd:1.3 net-nittin-irc/net-nittin-irc.asd:1.4 --- net-nittin-irc/net-nittin-irc.asd:1.3 Sat Nov 22 13:57:14 2003 +++ net-nittin-irc/net-nittin-irc.asd Sun Nov 23 17:39:16 2003 @@ -1,4 +1,4 @@ -;;;; $Id: net-nittin-irc.asd,v 1.3 2003/11/22 18:57:14 eenge Exp $ +;;;; $Id: net-nittin-irc.asd,v 1.4 2003/11/23 22:39:16 eenge Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/net-nittin-irc.asd,v $ ;;;; See the LICENSE file for licensing information. @@ -16,10 +16,12 @@ :version "0.1.0" :licence "MIT" :description "Common Lisp interface to the IRC protocol" - #+sbcl :depends-on (:sb-bsd-sockets :split-sequence) + :depends-on + #+sbcl (:sb-bsd-sockets :split-sequence) + #-sbcl (:split-sequence) :depends-on (:split-sequence) :properties ((#:author-email . "net-nittin-irc-devel at common-lisp.net") - (#:date . "$Date: 2003/11/22 18:57:14 $") + (#:date . "$Date: 2003/11/23 22:39:16 $") ((#:albert #:output-dir) . "doc/api-doc/") ((#:albert #:formats) . ("docbook")) ((#:albert #:docbook #:template) . "book") @@ -38,5 +40,3 @@ :depends-on ("protocol")) (:file "event" :depends-on ("command")))) - - Index: net-nittin-irc/package.lisp diff -u net-nittin-irc/package.lisp:1.8 net-nittin-irc/package.lisp:1.9 --- net-nittin-irc/package.lisp:1.8 Fri Nov 14 15:35:01 2003 +++ net-nittin-irc/package.lisp Sun Nov 23 17:39:16 2003 @@ -1,4 +1,4 @@ -;;;; $Id: package.lisp,v 1.8 2003/11/14 20:35:01 bmastenbrook Exp $ +;;;; $Id: package.lisp,v 1.9 2003/11/23 22:39:16 eenge Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/package.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -14,6 +14,7 @@ :add-asynchronous-message-handler :send-message :server-name + :no-such-reply :server-stream :client-stream :channels @@ -42,6 +43,7 @@ :make-channel :client-log :find-channel + :find-reply-name :remove-channel :remove-all-channels :add-channel Index: net-nittin-irc/parse-message.lisp diff -u net-nittin-irc/parse-message.lisp:1.5 net-nittin-irc/parse-message.lisp:1.6 --- net-nittin-irc/parse-message.lisp:1.5 Sat Nov 22 14:21:33 2003 +++ net-nittin-irc/parse-message.lisp Sun Nov 23 17:39:16 2003 @@ -1,4 +1,4 @@ -;;;; $Id: parse-message.lisp,v 1.5 2003/11/22 19:21:33 eenge Exp $ +;;;; $Id: parse-message.lisp,v 1.6 2003/11/23 22:39:16 eenge Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/parse-message.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -119,7 +119,7 @@ :dcc-send-request)) (otherwise nil))) -(defun ctcp-message-p (string) +(defun ctcp-message-type (string) "If `string' is a CTCP message, return the type of the message or nil if this is a) not a CTCP message or b) a CTCP message we don't know about." Index: net-nittin-irc/protocol.lisp diff -u net-nittin-irc/protocol.lisp:1.13 net-nittin-irc/protocol.lisp:1.14 --- net-nittin-irc/protocol.lisp:1.13 Sat Nov 22 14:24:13 2003 +++ net-nittin-irc/protocol.lisp Sun Nov 23 17:39:16 2003 @@ -1,4 +1,4 @@ -;;;; $Id: protocol.lisp,v 1.13 2003/11/22 19:24:13 eenge Exp $ +;;;; $Id: protocol.lisp,v 1.14 2003/11/23 22:39:16 eenge Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/protocol.lisp,v $ ;;;; See LICENSE for licensing information. @@ -56,11 +56,6 @@ :initarg :hooks :accessor hooks :initform (make-hash-table :test #'equal)) - (configuration - :initarg :configuration - :accessor configuration - :documentation "A CONFIGURATION object which would dictate much of -the behaviour of the library towards the connection object.") (dangling-users :initarg :dangling-users :accessor dangling-users @@ -82,20 +77,16 @@ (channels nil) (dangling-users nil) (hooks nil) - (channel-list nil) - (configuration nil)) - (let* ((configuration (or configuration - (make-configuration))) - (connection (make-instance 'connection - :user user - :server-name server-name - :server-socket server-socket - :server-stream server-stream - :client-stream client-stream - :channels channels - :dangling-users dangling-users - :channel-list channel-list - :configuration configuration))) + (channel-list nil)) + (let ((connection (make-instance 'connection + :user user + :server-name server-name + :server-socket server-socket + :server-stream server-stream + :client-stream client-stream + :channels channels + :dangling-users dangling-users + :channel-list channel-list))) (dolist (hook hooks) (add-hook connection (car hook) (cadr hook))) connection)) @@ -183,33 +174,6 @@ (defmethod remove-hooks ((connection connection) class) (setf (gethash class (hooks connection)) nil)) - -;; -;; Configuration -;; - -(defclass configuration () - ((automatically-accept-dcc-connections - :initarg :automatically-accept-dcc-connections - :accessor automatically-accept-dcc-connections - :initform t) - (automatically-accept-dcc-downloads - :initarg :automatically-accept-dcc-downloads - :accessor automatically-accept-dcc-downloads - :initform t) - (dcc-download-directory - :initarg :dcc-download-directory - :accessor dcc-download-directory - :initform (user-homedir-pathname)))) - -(defun make-configuration (&key - (automatically-accept-dcc-connections t) - (automatically-accept-dcc-downloads t) - (dcc-download-directory (user-homedir-pathname))) - (make-instance 'configuration - :automatically-accept-dcc-connections automatically-accept-dcc-connections - :automatically-accept-dcc-downloads automatically-accept-dcc-downloads - :dcc-download-directory dcc-download-directory)) ;; ;; DCC Connection Index: net-nittin-irc/utility.lisp diff -u net-nittin-irc/utility.lisp:1.4 net-nittin-irc/utility.lisp:1.5 --- net-nittin-irc/utility.lisp:1.4 Sat Nov 22 14:07:16 2003 +++ net-nittin-irc/utility.lisp Sun Nov 23 17:39:16 2003 @@ -1,15 +1,10 @@ -;;;; $Id: utility.lisp,v 1.4 2003/11/22 19:07:16 eenge Exp $ +;;;; $Id: utility.lisp,v 1.5 2003/11/23 22:39:16 eenge Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/utility.lisp,v $ ;;;; See the LICENSE file for licensing information. (in-package :irc) -(defun string-join (string1 string2) - (if (typep string2 'string) - (concatenate 'string string1 string2) - (concatenate 'string string1 (list string2)))) - (defun get-day-name (day-number) "Given a number, such as 1, return the appropriate day name, abbrevated, such as \"Tue\". Index 0 is Monday." @@ -43,6 +38,8 @@ (error "Unknown month ~A." month-number)))) (defun make-time-message (second minute hour date month year day) + "Returns a string composed of the input parameters so that it +represents a time message as by the IRC protocol." (format nil "~A ~A ~2D ~2,'0D:~2,'0D:~2,'0D ~D" (get-day-name day) (get-month-name month) @@ -52,21 +49,10 @@ second year)) -(defmacro with-output-as-irc-message ((sym stream message) &body body) - (let ((-second- (gensym)) - (-minute- (gensym)) - (-hour- (gensym)) - (-msg- (gensym))) - `(let ((,sym ,stream) - (,-msg- ,message)) - (multiple-value-bind (,-second- ,-minute- ,-hour-) - (decode-universal-time (receive-time ,-msg-)) - (format ,sym "[~2,'0D:~2,'0D:~2,'0D] " ,-hour- ,-minute- ,-second-) - , at body) - (terpri ,sym)))) - (defun make-irc-message (command &key (arguments nil) (trailing-argument nil)) + "Return a valid IRC message, as a string, composed of the input +parameters." (format nil "~A~{ ~A~}~A~A~A~A" command arguments (if trailing-argument " :" @@ -75,12 +61,14 @@ #\Return #\Linefeed)) -(defun make-ctcp-message (message) - (format nil "~A~A~A" +soh+ message +soh+)) +(defun make-ctcp-message (string) + "Return a valid IRC CTCP message, as a string, composed by +`string'." + (format nil "~A~A~A" +soh+ string +soh+)) (defun tokenize-string (string &key (delimiters '(#\Space #\Return #\Linefeed #\Newline))) - "Split string into a list, splitting on delimiters and removing any + "Split string into a list, splitting on `delimiters' and removing any empty subsequences." (split-sequence:split-sequence-if #'(lambda (character) (member character delimiters)) From eenge at common-lisp.net Sun Nov 23 22:40:24 2003 From: eenge at common-lisp.net (Erik Enge) Date: Sun, 23 Nov 2003 17:40:24 -0500 Subject: [net-nittin-irc-cvs] CVS update: net-nittin-irc/test/net-nittin-irc-test.asd net-nittin-irc/test/package.lisp net-nittin-irc/test/test-parse-message.lisp Message-ID: Update of /project/net-nittin-irc/cvsroot/net-nittin-irc/test In directory common-lisp.net:/tmp/cvs-serv13263 Added Files: net-nittin-irc-test.asd package.lisp test-parse-message.lisp Log Message: adding the beginnings of a test suite Date: Sun Nov 23 17:40:23 2003 Author: eenge From eenge at common-lisp.net Sun Nov 23 23:06:14 2003 From: eenge at common-lisp.net (Erik Enge) Date: Sun, 23 Nov 2003 18:06:14 -0500 Subject: [net-nittin-irc-cvs] CVS update: net-nittin-irc/package.lisp Message-ID: Update of /project/net-nittin-irc/cvsroot/net-nittin-irc In directory common-lisp.net:/tmp/cvs-serv25021 Modified Files: package.lisp Log Message: exporting parse-raw-message and the conditions Date: Sun Nov 23 18:06:14 2003 Author: eenge Index: net-nittin-irc/package.lisp diff -u net-nittin-irc/package.lisp:1.9 net-nittin-irc/package.lisp:1.10 --- net-nittin-irc/package.lisp:1.9 Sun Nov 23 17:39:16 2003 +++ net-nittin-irc/package.lisp Sun Nov 23 18:06:13 2003 @@ -1,4 +1,4 @@ -;;;; $Id: package.lisp,v 1.9 2003/11/23 22:39:16 eenge Exp $ +;;;; $Id: package.lisp,v 1.10 2003/11/23 23:06:13 eenge Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/package.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -15,6 +15,7 @@ :send-message :server-name :no-such-reply + :parse-raw-message :server-stream :client-stream :channels From eenge at common-lisp.net Sun Nov 23 23:06:24 2003 From: eenge at common-lisp.net (Erik Enge) Date: Sun, 23 Nov 2003 18:06:24 -0500 Subject: [net-nittin-irc-cvs] CVS update: net-nittin-irc/test/test-parse-message.lisp Message-ID: Update of /project/net-nittin-irc/cvsroot/net-nittin-irc/test In directory common-lisp.net:/tmp/cvs-serv25077 Modified Files: test-parse-message.lisp Log Message: adding more tests Date: Sun Nov 23 18:06:24 2003 Author: eenge Index: net-nittin-irc/test/test-parse-message.lisp diff -u net-nittin-irc/test/test-parse-message.lisp:1.1 net-nittin-irc/test/test-parse-message.lisp:1.2 --- net-nittin-irc/test/test-parse-message.lisp:1.1 Sun Nov 23 17:40:23 2003 +++ net-nittin-irc/test/test-parse-message.lisp Sun Nov 23 18:06:24 2003 @@ -1,11 +1,46 @@ -;;;; $Id: test-parse-message.lisp,v 1.1 2003/11/23 22:40:23 eenge Exp $ +;;;; $Id: test-parse-message.lisp,v 1.2 2003/11/23 23:06:24 eenge Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/test/test-parse-message.lisp,v $ ;;;; See the LICENSE file for licensing information. (in-package :net-nittin-irc-test) +(defvar *msg1* (format nil ":kire!~~eenge at 216.248.178.227 PRIVMSG cl-irc :heyhey!~A" #\Return)) +(defvar *msg2* (format nil ":tolkien.freenode.net 372 cl-irc :-~A" #\Return)) +(defvar *msg3* (format nil "NOTICE AUTH :*** Your forward and reverse DNS don't match~A" #\return)) + (deftest find-reply-name.1 (irc:find-reply-name 1) :rpl_welcome) (deftest find-reply-name.2 (handler-bind ((irc:no-such-reply #'continue)) (irc:find-reply-name 999)) :unknown-reply) + +(deftest return-source.1 (irc::return-source #.*msg1*) 5 "kire") +(deftest return-source.2 (irc::return-source #.*msg2*) 21 "tolkien.freenode.net") +(deftest return-source.3 (irc::return-source #.*msg3*) 0 nil) + +(deftest return-user.1 (irc::return-user #.*msg1* :start 5) 12 "~eenge") +(deftest return-user.2 (irc::return-user #.*msg2* :start 21) 21 nil) +(deftest return-user.3 (irc::return-user #.*msg3* :start 0) 0 nil) + +(deftest return-host.1 (irc::return-host #.*msg1* :start 12) 28 "216.248.178.227") +(deftest return-host.2 (irc::return-host #.*msg2* :start 21) 21 nil) +(deftest return-host.3 (irc::return-host #.*msg3* :start 0) 0 nil) + +(deftest return-command.1 (irc::return-command #.*msg1* :start 28) 36 "PRIVMSG") +(deftest return-command.2 (irc::return-command #.*msg2* :start 21) 25 "372") +(deftest return-command.3 (irc::return-command #.*msg3* :start 0) 6 "NOTICE") + +(deftest return-arguments.1 (irc::return-arguments #.*msg1* :start 36) 44 ("cl-irc")) +(deftest return-arguments.2 (irc::return-arguments #.*msg2* :start 25) 33 ("cl-irc")) +(deftest return-arguments.3 (irc::return-arguments #.*msg3* :start 6) 12 ("AUTH")) + +(deftest return-trailing-argument.1 + (irc::return-trailing-argument #.*msg1* :start 44) 52 "heyhey!") +(deftest return-trailing-argument.2 + (irc::return-trailing-argument #.*msg2* :start 33) 35 "-") +(deftest return-trailing-argument.3 + (irc::return-trailing-argument #.*msg3* :start 12) 57 "*** Your forward and reverse DNS don't match") + +(deftest parse-raw-message.1 + (irc::parse-raw-message #.*msg1*) + "kire" "~eenge" "216.248.178.227" "PRIVMSG" ("cl-irc") "heyhey!") From eenge at common-lisp.net Sun Nov 23 23:21:39 2003 From: eenge at common-lisp.net (Erik Enge) Date: Sun, 23 Nov 2003 18:21:39 -0500 Subject: [net-nittin-irc-cvs] CVS update: net-nittin-irc/event.lisp Message-ID: Update of /project/net-nittin-irc/cvsroot/net-nittin-irc In directory common-lisp.net:/tmp/cvs-serv31306 Modified Files: event.lisp Log Message: adding default hooks Date: Sun Nov 23 18:21:39 2003 Author: eenge Index: net-nittin-irc/event.lisp diff -u net-nittin-irc/event.lisp:1.9 net-nittin-irc/event.lisp:1.10 --- net-nittin-irc/event.lisp:1.9 Sun Nov 23 17:39:15 2003 +++ net-nittin-irc/event.lisp Sun Nov 23 18:21:38 2003 @@ -1,4 +1,4 @@ -;;;; $Id: event.lisp,v 1.9 2003/11/23 22:39:15 eenge Exp $ +;;;; $Id: event.lisp,v 1.10 2003/11/23 23:21:38 eenge Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/event.lisp,v $ ;;;; See LICENSE for licensing information. @@ -14,16 +14,9 @@ (apply-to-hooks message) (client-log (connection message) message "UNHANLDED-EVENT:")) -(defmethod irc-message-event ((message irc-error-reply)) - (apply-to-hooks message) - (let* ((connection (connection message)) - (stream (client-stream connection))) - (client-log connection message))) - -(defmethod irc-message-event ((message irc-rpl_whoisuser-message)) - (apply-to-hooks message) - (client-log (connection message) message) - (let ((user (find-user (connection message) (second (arguments message)))) +(defmethod default-hook ((message irc-rpl_whoisuser-message)) + (let ((user (find-user (connection message) + (second (arguments message)))) (realname (trailing-argument message)) (username (third (arguments message))) (hostname (fourth (arguments message)))) @@ -31,9 +24,7 @@ (setf (username user) username) (setf (hostname user) hostname))) -(defmethod irc-message-event ((message irc-rpl_list-message)) - (apply-to-hooks message) - (client-log (connection message) message) +(defmethod default-hook ((message irc-rpl_list-message)) (let ((connection (connection message)) (channel (second (arguments message))) (user-count (parse-integer (or (third (arguments message)) "0"))) @@ -44,16 +35,12 @@ :user-count user-count)) (channel-list connection)))) -(defmethod irc-message-event ((message irc-rpl_topic-message)) - (apply-to-hooks message) - (client-log (connection message) message) +(defmethod default-hook ((message irc-rpl_topic-message)) (setf (topic (find-channel (connection message) (second (arguments message)))) (trailing-argument message))) -(defmethod irc-message-event ((message irc-rpl_namreply-message)) - (apply-to-hooks message) - (client-log (connection message) message) +(defmethod default-hook ((message irc-rpl_namreply-message)) (let ((channel (find-channel (connection message) (car (last (arguments message)))))) (dolist (nickname (tokenize-string (trailing-argument message))) (add-user channel @@ -62,14 +49,10 @@ :username (user message) :hostname (host message)))))) -(defmethod irc-message-event ((message irc-ping-message)) - (apply-to-hooks message) - (client-log (connection message) message) - (pong (connection message) (trailing-argument message) )) +(defmethod default-hook ((message irc-ping-message)) + (pong (connection message) (trailing-argument message))) -(defmethod irc-message-event ((message irc-join-message)) - (apply-to-hooks message) - (client-log (connection message) message) +(defmethod default-hook ((message irc-join-message)) (let* ((connection (connection message)) (user (find-or-make-user (connection message) @@ -82,16 +65,12 @@ (add-channel connection channel) (add-user channel user)))) -(defmethod irc-message-event ((message irc-topic-message)) - (apply-to-hooks message) - (client-log (connection message) message) +(defmethod default-hook ((message irc-topic-message)) (setf (topic (find-channel (connection message) (first (arguments message)))) (trailing-argument message))) -(defmethod irc-message-event ((message irc-part-message)) - (apply-to-hooks message) - (client-log (connection message) message) +(defmethod default-hook ((message irc-part-message)) (let* ((connection (connection message)) (channel (find-channel connection (first (arguments message)))) (user (find-user connection (source message)))) @@ -99,15 +78,11 @@ (remove-channel connection channel) (remove-user channel user)))) -(defmethod irc-message-event ((message irc-quit-message)) - (apply-to-hooks message) - (client-log (connection message) message) +(defmethod default-hook ((message irc-quit-message)) (let ((connection (connection message))) (remove-user-everywhere connection (find-user connection (source message))))) -(defmethod irc-message-event ((message irc-nick-message)) - (apply-to-hooks message) - (client-log (connection message) message) +(defmethod default-hook ((message irc-nick-message)) (if (self-message-p message) (change-nickname (connection message) (user (connection message)) (trailing-argument message)) @@ -118,16 +93,7 @@ (format nil "Could not find user with nick ~A~%" (source message))))))) -;; if we don't know about the user, we should probably add him here to -;; the dangling-users as he is messaging us without being on a channel -;; we are. -(defmethod irc-message-event ((message irc-privmsg-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-kick-message)) - (apply-to-hooks message) - (client-log (connection message) message) +(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))))) @@ -135,9 +101,7 @@ (remove-channel connection channel) (remove-user channel user)))) -(defmethod irc-message-event ((message ctcp-time-message)) - (apply-to-hooks message) - (client-log (connection message) message) +(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) @@ -146,9 +110,7 @@ (make-time-message second minute hour date month year day))) (source message)))) -(defmethod irc-message-event ((message ctcp-source-message)) - (apply-to-hooks message) - (client-log (connection message) message) +(defmethod default-hook ((message ctcp-source-message)) (send-irc-message (connection message) :notice (make-ctcp-message @@ -158,9 +120,7 @@ *download-file*)) (source message))) -(defmethod irc-message-event ((message ctcp-finger-message)) - (apply-to-hooks message) - (client-log (connection message) message) +(defmethod default-hook ((message ctcp-finger-message)) (let* ((user (user (connection message))) (finger-info (if (not (zerop (length (realname user)))) (realname user) @@ -171,18 +131,14 @@ (format nil "FINGER ~A" finger-info)) (source message)))) -(defmethod irc-message-event ((message ctcp-version-message)) - (apply-to-hooks message) - (client-log (connection message) message) +(defmethod default-hook ((message ctcp-version-message)) (send-irc-message (connection message) :notice (make-ctcp-message (format nil "VERSION ~A" *ctcp-version*)) (source message))) -(defmethod irc-message-event ((message ctcp-ping-message)) - (apply-to-hooks message) - (client-log (connection message) message) +(defmethod default-hook ((message ctcp-ping-message)) (send-irc-message (connection message) :notice (make-ctcp-message From eenge at common-lisp.net Sun Nov 23 23:21:59 2003 From: eenge at common-lisp.net (Erik Enge) Date: Sun, 23 Nov 2003 18:21:59 -0500 Subject: [net-nittin-irc-cvs] CVS update: net-nittin-irc/command.lisp Message-ID: Update of /project/net-nittin-irc/cvsroot/net-nittin-irc In directory common-lisp.net:/tmp/cvs-serv31378 Modified Files: command.lisp Log Message: calling add-default-hooks in connect Date: Sun Nov 23 18:21:59 2003 Author: eenge Index: net-nittin-irc/command.lisp diff -u net-nittin-irc/command.lisp:1.7 net-nittin-irc/command.lisp:1.8 --- net-nittin-irc/command.lisp:1.7 Sun Nov 23 17:39:15 2003 +++ net-nittin-irc/command.lisp Sun Nov 23 18:21:57 2003 @@ -1,4 +1,4 @@ -;;;; $Id: command.lisp,v 1.7 2003/11/23 22:39:15 eenge Exp $ +;;;; $Id: command.lisp,v 1.8 2003/11/23 23:21:57 eenge Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/command.lisp,v $ ;;;; See LICENSE for licensing information. @@ -222,6 +222,7 @@ :server-name server))) (nick connection nickname) (user- connection (or username nickname) mode (or realname nickname)) + (add-default-hooks connection) connection)) (defmethod trace- ((connection connection) &optional (target "")) From eenge at common-lisp.net Sun Nov 23 23:22:19 2003 From: eenge at common-lisp.net (Erik Enge) Date: Sun, 23 Nov 2003 18:22:19 -0500 Subject: [net-nittin-irc-cvs] CVS update: net-nittin-irc/protocol.lisp Message-ID: Update of /project/net-nittin-irc/cvsroot/net-nittin-irc In directory common-lisp.net:/tmp/cvs-serv31463 Modified Files: protocol.lisp Log Message: adding add-default-hooks Date: Sun Nov 23 18:22:19 2003 Author: eenge Index: net-nittin-irc/protocol.lisp diff -u net-nittin-irc/protocol.lisp:1.14 net-nittin-irc/protocol.lisp:1.15 --- net-nittin-irc/protocol.lisp:1.14 Sun Nov 23 17:39:16 2003 +++ net-nittin-irc/protocol.lisp Sun Nov 23 18:22:19 2003 @@ -1,4 +1,4 @@ -;;;; $Id: protocol.lisp,v 1.14 2003/11/23 22:39:16 eenge Exp $ +;;;; $Id: protocol.lisp,v 1.15 2003/11/23 23:22:19 eenge Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/protocol.lisp,v $ ;;;; See LICENSE for licensing information. @@ -90,6 +90,25 @@ (dolist (hook hooks) (add-hook connection (car hook) (cadr hook))) connection)) + +(defmethod add-default-hooks ((connection connection)) + (dolist (message '(irc-rpl_whoisuser-message + irc-rpl_list-message + irc-rpl_topic-message + irc-rpl_namreply-message + irc-ping-message + irc-join-message + irc-topic-message + irc-ping-message + irc-quit-message + irc-kick-message + irc-nick-message + ctcp-time-message + ctcp-source-message + ctcp-finger-message + ctcp-version-message + ctcp-ping-message)) + (add-hook connection message #'default-hook))) (defmethod client-raw-log ((connection connection) message) (let ((stream (client-stream connection))) From eenge at common-lisp.net Sun Nov 23 23:35:09 2003 From: eenge at common-lisp.net (Erik Enge) Date: Sun, 23 Nov 2003 18:35:09 -0500 Subject: [net-nittin-irc-cvs] CVS update: net-nittin-irc/test/package.lisp Message-ID: Update of /project/net-nittin-irc/cvsroot/net-nittin-irc/test In directory common-lisp.net:/tmp/cvs-serv4453 Modified Files: package.lisp Log Message: adding package nickname Date: Sun Nov 23 18:35:09 2003 Author: eenge Index: net-nittin-irc/test/package.lisp diff -u net-nittin-irc/test/package.lisp:1.1 net-nittin-irc/test/package.lisp:1.2 --- net-nittin-irc/test/package.lisp:1.1 Sun Nov 23 17:40:23 2003 +++ net-nittin-irc/test/package.lisp Sun Nov 23 18:35:09 2003 @@ -1,4 +1,4 @@ -;;;; $Id: package.lisp,v 1.1 2003/11/23 22:40:23 eenge Exp $ +;;;; $Id: package.lisp,v 1.2 2003/11/23 23:35:09 eenge Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/test/package.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -8,4 +8,5 @@ (eval-when (:execute :load-toplevel :compile-toplevel) (defpackage :net-nittin-irc-test (:use :cl :rt) + (:nicknames :nni-test) (:export :do-tests))) From eenge at common-lisp.net Sun Nov 23 23:35:30 2003 From: eenge at common-lisp.net (Erik Enge) Date: Sun, 23 Nov 2003 18:35:30 -0500 Subject: [net-nittin-irc-cvs] CVS update: net-nittin-irc/test/test-parse-message.lisp Message-ID: Update of /project/net-nittin-irc/cvsroot/net-nittin-irc/test In directory common-lisp.net:/tmp/cvs-serv4539 Modified Files: test-parse-message.lisp Log Message: removing #. and adding nni-test:: instead (not using reader) Date: Sun Nov 23 18:35:30 2003 Author: eenge Index: net-nittin-irc/test/test-parse-message.lisp diff -u net-nittin-irc/test/test-parse-message.lisp:1.2 net-nittin-irc/test/test-parse-message.lisp:1.3 --- net-nittin-irc/test/test-parse-message.lisp:1.2 Sun Nov 23 18:06:24 2003 +++ net-nittin-irc/test/test-parse-message.lisp Sun Nov 23 18:35:30 2003 @@ -1,4 +1,4 @@ -;;;; $Id: test-parse-message.lisp,v 1.2 2003/11/23 23:06:24 eenge Exp $ +;;;; $Id: test-parse-message.lisp,v 1.3 2003/11/23 23:35:30 eenge Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/test/test-parse-message.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -14,33 +14,33 @@ (handler-bind ((irc:no-such-reply #'continue)) (irc:find-reply-name 999)) :unknown-reply) -(deftest return-source.1 (irc::return-source #.*msg1*) 5 "kire") -(deftest return-source.2 (irc::return-source #.*msg2*) 21 "tolkien.freenode.net") -(deftest return-source.3 (irc::return-source #.*msg3*) 0 nil) - -(deftest return-user.1 (irc::return-user #.*msg1* :start 5) 12 "~eenge") -(deftest return-user.2 (irc::return-user #.*msg2* :start 21) 21 nil) -(deftest return-user.3 (irc::return-user #.*msg3* :start 0) 0 nil) - -(deftest return-host.1 (irc::return-host #.*msg1* :start 12) 28 "216.248.178.227") -(deftest return-host.2 (irc::return-host #.*msg2* :start 21) 21 nil) -(deftest return-host.3 (irc::return-host #.*msg3* :start 0) 0 nil) - -(deftest return-command.1 (irc::return-command #.*msg1* :start 28) 36 "PRIVMSG") -(deftest return-command.2 (irc::return-command #.*msg2* :start 21) 25 "372") -(deftest return-command.3 (irc::return-command #.*msg3* :start 0) 6 "NOTICE") - -(deftest return-arguments.1 (irc::return-arguments #.*msg1* :start 36) 44 ("cl-irc")) -(deftest return-arguments.2 (irc::return-arguments #.*msg2* :start 25) 33 ("cl-irc")) -(deftest return-arguments.3 (irc::return-arguments #.*msg3* :start 6) 12 ("AUTH")) +(deftest return-source.1 (irc::return-source nni-test::*msg1*) 5 "kire") +(deftest return-source.2 (irc::return-source nni-test::*msg2*) 21 "tolkien.freenode.net") +(deftest return-source.3 (irc::return-source nni-test::*msg3*) 0 nil) + +(deftest return-user.1 (irc::return-user nni-test::*msg1* :start 5) 12 "~eenge") +(deftest return-user.2 (irc::return-user nni-test::*msg2* :start 21) 21 nil) +(deftest return-user.3 (irc::return-user nni-test::*msg3* :start 0) 0 nil) + +(deftest return-host.1 (irc::return-host nni-test::*msg1* :start 12) 28 "216.248.178.227") +(deftest return-host.2 (irc::return-host nni-test::*msg2* :start 21) 21 nil) +(deftest return-host.3 (irc::return-host nni-test::*msg3* :start 0) 0 nil) + +(deftest return-command.1 (irc::return-command nni-test::*msg1* :start 28) 36 "PRIVMSG") +(deftest return-command.2 (irc::return-command nni-test::*msg2* :start 21) 25 "372") +(deftest return-command.3 (irc::return-command nni-test::*msg3* :start 0) 6 "NOTICE") + +(deftest return-arguments.1 (irc::return-arguments nni-test::*msg1* :start 36) 44 ("cl-irc")) +(deftest return-arguments.2 (irc::return-arguments nni-test::*msg2* :start 25) 33 ("cl-irc")) +(deftest return-arguments.3 (irc::return-arguments nni-test::*msg3* :start 6) 12 ("AUTH")) (deftest return-trailing-argument.1 - (irc::return-trailing-argument #.*msg1* :start 44) 52 "heyhey!") + (irc::return-trailing-argument nni-test::*msg1* :start 44) 52 "heyhey!") (deftest return-trailing-argument.2 - (irc::return-trailing-argument #.*msg2* :start 33) 35 "-") + (irc::return-trailing-argument nni-test::*msg2* :start 33) 35 "-") (deftest return-trailing-argument.3 - (irc::return-trailing-argument #.*msg3* :start 12) 57 "*** Your forward and reverse DNS don't match") + (irc::return-trailing-argument nni-test::*msg3* :start 12) 57 "*** Your forward and reverse DNS don't match") (deftest parse-raw-message.1 - (irc::parse-raw-message #.*msg1*) + (irc::parse-raw-message nni-test::*msg1*) "kire" "~eenge" "216.248.178.227" "PRIVMSG" ("cl-irc") "heyhey!") From eenge at common-lisp.net Mon Nov 24 00:24:47 2003 From: eenge at common-lisp.net (Erik Enge) Date: Sun, 23 Nov 2003 19:24:47 -0500 Subject: [net-nittin-irc-cvs] CVS update: Directory change: net-nittin-irc/doc Message-ID: Update of /project/net-nittin-irc/cvsroot/net-nittin-irc/doc In directory common-lisp.net:/tmp/cvs-serv25131/doc Log Message: Directory /project/net-nittin-irc/cvsroot/net-nittin-irc/doc added to the repository Date: Sun Nov 23 19:24:46 2003 Author: eenge New directory net-nittin-irc/doc added From eenge at common-lisp.net Mon Nov 24 00:24:58 2003 From: eenge at common-lisp.net (Erik Enge) Date: Sun, 23 Nov 2003 19:24:58 -0500 Subject: [net-nittin-irc-cvs] CVS update: Directory change: net-nittin-irc/doc/api-doc Message-ID: Update of /project/net-nittin-irc/cvsroot/net-nittin-irc/doc/api-doc In directory common-lisp.net:/tmp/cvs-serv25173/api-doc Log Message: Directory /project/net-nittin-irc/cvsroot/net-nittin-irc/doc/api-doc added to the repository Date: Sun Nov 23 19:24:58 2003 Author: eenge New directory net-nittin-irc/doc/api-doc added From eenge at common-lisp.net Mon Nov 24 00:33:14 2003 From: eenge at common-lisp.net (Erik Enge) Date: Sun, 23 Nov 2003 19:33:14 -0500 Subject: [net-nittin-irc-cvs] CVS update: net-nittin-irc/README Message-ID: Update of /project/net-nittin-irc/cvsroot/net-nittin-irc In directory common-lisp.net:/tmp/cvs-serv28287 Modified Files: README Log Message: move stuff to the user-guide Date: Sun Nov 23 19:33:14 2003 Author: eenge Index: net-nittin-irc/README diff -u net-nittin-irc/README:1.4 net-nittin-irc/README:1.5 --- net-nittin-irc/README:1.4 Sun Nov 23 17:39:15 2003 +++ net-nittin-irc/README Sun Nov 23 19:33:14 2003 @@ -1,39 +1,4 @@ net-nittin-irc: A Common Lisp interface to the client-part of the IRC -protocol; RFCs 2810, 2811 and 2812. - -Quick demo: - - * (require :net-nittin-irc) - - * (in-package :irc) - - * (setf connection (connect :nickname "mynick" - :server "irc.somewhere.org")) - - * (read-message-loop connection) - -That's it. Interrupt the read-message-loop and do: - - * (join connection "#lisp") - -etc. (look at command.lisp) to operate the library. After issuing a -command, you need to get back on the feed: - - * (read-message-loop connection) - -If you need to do something on every join, do: - - * (defun my-hook (message) - ) - - * (add-hook connection 'irc-join-message #'my-hook) - -and it will be run next time the library receives an irc-join-message. -For a full list of messages you can hook into, look at event.lisp. - -Your connection object will get updated by the library with regards to -users joining/parting channels, you joining/parting channels, etc. -Look at protocol.lisp's connection object for slots and methods. - -Erik Enge, erik at nittin.net +protocol; RFCs 2810, 2811 and 2812. See doc/user-guide.txt for more +information. From eenge at common-lisp.net Mon Nov 24 00:35:25 2003 From: eenge at common-lisp.net (Erik Enge) Date: Sun, 23 Nov 2003 19:35:25 -0500 Subject: [net-nittin-irc-cvs] CVS update: net-nittin-irc/doc/rfc2810.txt net-nittin-irc/doc/rfc2811.txt net-nittin-irc/doc/rfc2812.txt net-nittin-irc/doc/rfc2813.txt net-nittin-irc/doc/user-guide.txt Message-ID: Update of /project/net-nittin-irc/cvsroot/net-nittin-irc/doc In directory common-lisp.net:/tmp/cvs-serv29534 Added Files: rfc2810.txt rfc2811.txt rfc2812.txt rfc2813.txt user-guide.txt Log Message: adding docs Date: Sun Nov 23 19:35:24 2003 Author: eenge From eenge at common-lisp.net Mon Nov 24 00:42:53 2003 From: eenge at common-lisp.net (Erik Enge) Date: Sun, 23 Nov 2003 19:42:53 -0500 Subject: [net-nittin-irc-cvs] CVS update: net-nittin-irc/protocol.lisp Message-ID: Update of /project/net-nittin-irc/cvsroot/net-nittin-irc In directory common-lisp.net:/tmp/cvs-serv32354 Modified Files: protocol.lisp Log Message: adding some more docstrings Date: Sun Nov 23 19:42:53 2003 Author: eenge Index: net-nittin-irc/protocol.lisp diff -u net-nittin-irc/protocol.lisp:1.15 net-nittin-irc/protocol.lisp:1.16 --- net-nittin-irc/protocol.lisp:1.15 Sun Nov 23 18:22:19 2003 +++ net-nittin-irc/protocol.lisp Sun Nov 23 19:42:53 2003 @@ -1,4 +1,4 @@ -;;;; $Id: protocol.lisp,v 1.15 2003/11/23 23:22:19 eenge Exp $ +;;;; $Id: protocol.lisp,v 1.16 2003/11/24 00:42:53 eenge Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/protocol.lisp,v $ ;;;; See LICENSE for licensing information. @@ -157,7 +157,9 @@ message)) (defmethod send-irc-message ((connection connection) command - trailing-argument &rest arguments) + trailing-argument &rest arguments) + "Turn the arguments into a valid IRC message and send it to the +server, via the `connection'." (let ((raw-message (make-irc-message command :arguments arguments :trailing-argument trailing-argument))) @@ -166,6 +168,7 @@ raw-message)) (defmethod all-users ((connection connection)) + "Return all users known the `connection'." (let ((user-list (dangling-users connection))) (push (user connection) user-list) (dolist (channel (channels connection)) @@ -175,23 +178,29 @@ (remove-duplicates user-list))) (defmethod all-channels ((connection connection)) + "Return a list of all channels known to the `connection'. Note that +this includes any channels found by listing channels." (let ((channel-list (channel-list connection))) (dolist (channel (channels connection)) (push channel channel-list)) channel-list)) (defmethod get-hooks ((connection connection) (class symbol)) + "Return a list of all hooks for `class'." (gethash class (hooks connection))) (defmethod add-hook ((connection connection) class hook) + "Add `hook' to `class'." (setf (gethash class (hooks connection)) (pushnew hook (gethash class (hooks connection))))) (defmethod remove-hook ((connection connection) class hook) + "Remove `hook' from `class'." (setf (gethash class (hooks connection)) (delete hook (gethash class (hooks connection))))) (defmethod remove-hooks ((connection connection) class) + "Remove all hooks for `class'." (setf (gethash class (hooks connection)) nil)) ;; @@ -314,18 +323,24 @@ channel)) (defmethod find-channel ((connection connection) (channel string)) + "Return channel as designated by `channel'. If no such channel can +be found, return nil." (find channel (all-channels connection) :key #'name :test #'string-equal)) (defmethod remove-all-channels ((connection connection)) + "Remove all channels known to `connection'." (setf (channels connection) nil)) (defmethod add-channel ((connection connection) (channel channel)) + "Add `channel' to `connection'." (pushnew channel (channels connection))) (defmethod remove-channel ((connection connection) (channel channel)) + "Remove `channel' from `connection'." (setf (channels connection) (remove channel (channels connection)))) (defmethod remove-users ((channel channel)) + "Remove all users on `channel'." (clrhash (users channel))) ;; @@ -375,22 +390,29 @@ nickname)) (defmethod find-user ((connection connection) (nickname string)) + "Return user as designated by `nickname' or nil if no such user is +known." (find nickname (all-users connection) :key #'nickname :test #'string-equal)) (defmethod add-user ((connection connection) (user user)) + "Add `user' to `connection'." (pushnew user (dangling-users connection))) (defmethod add-user ((channel channel) (user user)) + "Add `user' to `channel'." (setf (gethash (nickname user) (users channel)) user)) (defmethod remove-all-users ((connection connection)) + "Remove all users known to `connection'." (setf (dangling-users connection) nil) (mapc #'remove-users (channels connection))) (defmethod remove-user ((channel channel) (user user)) + "Remove `user' from `channel'." (remhash (nickname user) (users channel))) (defmethod remove-user-everywhere ((connection connection) (user user)) + "Remove `user' anywhere present in the `connection'." (dolist (channel (channels connection)) (remove-user channel user))) From eenge at common-lisp.net Mon Nov 24 03:16:26 2003 From: eenge at common-lisp.net (Erik Enge) Date: Sun, 23 Nov 2003 22:16:26 -0500 Subject: [net-nittin-irc-cvs] CVS update: net-nittin-irc/protocol.lisp Message-ID: Update of /project/net-nittin-irc/cvsroot/net-nittin-irc In directory common-lisp.net:/tmp/cvs-serv2457 Modified Files: protocol.lisp Log Message: find-user now respects: Because of IRC's Scandinavian origin, the characters {}|^ are considered to be the lower case equivalents of the characters []\~, respectively. This is a critical issue when determining the equivalence of two nicknames or channel names. Date: Sun Nov 23 22:16:26 2003 Author: eenge Index: net-nittin-irc/protocol.lisp diff -u net-nittin-irc/protocol.lisp:1.16 net-nittin-irc/protocol.lisp:1.17 --- net-nittin-irc/protocol.lisp:1.16 Sun Nov 23 19:42:53 2003 +++ net-nittin-irc/protocol.lisp Sun Nov 23 22:16:26 2003 @@ -1,4 +1,4 @@ -;;;; $Id: protocol.lisp,v 1.16 2003/11/24 00:42:53 eenge Exp $ +;;;; $Id: protocol.lisp,v 1.17 2003/11/24 03:16:26 eenge Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/protocol.lisp,v $ ;;;; See LICENSE for licensing information. @@ -389,10 +389,24 @@ (subseq nickname 1) nickname)) +;; oh, what a terrible operator name +(defun irc-nick-mangle (string) + (let* ((new-string (substitute #\[ #\{ string)) + (new-string (substitute #\] #\} new-string)) + (new-string (substitute #\\ #\| new-string)) + (new-string (substitute #\~ #\^ new-string))) + new-string)) + +;; ditto +(defun irc-nick-equal (string1 string2) + "Return t if `string1' and `string2' are equal as far as nickname +rules in IRC goes." + (string-equal (irc-nick-mangle string1) (irc-nick-mangle string2))) + (defmethod find-user ((connection connection) (nickname string)) "Return user as designated by `nickname' or nil if no such user is known." - (find nickname (all-users connection) :key #'nickname :test #'string-equal)) + (find nickname (all-users connection) :key #'nickname :test #'irc-nick-equal)) (defmethod add-user ((connection connection) (user user)) "Add `user' to `connection'." From eenge at common-lisp.net Mon Nov 24 03:16:50 2003 From: eenge at common-lisp.net (Erik Enge) Date: Sun, 23 Nov 2003 22:16:50 -0500 Subject: [net-nittin-irc-cvs] CVS update: net-nittin-irc/TODO Message-ID: Update of /project/net-nittin-irc/cvsroot/net-nittin-irc In directory common-lisp.net:/tmp/cvs-serv2530 Modified Files: TODO Log Message: removed issue from TODO (the one about lowercase equivalents of irc nicks) Date: Sun Nov 23 22:16:50 2003 Author: eenge Index: net-nittin-irc/TODO diff -u net-nittin-irc/TODO:1.7 net-nittin-irc/TODO:1.8 --- net-nittin-irc/TODO:1.7 Fri Nov 14 11:13:21 2003 +++ net-nittin-irc/TODO Sun Nov 23 22:16:49 2003 @@ -3,15 +3,6 @@ - Add DCC - - From RFC 2812: - - Because of IRC's Scandinavian origin, the characters {}|^ are - considered to be the lower case equivalents of the characters - []\~, respectively. This is a critical issue when determining the - equivalence of two nicknames or channel names. - - So when we do FIND-USER etc. we need to be mindful of this fact. - - Need to optimize the user approach. When joining ten high-volume (2000+ users total) channels there seems to be O(n) or somesuch performance because of, I'm guessing, the way FIND-USER works. From eenge at common-lisp.net Mon Nov 24 21:30:15 2003 From: eenge at common-lisp.net (Erik Enge) Date: Mon, 24 Nov 2003 16:30:15 -0500 Subject: [net-nittin-irc-cvs] CVS update: net-nittin-irc/TODO net-nittin-irc/event.lisp net-nittin-irc/protocol.lisp Message-ID: Update of /project/net-nittin-irc/cvsroot/net-nittin-irc In directory common-lisp.net:/tmp/cvs-serv17874 Modified Files: TODO event.lisp protocol.lisp Log Message: find-user is now very fast, comparatively speaking however it came at the sacrifice of nickname-equalness being broken for now. will think of a fix later. Date: Mon Nov 24 16:30:12 2003 Author: eenge Index: net-nittin-irc/TODO diff -u net-nittin-irc/TODO:1.8 net-nittin-irc/TODO:1.9 --- net-nittin-irc/TODO:1.8 Sun Nov 23 22:16:49 2003 +++ net-nittin-irc/TODO Mon Nov 24 16:30:11 2003 @@ -3,12 +3,15 @@ - Add DCC - - Need to optimize the user approach. When joining ten high-volume - (2000+ users total) channels there seems to be O(n) or somesuch - performance because of, I'm guessing, the way FIND-USER works. + - I would really like usocket first - If a message (as in PRIVMSG) is longer than 512 characters (including carriage return and linefeed) we should probably split the message into several on behalf of the user. + - should send-irc-message automatically do this for you? + - Add ignore + + - During find-user optimization, I broke with irc-nick-equal for + nicknames in find-user. Index: net-nittin-irc/event.lisp diff -u net-nittin-irc/event.lisp:1.10 net-nittin-irc/event.lisp:1.11 --- net-nittin-irc/event.lisp:1.10 Sun Nov 23 18:21:38 2003 +++ net-nittin-irc/event.lisp Mon Nov 24 16:30:11 2003 @@ -1,4 +1,4 @@ -;;;; $Id: event.lisp,v 1.10 2003/11/23 23:21:38 eenge Exp $ +;;;; $Id: event.lisp,v 1.11 2003/11/24 21:30:11 eenge Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/event.lisp,v $ ;;;; See LICENSE for licensing information. @@ -33,7 +33,7 @@ (make-channel :name channel :topic topic :user-count user-count)) - (channel-list connection)))) + (channels connection)))) (defmethod default-hook ((message irc-rpl_topic-message)) (setf (topic (find-channel (connection message) @@ -41,13 +41,15 @@ (trailing-argument message))) (defmethod default-hook ((message irc-rpl_namreply-message)) - (let ((channel (find-channel (connection message) (car (last (arguments message)))))) + (let* ((connection (connection message)) + (channel (find-channel connection (car (last (arguments message)))))) (dolist (nickname (tokenize-string (trailing-argument message))) - (add-user channel - (find-or-make-user (connection message) - (canonicalize-nickname nickname) - :username (user message) - :hostname (host message)))))) + (let ((user (find-or-make-user connection + (canonicalize-nickname nickname) + :username (user message) + :hostname (host message)))) + (unless (equal user (user connection)) + (add-user connection channel user)))))) (defmethod default-hook ((message irc-ping-message)) (pong (connection message) (trailing-argument message))) @@ -63,7 +65,7 @@ (make-channel :name (trailing-argument message))))) (if (self-message-p message) (add-channel connection channel) - (add-user channel user)))) + (add-user connection channel user)))) (defmethod default-hook ((message irc-topic-message)) (setf (topic (find-channel (connection message) @@ -75,7 +77,7 @@ (channel (find-channel connection (first (arguments message)))) (user (find-user connection (source message)))) (if (self-message-p message) - (remove-channel connection channel) + (remove-channel channel user) (remove-user channel user)))) (defmethod default-hook ((message irc-quit-message)) @@ -98,7 +100,7 @@ (channel (find-channel connection (first (arguments message)))) (user (find-user connection (second (arguments message))))) (if (self-message-p message) - (remove-channel connection channel) + (remove-channel channel user) (remove-user channel user)))) (defmethod default-hook ((message ctcp-time-message)) Index: net-nittin-irc/protocol.lisp diff -u net-nittin-irc/protocol.lisp:1.17 net-nittin-irc/protocol.lisp:1.18 --- net-nittin-irc/protocol.lisp:1.17 Sun Nov 23 22:16:26 2003 +++ net-nittin-irc/protocol.lisp Mon Nov 24 16:30:11 2003 @@ -1,4 +1,4 @@ -;;;; $Id: protocol.lisp,v 1.17 2003/11/24 03:16:26 eenge Exp $ +;;;; $Id: protocol.lisp,v 1.18 2003/11/24 21:30:11 eenge Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/protocol.lisp,v $ ;;;; See LICENSE for licensing information. @@ -20,6 +20,7 @@ ;; Connection ;; + (defclass connection () ((user :initarg :user @@ -46,23 +47,14 @@ :initarg :channels :accessor channels :initform nil) - (channel-list - :initarg :channel-list - :accessor channel-list - :initform nil - :documentation "A list of channels known to this server as -recorded by the LIST command.") (hooks :initarg :hooks :accessor hooks :initform (make-hash-table :test #'equal)) - (dangling-users - :initarg :dangling-users - :accessor dangling-users - :initform nil - :documentation "A list of all users we currently know of which are -not associated with a given channel. There are no provisions given -for making sure that these users actually are online."))) + (users + :initarg :users + :accessor users + :initform (make-hash-table :test #'equal)))) (defmethod print-object ((object connection) stream) "Print the object for the Lisp reader." @@ -74,19 +66,13 @@ (server-socket nil) (server-stream nil) (client-stream t) - (channels nil) - (dangling-users nil) - (hooks nil) - (channel-list nil)) + (hooks nil)) (let ((connection (make-instance 'connection :user user :server-name server-name :server-socket server-socket :server-stream server-stream - :client-stream client-stream - :channels channels - :dangling-users dangling-users - :channel-list channel-list))) + :client-stream client-stream))) (dolist (hook hooks) (add-hook connection (car hook) (cadr hook))) connection)) @@ -99,7 +85,7 @@ irc-ping-message irc-join-message irc-topic-message - irc-ping-message + irc-part-message irc-quit-message irc-kick-message irc-nick-message @@ -167,24 +153,6 @@ (force-output (server-stream connection)) raw-message)) -(defmethod all-users ((connection connection)) - "Return all users known the `connection'." - (let ((user-list (dangling-users connection))) - (push (user connection) user-list) - (dolist (channel (channels connection)) - (maphash #'(lambda (key value) - (declare (ignore key)) - (push value user-list)) (users channel))) - (remove-duplicates user-list))) - -(defmethod all-channels ((connection connection)) - "Return a list of all channels known to the `connection'. Note that -this includes any channels found by listing channels." - (let ((channel-list (channel-list connection))) - (dolist (channel (channels connection)) - (push channel channel-list)) - channel-list)) - (defmethod get-hooks ((connection connection) (class symbol)) "Return a list of all hooks for `class'." (gethash class (hooks connection))) @@ -203,6 +171,9 @@ "Remove all hooks for `class'." (setf (gethash class (hooks connection)) nil)) +(defmethod remove-all-hooks ((connection connection)) + (clrhash (hooks connection))) + ;; ;; DCC Connection ;; @@ -325,7 +296,7 @@ (defmethod find-channel ((connection connection) (channel string)) "Return channel as designated by `channel'. If no such channel can be found, return nil." - (find channel (all-channels connection) :key #'name :test #'string-equal)) + (find channel (channels connection) :key #'name :test #'string-equal)) (defmethod remove-all-channels ((connection connection)) "Remove all channels known to `connection'." @@ -363,7 +334,11 @@ (realname :initarg :realname :accessor realname - :initform ""))) + :initform "") + (channels + :initarg :channels + :accessor channels + :initform nil))) (defmethod print-object ((object user) stream) "Print the object for the Lisp reader." @@ -403,32 +378,40 @@ rules in IRC goes." (string-equal (irc-nick-mangle string1) (irc-nick-mangle string2))) +;; this is broken. we should use #'irc-nick-equal somehow. (defmethod find-user ((connection connection) (nickname string)) "Return user as designated by `nickname' or nil if no such user is known." - (find nickname (all-users connection) :key #'nickname :test #'irc-nick-equal)) - -(defmethod add-user ((connection connection) (user user)) - "Add `user' to `connection'." - (pushnew user (dangling-users connection))) - -(defmethod add-user ((channel channel) (user user)) - "Add `user' to `channel'." - (setf (gethash (nickname user) (users channel)) user)) + (or (gethash nickname (users connection)) + (when (string= nickname (nickname (user connection))) + (user connection)))) + +; what if the user is not on any channels? +(defmethod add-user ((connection connection) (channel channel) (user user)) + "Add `user' to `channel' and `channel' to `user'." + (setf (gethash (nickname user) (users channel)) user) + (pushnew channel (channels user)) + (setf (gethash (nickname user) (users connection)) user)) (defmethod remove-all-users ((connection connection)) "Remove all users known to `connection'." - (setf (dangling-users connection) nil) + (setf (users connection) nil) (mapc #'remove-users (channels connection))) (defmethod remove-user ((channel channel) (user user)) - "Remove `user' from `channel'." - (remhash (nickname user) (users channel))) + "Remove `user' from `channel' and `channel' from `user'." + (remhash (nickname user) (users channel)) + (setf (channels user) (remove channel (channels user)))) + +(defmethod remove-channel ((channel channel) (user user)) + "Remove `channel' from `user'." + (setf (channels user) (remove channel (channels user)))) (defmethod remove-user-everywhere ((connection connection) (user user)) "Remove `user' anywhere present in the `connection'." - (dolist (channel (channels connection)) - (remove-user channel user))) + (dolist (channel (channels user)) + (remove-user channel user)) + (remhash (nickname user) (users connection))) (defmethod find-or-make-user ((connection connection) nickname &key (username "") (hostname "") (realname "")) @@ -442,9 +425,9 @@ (dolist (channel (channels connection)) (let ((old-user (gethash (nickname user) (users channel)))) (when old-user - (remhash (nickname user) (users channel)) + (remove-user channel user) (setf (nickname user) new-nickname) - (add-user channel user)))) + (add-user connection channel user)))) (when (equal user (user connection)) (setf (nickname user) new-nickname))) From eenge at common-lisp.net Mon Nov 24 21:56:49 2003 From: eenge at common-lisp.net (Erik Enge) Date: Mon, 24 Nov 2003 16:56:49 -0500 Subject: [net-nittin-irc-cvs] CVS update: net-nittin-irc/TODO net-nittin-irc/protocol.lisp Message-ID: Update of /project/net-nittin-irc/cvsroot/net-nittin-irc In directory common-lisp.net:/tmp/cvs-serv30304 Modified Files: TODO protocol.lisp Log Message: fixing find-user problem Date: Mon Nov 24 16:56:49 2003 Author: eenge Index: net-nittin-irc/TODO diff -u net-nittin-irc/TODO:1.9 net-nittin-irc/TODO:1.10 --- net-nittin-irc/TODO:1.9 Mon Nov 24 16:30:11 2003 +++ net-nittin-irc/TODO Mon Nov 24 16:56:49 2003 @@ -12,6 +12,3 @@ - should send-irc-message automatically do this for you? - Add ignore - - - During find-user optimization, I broke with irc-nick-equal for - nicknames in find-user. Index: net-nittin-irc/protocol.lisp diff -u net-nittin-irc/protocol.lisp:1.18 net-nittin-irc/protocol.lisp:1.19 --- net-nittin-irc/protocol.lisp:1.18 Mon Nov 24 16:30:11 2003 +++ net-nittin-irc/protocol.lisp Mon Nov 24 16:56:49 2003 @@ -1,4 +1,4 @@ -;;;; $Id: protocol.lisp,v 1.18 2003/11/24 21:30:11 eenge Exp $ +;;;; $Id: protocol.lisp,v 1.19 2003/11/24 21:56:49 eenge Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/protocol.lisp,v $ ;;;; See LICENSE for licensing information. @@ -323,6 +323,10 @@ :initarg :nickname :accessor nickname :initform "") + (normalized-nickname + :initarg :normalized-nickname + :accessor normalized-nickname + :initform "") (username :initarg :username :accessor username @@ -355,6 +359,7 @@ (realname "")) (make-instance 'user :nickname nickname + :normalized-nickname (normalize-nickname nickname) :username username :hostname hostname :realname realname)) @@ -365,33 +370,28 @@ nickname)) ;; oh, what a terrible operator name -(defun irc-nick-mangle (string) +(defun normalize-nickname (string) (let* ((new-string (substitute #\[ #\{ string)) (new-string (substitute #\] #\} new-string)) (new-string (substitute #\\ #\| new-string)) (new-string (substitute #\~ #\^ new-string))) - new-string)) - -;; ditto -(defun irc-nick-equal (string1 string2) - "Return t if `string1' and `string2' are equal as far as nickname -rules in IRC goes." - (string-equal (irc-nick-mangle string1) (irc-nick-mangle string2))) + (string-downcase string))) ;; this is broken. we should use #'irc-nick-equal somehow. (defmethod find-user ((connection connection) (nickname string)) "Return user as designated by `nickname' or nil if no such user is known." - (or (gethash nickname (users connection)) - (when (string= nickname (nickname (user connection))) - (user connection)))) + (let ((nickname (normalize-nickname nickname))) + (or (gethash nickname (users connection)) + (when (string= nickname (nickname (user connection))) + (user connection))))) ; what if the user is not on any channels? (defmethod add-user ((connection connection) (channel channel) (user user)) "Add `user' to `channel' and `channel' to `user'." - (setf (gethash (nickname user) (users channel)) user) + (setf (gethash (normalized-nickname user) (users channel)) user) (pushnew channel (channels user)) - (setf (gethash (nickname user) (users connection)) user)) + (setf (gethash (normalized-nickname user) (users connection)) user)) (defmethod remove-all-users ((connection connection)) "Remove all users known to `connection'." @@ -400,7 +400,7 @@ (defmethod remove-user ((channel channel) (user user)) "Remove `user' from `channel' and `channel' from `user'." - (remhash (nickname user) (users channel)) + (remhash (normalized-nickname user) (users channel)) (setf (channels user) (remove channel (channels user)))) (defmethod remove-channel ((channel channel) (user user)) @@ -411,7 +411,7 @@ "Remove `user' anywhere present in the `connection'." (dolist (channel (channels user)) (remove-user channel user)) - (remhash (nickname user) (users connection))) + (remhash (normalized-nickname user) (users connection))) (defmethod find-or-make-user ((connection connection) nickname &key (username "") (hostname "") (realname "")) @@ -422,14 +422,7 @@ :realname realname))) (defmethod change-nickname ((connection connection) (user user) new-nickname) - (dolist (channel (channels connection)) - (let ((old-user (gethash (nickname user) (users channel)))) - (when old-user - (remove-user channel user) - (setf (nickname user) new-nickname) - (add-user connection channel user)))) - (when (equal user (user connection)) - (setf (nickname user) new-nickname))) + (setf (nickname user) new-nickname)) ;; IRC Message ;; From eenge at common-lisp.net Mon Nov 24 22:12:21 2003 From: eenge at common-lisp.net (Erik Enge) Date: Mon, 24 Nov 2003 17:12:21 -0500 Subject: [net-nittin-irc-cvs] CVS update: net-nittin-irc/TODO Message-ID: Update of /project/net-nittin-irc/cvsroot/net-nittin-irc In directory common-lisp.net:/tmp/cvs-serv10444 Modified Files: TODO Log Message: adding comment about inconsistent servers Date: Mon Nov 24 17:12:20 2003 Author: eenge Index: net-nittin-irc/TODO diff -u net-nittin-irc/TODO:1.10 net-nittin-irc/TODO:1.11 --- net-nittin-irc/TODO:1.10 Mon Nov 24 16:56:49 2003 +++ net-nittin-irc/TODO Mon Nov 24 17:12:20 2003 @@ -12,3 +12,7 @@ - should send-irc-message automatically do this for you? - Add ignore + + - Document inconsistencies between IRC servers (ref. undernet + servers send out channel name in arguments rather than + trailing-messages on a part/quit message) From eenge at common-lisp.net Tue Nov 25 03:10:53 2003 From: eenge at common-lisp.net (Erik Enge) Date: Mon, 24 Nov 2003 22:10:53 -0500 Subject: [net-nittin-irc-cvs] CVS update: net-nittin-irc/test/test-parse-message.lisp Message-ID: Update of /project/net-nittin-irc/cvsroot/net-nittin-irc/test In directory common-lisp.net:/tmp/cvs-serv13545 Modified Files: test-parse-message.lisp Log Message: adding more tests to capture MODE messages and correct argument parsing Date: Mon Nov 24 22:10:52 2003 Author: eenge Index: net-nittin-irc/test/test-parse-message.lisp diff -u net-nittin-irc/test/test-parse-message.lisp:1.3 net-nittin-irc/test/test-parse-message.lisp:1.4 --- net-nittin-irc/test/test-parse-message.lisp:1.3 Sun Nov 23 18:35:30 2003 +++ net-nittin-irc/test/test-parse-message.lisp Mon Nov 24 22:10:52 2003 @@ -1,4 +1,4 @@ -;;;; $Id: test-parse-message.lisp,v 1.3 2003/11/23 23:35:30 eenge Exp $ +;;;; $Id: test-parse-message.lisp,v 1.4 2003/11/25 03:10:52 eenge Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/test/test-parse-message.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -7,7 +7,9 @@ (defvar *msg1* (format nil ":kire!~~eenge at 216.248.178.227 PRIVMSG cl-irc :heyhey!~A" #\Return)) (defvar *msg2* (format nil ":tolkien.freenode.net 372 cl-irc :-~A" #\Return)) -(defvar *msg3* (format nil "NOTICE AUTH :*** Your forward and reverse DNS don't match~A" #\return)) +(defvar *msg3* (format nil "NOTICE AUTH :*** Your forward and reverse DNS don't match~A" #\Return)) +(defvar *msg4* (format nil ":kire_!~~eenge at adsl-156-35-240.asm.bellsouth.net MODE #lisppaste +k key~A" #\Return)) +(defvar *msg5* (format nil ":kire_!~~eenge at adsl-156-35-240.asm.bellsouth.net MODE #lisppaste +bbb *!*@somewhere.com *!*@somewhereles.com *!*@youdontwannaknow.org~A" #\Return)) (deftest find-reply-name.1 (irc:find-reply-name 1) :rpl_welcome) (deftest find-reply-name.2 @@ -17,22 +19,32 @@ (deftest return-source.1 (irc::return-source nni-test::*msg1*) 5 "kire") (deftest return-source.2 (irc::return-source nni-test::*msg2*) 21 "tolkien.freenode.net") (deftest return-source.3 (irc::return-source nni-test::*msg3*) 0 nil) +(deftest return-source.4 (irc::return-source nni-test::*msg4*) 6 "kire_") +(deftest return-source.5 (irc::return-source nni-test::*msg5*) 6 "kire_") (deftest return-user.1 (irc::return-user nni-test::*msg1* :start 5) 12 "~eenge") (deftest return-user.2 (irc::return-user nni-test::*msg2* :start 21) 21 nil) (deftest return-user.3 (irc::return-user nni-test::*msg3* :start 0) 0 nil) +(deftest return-user.4 (irc::return-user nni-test::*msg4* :start 6) 13 "~eenge") +(deftest return-user.5 (irc::return-user nni-test::*msg5* :start 6) 13 "~eenge") (deftest return-host.1 (irc::return-host nni-test::*msg1* :start 12) 28 "216.248.178.227") (deftest return-host.2 (irc::return-host nni-test::*msg2* :start 21) 21 nil) (deftest return-host.3 (irc::return-host nni-test::*msg3* :start 0) 0 nil) +(deftest return-host.4 (irc::return-host nni-test::*msg4* :start 13) 47 "adsl-156-35-240.asm.bellsouth.net") +(deftest return-host.5 (irc::return-host nni-test::*msg5* :start 13) 47 "adsl-156-35-240.asm.bellsouth.net") (deftest return-command.1 (irc::return-command nni-test::*msg1* :start 28) 36 "PRIVMSG") (deftest return-command.2 (irc::return-command nni-test::*msg2* :start 21) 25 "372") (deftest return-command.3 (irc::return-command nni-test::*msg3* :start 0) 6 "NOTICE") +(deftest return-command.4 (irc::return-command nni-test::*msg4* :start 47) 52 "MODE") +(deftest return-command.5 (irc::return-command nni-test::*msg5* :start 47) 52 "MODE") (deftest return-arguments.1 (irc::return-arguments nni-test::*msg1* :start 36) 44 ("cl-irc")) (deftest return-arguments.2 (irc::return-arguments nni-test::*msg2* :start 25) 33 ("cl-irc")) (deftest return-arguments.3 (irc::return-arguments nni-test::*msg3* :start 6) 12 ("AUTH")) +(deftest return-arguments.4 (irc::return-arguments nni-test::*msg4* :start 52) 70 ("#lisppaste" "+k" "key")) +(deftest return-arguments.5 (irc::return-arguments nni-test::*msg5* :start 52) 132 ("#lisppaste" "+bbb" "*!*@somewhere.com" "*!*@somewhereles.com" "*!*@youdontwannaknow.org")) (deftest return-trailing-argument.1 (irc::return-trailing-argument nni-test::*msg1* :start 44) 52 "heyhey!") @@ -40,6 +52,10 @@ (irc::return-trailing-argument nni-test::*msg2* :start 33) 35 "-") (deftest return-trailing-argument.3 (irc::return-trailing-argument nni-test::*msg3* :start 12) 57 "*** Your forward and reverse DNS don't match") +(deftest return-trailing-argument.4 + (irc::return-trailing-argument nni-test::*msg4* :start 70) 70 nil) +(deftest return-trailing-argument.5 + (irc::return-trailing-argument nni-test::*msg5* :start 132) 132 nil) (deftest parse-raw-message.1 (irc::parse-raw-message nni-test::*msg1*) From eenge at common-lisp.net Tue Nov 25 03:11:33 2003 From: eenge at common-lisp.net (Erik Enge) Date: Mon, 24 Nov 2003 22:11:33 -0500 Subject: [net-nittin-irc-cvs] CVS update: net-nittin-irc/test/irc-messages.txt Message-ID: Update of /project/net-nittin-irc/cvsroot/net-nittin-irc/test In directory common-lisp.net:/tmp/cvs-serv13660 Modified Files: irc-messages.txt Log Message: adding more test messages Date: Mon Nov 24 22:11:33 2003 Author: eenge Index: net-nittin-irc/test/irc-messages.txt diff -u net-nittin-irc/test/irc-messages.txt:1.1 net-nittin-irc/test/irc-messages.txt:1.2 --- net-nittin-irc/test/irc-messages.txt:1.1 Fri Nov 7 08:43:53 2003 +++ net-nittin-irc/test/irc-messages.txt Mon Nov 24 22:11:27 2003 @@ -1 +1 @@ -NOTICE AUTH :*** Your forward and reverse DNS don't match :tolkien.freenode.net 376 cl-irc :End of /MOTD command. :tolkien.freenode.net 372 cl-irc :- :leguin.freenode.net 353 cl-irc = #lisppaste :cl-irc kire :cl-irc!~cl-irc at 216.248.178.227 JOIN :#lisppaste :kire!~eenge at 216.248.178.227 PRIVMSG cl-irc :heyhey! \ No newline at end of file +NOTICE AUTH :*** Your forward and reverse DNS don't match :tolkien.freenode.net 376 cl-irc :End of /MOTD command. :tolkien.freenode.net 372 cl-irc :- :leguin.freenode.net 353 cl-irc = #lisppaste :cl-irc kire :cl-irc!~cl-irc at 216.248.178.227 JOIN :#lisppaste :kire!~eenge at 216.248.178.227 PRIVMSG cl-irc :heyhey! :kire_!~eenge at adsl-156-35-240.asm.bellsouth.net MODE #lisppaste +b *!*@somewhere.com :kire_!~eenge at adsl-156-35-240.asm.bellsouth.net MODE #lisppaste +bbb *!*@somewhere.com *!*@somewhereles.com *!*@youdontwannaknow.org :kire_!~eenge at adsl-156-35-240.asm.bellsouth.net MODE #lisppaste -m :kire_!~eenge at adsl-156-35-240.asm.bellsouth.net MODE #lisppaste +k key \ No newline at end of file From eenge at common-lisp.net Tue Nov 25 03:12:02 2003 From: eenge at common-lisp.net (Erik Enge) Date: Mon, 24 Nov 2003 22:12:02 -0500 Subject: [net-nittin-irc-cvs] CVS update: net-nittin-irc/parse-message.lisp Message-ID: Update of /project/net-nittin-irc/cvsroot/net-nittin-irc In directory common-lisp.net:/tmp/cvs-serv13779 Modified Files: parse-message.lisp Log Message: return-arguments now parses arguments-lists of MODE messages properly Date: Mon Nov 24 22:12:01 2003 Author: eenge Index: net-nittin-irc/parse-message.lisp diff -u net-nittin-irc/parse-message.lisp:1.6 net-nittin-irc/parse-message.lisp:1.7 --- net-nittin-irc/parse-message.lisp:1.6 Sun Nov 23 17:39:16 2003 +++ net-nittin-irc/parse-message.lisp Mon Nov 24 22:12:00 2003 @@ -1,4 +1,4 @@ -;;;; $Id: parse-message.lisp,v 1.6 2003/11/23 22:39:16 eenge Exp $ +;;;; $Id: parse-message.lisp,v 1.7 2003/11/25 03:12:00 eenge Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/parse-message.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -50,7 +50,7 @@ arguments part of the message as a list. Returns nil if the arguments part is not present." (multiple-value-bind (end-position return-argument) - (cut-between string nil '(#\:) :start start) + (cut-between string nil '(#\: #\Return) :start start) (values end-position (tokenize-string return-argument :delimiters '(#\Space))))) From eenge at common-lisp.net Tue Nov 25 03:35:56 2003 From: eenge at common-lisp.net (Erik Enge) Date: Mon, 24 Nov 2003 22:35:56 -0500 Subject: [net-nittin-irc-cvs] CVS update: net-nittin-irc/event.lisp net-nittin-irc/package.lisp net-nittin-irc/protocol.lisp Message-ID: Update of /project/net-nittin-irc/cvsroot/net-nittin-irc In directory common-lisp.net:/tmp/cvs-serv23681 Modified Files: event.lisp package.lisp protocol.lisp Log Message: (channels connection) is now a hash-table and the LIST- command is fairly efficient. now normalizing channel-names and cleaned up some other minor things (all-users and all-channels no longer used). Date: Mon Nov 24 22:35:55 2003 Author: eenge Index: net-nittin-irc/event.lisp diff -u net-nittin-irc/event.lisp:1.11 net-nittin-irc/event.lisp:1.12 --- net-nittin-irc/event.lisp:1.11 Mon Nov 24 16:30:11 2003 +++ net-nittin-irc/event.lisp Mon Nov 24 22:35:55 2003 @@ -1,4 +1,4 @@ -;;;; $Id: event.lisp,v 1.11 2003/11/24 21:30:11 eenge Exp $ +;;;; $Id: event.lisp,v 1.12 2003/11/25 03:35:55 eenge Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/event.lisp,v $ ;;;; See LICENSE for licensing information. @@ -29,11 +29,10 @@ (channel (second (arguments message))) (user-count (parse-integer (or (third (arguments message)) "0"))) (topic (trailing-argument message))) - (pushnew (or (find-channel connection channel) - (make-channel :name channel - :topic topic - :user-count user-count)) - (channels connection)))) + (add-channel connection (or (find-channel connection channel) + (make-channel :name channel + :topic topic + :user-count user-count))))) (defmethod default-hook ((message irc-rpl_topic-message)) (setf (topic (find-channel (connection message) Index: net-nittin-irc/package.lisp diff -u net-nittin-irc/package.lisp:1.10 net-nittin-irc/package.lisp:1.11 --- net-nittin-irc/package.lisp:1.10 Sun Nov 23 18:06:13 2003 +++ net-nittin-irc/package.lisp Mon Nov 24 22:35:55 2003 @@ -1,10 +1,11 @@ -;;;; $Id: package.lisp,v 1.10 2003/11/23 23:06:13 eenge Exp $ +;;;; $Id: package.lisp,v 1.11 2003/11/25 03:35:55 eenge Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/package.lisp,v $ ;;;; See the LICENSE file for licensing information. (in-package :cl-user) +;; the exports list needs some cleanup/clarification/categorization (eval-when (:execute :load-toplevel :compile-toplevel) (defpackage :net-nittin-irc (:use :cl) @@ -16,12 +17,12 @@ :server-name :no-such-reply :parse-raw-message + :normalize-nickname + :normalize-channel-name :server-stream :client-stream :channels :configuration - :all-users - :all-channels :dangling-users :channel-list :add-hook Index: net-nittin-irc/protocol.lisp diff -u net-nittin-irc/protocol.lisp:1.19 net-nittin-irc/protocol.lisp:1.20 --- net-nittin-irc/protocol.lisp:1.19 Mon Nov 24 16:56:49 2003 +++ net-nittin-irc/protocol.lisp Mon Nov 24 22:35:55 2003 @@ -1,4 +1,4 @@ -;;;; $Id: protocol.lisp,v 1.19 2003/11/24 21:56:49 eenge Exp $ +;;;; $Id: protocol.lisp,v 1.20 2003/11/25 03:35:55 eenge Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/protocol.lisp,v $ ;;;; See LICENSE for licensing information. @@ -46,7 +46,7 @@ (channels :initarg :channels :accessor channels - :initform nil) + :initform (make-hash-table :test #'equal)) (hooks :initarg :hooks :accessor hooks @@ -252,6 +252,9 @@ ((name :initarg :name :accessor name) + (normalized-name + :initarg :normalized-name + :accessor normalized-name) (topic :initarg :topic :accessor topic) @@ -278,6 +281,11 @@ (print-unreadable-object (object stream :type t :identity t) (princ (name object) stream))) +(defun normalize-channel-name (string) + "Normalize `string' so that it represents an all-downcased channel +name." + (string-downcase string)) + (defun make-channel (&key (name "") (topic "") (modes nil) @@ -286,6 +294,7 @@ (let ((channel (make-instance 'channel :name name + :normalized-name (normalize-channel-name name) :topic topic :modes modes :user-count user-count))) @@ -296,19 +305,20 @@ (defmethod find-channel ((connection connection) (channel string)) "Return channel as designated by `channel'. If no such channel can be found, return nil." - (find channel (channels connection) :key #'name :test #'string-equal)) + (let ((channel-name (normalize-channel-name channel))) + (gethash channel-name (channels connection)))) (defmethod remove-all-channels ((connection connection)) "Remove all channels known to `connection'." - (setf (channels connection) nil)) + (clrhash (channels connection))) (defmethod add-channel ((connection connection) (channel channel)) "Add `channel' to `connection'." - (pushnew channel (channels connection))) + (setf (gethash (normalized-name channel) (channels connection)) channel)) (defmethod remove-channel ((connection connection) (channel channel)) "Remove `channel' from `connection'." - (setf (channels connection) (remove channel (channels connection)))) + (remhash (normalized-name channel) (channels connection))) (defmethod remove-users ((channel channel)) "Remove all users on `channel'." @@ -369,15 +379,15 @@ (subseq nickname 1) nickname)) -;; oh, what a terrible operator name (defun normalize-nickname (string) + "Normalize `string' so that represents an all-downcased IRC +nickname." (let* ((new-string (substitute #\[ #\{ string)) (new-string (substitute #\] #\} new-string)) (new-string (substitute #\\ #\| new-string)) (new-string (substitute #\~ #\^ new-string))) (string-downcase string))) -;; this is broken. we should use #'irc-nick-equal somehow. (defmethod find-user ((connection connection) (nickname string)) "Return user as designated by `nickname' or nil if no such user is known." @@ -395,8 +405,7 @@ (defmethod remove-all-users ((connection connection)) "Remove all users known to `connection'." - (setf (users connection) nil) - (mapc #'remove-users (channels connection))) + (clrhash (users connection))) (defmethod remove-user ((channel channel) (user user)) "Remove `user' from `channel' and `channel' from `user'." From eenge at common-lisp.net Tue Nov 25 03:56:07 2003 From: eenge at common-lisp.net (Erik Enge) Date: Mon, 24 Nov 2003 22:56:07 -0500 Subject: [net-nittin-irc-cvs] CVS update: net-nittin-irc/event.lisp net-nittin-irc/protocol.lisp Message-ID: Update of /project/net-nittin-irc/cvsroot/net-nittin-irc In directory common-lisp.net:/tmp/cvs-serv32047 Modified Files: event.lisp protocol.lisp Log Message: change-user didn't properly change nicknames; fixed. Date: Mon Nov 24 22:56:06 2003 Author: eenge Index: net-nittin-irc/event.lisp diff -u net-nittin-irc/event.lisp:1.12 net-nittin-irc/event.lisp:1.13 --- net-nittin-irc/event.lisp:1.12 Mon Nov 24 22:35:55 2003 +++ net-nittin-irc/event.lisp Mon Nov 24 22:56:06 2003 @@ -1,4 +1,4 @@ -;;;; $Id: event.lisp,v 1.12 2003/11/25 03:35:55 eenge Exp $ +;;;; $Id: event.lisp,v 1.13 2003/11/25 03:56:06 eenge Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/event.lisp,v $ ;;;; See LICENSE for licensing information. @@ -84,15 +84,9 @@ (remove-user-everywhere connection (find-user connection (source message))))) (defmethod default-hook ((message irc-nick-message)) - (if (self-message-p message) - (change-nickname (connection message) (user (connection message)) - (trailing-argument message)) - (let ((user (find-user (connection message) (source message)))) - (if user - (change-nickname (connection message) user (trailing-argument message)) - (client-raw-log (connection message) - (format nil "Could not find user with nick ~A~%" - (source message))))))) + (let ((con (connection message))) + (change-nickname con (find-user con (source message)) + (trailing-argument message)))) (defmethod default-hook ((message irc-kick-message)) (let* ((connection (connection message)) Index: net-nittin-irc/protocol.lisp diff -u net-nittin-irc/protocol.lisp:1.20 net-nittin-irc/protocol.lisp:1.21 --- net-nittin-irc/protocol.lisp:1.20 Mon Nov 24 22:35:55 2003 +++ net-nittin-irc/protocol.lisp Mon Nov 24 22:56:06 2003 @@ -1,4 +1,4 @@ -;;;; $Id: protocol.lisp,v 1.20 2003/11/25 03:35:55 eenge Exp $ +;;;; $Id: protocol.lisp,v 1.21 2003/11/25 03:56:06 eenge Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/protocol.lisp,v $ ;;;; See LICENSE for licensing information. @@ -416,11 +416,16 @@ "Remove `channel' from `user'." (setf (channels user) (remove channel (channels user)))) +(defmethod remove-user ((connection connection) (user user)) + "Remove `user' from `connection' but leave user in any channels he +may be already be on." + (remhash (normalized-nickname user) (users connection))) + (defmethod remove-user-everywhere ((connection connection) (user user)) "Remove `user' anywhere present in the `connection'." (dolist (channel (channels user)) (remove-user channel user)) - (remhash (normalized-nickname user) (users connection))) + (remove-user connection user)) (defmethod find-or-make-user ((connection connection) nickname &key (username "") (hostname "") (realname "")) @@ -431,7 +436,14 @@ :realname realname))) (defmethod change-nickname ((connection connection) (user user) new-nickname) - (setf (nickname user) new-nickname)) + (let ((new-user user) + (channels (channels user))) + (remove-user connection user) + (setf (nickname new-user) new-nickname) + (setf (normalized-nickname new-user) (normalize-nickname new-nickname)) + (dolist (channel channels) + (remove-user channel user) + (add-user connection channel new-user)))) ;; IRC Message ;; From eenge at common-lisp.net Tue Nov 25 13:04:33 2003 From: eenge at common-lisp.net (Erik Enge) Date: Tue, 25 Nov 2003 08:04:33 -0500 Subject: [net-nittin-irc-cvs] CVS update: net-nittin-irc/event.lisp net-nittin-irc/protocol.lisp Message-ID: Update of /project/net-nittin-irc/cvsroot/net-nittin-irc In directory common-lisp.net:/tmp/cvs-serv24735 Modified Files: event.lisp protocol.lisp Log Message: I let net-nittin-irc listen to a couple of channels on freenode over the night and it blew up after four hours. change-nickname didn't work the way I thought it would, apparently, but I'm not sure it's still fixed. Date: Tue Nov 25 08:04:33 2003 Author: eenge Index: net-nittin-irc/event.lisp diff -u net-nittin-irc/event.lisp:1.13 net-nittin-irc/event.lisp:1.14 --- net-nittin-irc/event.lisp:1.13 Mon Nov 24 22:56:06 2003 +++ net-nittin-irc/event.lisp Tue Nov 25 08:04:33 2003 @@ -1,4 +1,4 @@ -;;;; $Id: event.lisp,v 1.13 2003/11/25 03:56:06 eenge Exp $ +;;;; $Id: event.lisp,v 1.14 2003/11/25 13:04:33 eenge Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/event.lisp,v $ ;;;; See LICENSE for licensing information. @@ -48,7 +48,8 @@ :username (user message) :hostname (host message)))) (unless (equal user (user connection)) - (add-user connection channel user)))))) + (add-user connection user) + (add-user channel user)))))) (defmethod default-hook ((message irc-ping-message)) (pong (connection message) (trailing-argument message))) @@ -64,7 +65,9 @@ (make-channel :name (trailing-argument message))))) (if (self-message-p message) (add-channel connection channel) - (add-user connection channel user)))) + (progn + (add-user connection user) + (add-user channel user))))) (defmethod default-hook ((message irc-topic-message)) (setf (topic (find-channel (connection message) Index: net-nittin-irc/protocol.lisp diff -u net-nittin-irc/protocol.lisp:1.21 net-nittin-irc/protocol.lisp:1.22 --- net-nittin-irc/protocol.lisp:1.21 Mon Nov 24 22:56:06 2003 +++ net-nittin-irc/protocol.lisp Tue Nov 25 08:04:33 2003 @@ -1,4 +1,4 @@ -;;;; $Id: protocol.lisp,v 1.21 2003/11/25 03:56:06 eenge Exp $ +;;;; $Id: protocol.lisp,v 1.22 2003/11/25 13:04:33 eenge Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/protocol.lisp,v $ ;;;; See LICENSE for licensing information. @@ -397,12 +397,14 @@ (user connection))))) ; what if the user is not on any channels? -(defmethod add-user ((connection connection) (channel channel) (user user)) - "Add `user' to `channel' and `channel' to `user'." - (setf (gethash (normalized-nickname user) (users channel)) user) - (pushnew channel (channels user)) +(defmethod add-user ((connection connection) (user user)) + "Add `user' to `connection'." (setf (gethash (normalized-nickname user) (users connection)) user)) +(defmethod add-user ((channel channel) (user user)) + (setf (gethash (normalized-nickname user) (users channel)) user) + (pushnew channel (channels user))) + (defmethod remove-all-users ((connection connection)) "Remove all users known to `connection'." (clrhash (users connection))) @@ -443,7 +445,9 @@ (setf (normalized-nickname new-user) (normalize-nickname new-nickname)) (dolist (channel channels) (remove-user channel user) - (add-user connection channel new-user)))) + (add-user channel new-user)) + (add-user connection user) + new-user)) ;; IRC Message ;; From eenge at common-lisp.net Tue Nov 25 13:14:34 2003 From: eenge at common-lisp.net (Erik Enge) Date: Tue, 25 Nov 2003 08:14:34 -0500 Subject: [net-nittin-irc-cvs] CVS update: net-nittin-irc/protocol.lisp Message-ID: Update of /project/net-nittin-irc/cvsroot/net-nittin-irc In directory common-lisp.net:/tmp/cvs-serv29656 Modified Files: protocol.lisp Log Message: really, really, silly bug in normalize-nickname (returning wrong value) Date: Tue Nov 25 08:14:34 2003 Author: eenge Index: net-nittin-irc/protocol.lisp diff -u net-nittin-irc/protocol.lisp:1.22 net-nittin-irc/protocol.lisp:1.23 --- net-nittin-irc/protocol.lisp:1.22 Tue Nov 25 08:04:33 2003 +++ net-nittin-irc/protocol.lisp Tue Nov 25 08:14:34 2003 @@ -1,4 +1,4 @@ -;;;; $Id: protocol.lisp,v 1.22 2003/11/25 13:04:33 eenge Exp $ +;;;; $Id: protocol.lisp,v 1.23 2003/11/25 13:14:34 eenge Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/protocol.lisp,v $ ;;;; See LICENSE for licensing information. @@ -386,7 +386,7 @@ (new-string (substitute #\] #\} new-string)) (new-string (substitute #\\ #\| new-string)) (new-string (substitute #\~ #\^ new-string))) - (string-downcase string))) + (string-downcase new-string))) (defmethod find-user ((connection connection) (nickname string)) "Return user as designated by `nickname' or nil if no such user is From eenge at common-lisp.net Tue Nov 25 13:15:41 2003 From: eenge at common-lisp.net (Erik Enge) Date: Tue, 25 Nov 2003 08:15:41 -0500 Subject: [net-nittin-irc-cvs] CVS update: net-nittin-irc/test/test-protocol.lisp net-nittin-irc/test/net-nittin-irc-test.asd Message-ID: Update of /project/net-nittin-irc/cvsroot/net-nittin-irc/test In directory common-lisp.net:/tmp/cvs-serv29837/test Modified Files: net-nittin-irc-test.asd Added Files: test-protocol.lisp Log Message: fixing bug in change-nickname and adding tests to catch any future problems with that function Date: Tue Nov 25 08:15:41 2003 Author: eenge Index: net-nittin-irc/test/net-nittin-irc-test.asd diff -u net-nittin-irc/test/net-nittin-irc-test.asd:1.1 net-nittin-irc/test/net-nittin-irc-test.asd:1.2 --- net-nittin-irc/test/net-nittin-irc-test.asd:1.1 Sun Nov 23 17:40:23 2003 +++ net-nittin-irc/test/net-nittin-irc-test.asd Tue Nov 25 08:15:41 2003 @@ -1,4 +1,4 @@ -;;;; $Id: net-nittin-irc-test.asd,v 1.1 2003/11/23 22:40:23 eenge Exp $ +;;;; $Id: net-nittin-irc-test.asd,v 1.2 2003/11/25 13:15:41 eenge Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/test/net-nittin-irc-test.asd,v $ ;;;; See the LICENSE file for licensing information. @@ -21,4 +21,6 @@ #-sbcl (:split-sequence :rt :net-nittin-irc) :components ((:file "package") (:file "test-parse-message" - :depends-on ("package")))) + :depends-on ("package")) + (:file "test-protocol" + :depends-on ("test-parse-message")))) From eenge at common-lisp.net Wed Nov 26 00:51:37 2003 From: eenge at common-lisp.net (Erik Enge) Date: Tue, 25 Nov 2003 19:51:37 -0500 Subject: [net-nittin-irc-cvs] CVS update: net-nittin-irc/TODO Message-ID: Update of /project/net-nittin-irc/cvsroot/net-nittin-irc In directory common-lisp.net:/tmp/cvs-serv3539 Modified Files: TODO Log Message: adding note about WHOISCHANNEL Date: Tue Nov 25 19:51:37 2003 Author: eenge Index: net-nittin-irc/TODO diff -u net-nittin-irc/TODO:1.11 net-nittin-irc/TODO:1.12 --- net-nittin-irc/TODO:1.11 Mon Nov 24 17:12:20 2003 +++ net-nittin-irc/TODO Tue Nov 25 19:51:37 2003 @@ -16,3 +16,6 @@ - Document inconsistencies between IRC servers (ref. undernet servers send out channel name in arguments rather than trailing-messages on a part/quit message) + + - When doing a whois on a user the library ought to snap up the + channels in WHOISCHANNELS as channels the user is currently on. From eenge at common-lisp.net Wed Nov 26 12:38:35 2003 From: eenge at common-lisp.net (Erik Enge) Date: Wed, 26 Nov 2003 07:38:35 -0500 Subject: [net-nittin-irc-cvs] CVS update: public_html/index.html Message-ID: Update of /project/net-nittin-irc/cvsroot/public_html In directory common-lisp.net:/tmp/cvs-serv24655 Modified Files: index.html Log Message: releasing version 0.4.0 Date: Wed Nov 26 07:38:29 2003 Author: eenge Index: public_html/index.html diff -u public_html/index.html:1.7 public_html/index.html:1.8 --- public_html/index.html:1.7 Wed Nov 12 14:31:59 2003 +++ public_html/index.html Wed Nov 26 07:38:23 2003 @@ -5,7 +5,7 @@
    -

    net-nittin-irc 0.3.0

    +

    net-nittin-irc 0.4.0

    @@ -24,6 +24,11 @@ groundwork for this library with his Weird-IRC IRC client and that therefore some of the code is copyright him.

    + +

    News

    +
    +
  • Version 0.4.0 released (some documentation, beginnings of a test suite, better performance)
    • +

    Features