cl-irc-cvs

cl-irc-cvs@common-lisp.net

220 discussions

[cl-irc-cvs] r220 - branches/0.9.0
by ehuelsmann＠common-lisp.net 23 Sep '12

23 Sep '12

Author: ehuelsmann Date: Sun Sep 23 03:44:12 2012 New Revision: 220 Log: Create 0.9.0 release tag. Added: branches/0.9.0/ - copied from r219, trunk/

1 0

[cl-irc-cvs] r219 - trunk
by ehuelsmann＠common-lisp.net 23 Sep '12

23 Sep '12

Author: ehuelsmann Date: Sun Sep 23 02:50:06 2012 New Revision: 219 Log: Fix long-standing complaint that cl-irc hits the debugger on unknown (and, as Matthew Emerson puts it, irrelevant) response codes. * parse-message.lisp: (find-reply-name): Simply return the reply name. (create-irc-message): If there's no reply name, raise an error. * protocol.lisp: (read-irc-message, read-message, read-message-loop): restructure condition handling for END-OF-FILE and NO-SUCH-REPLY to eliminate "trickery" (returning values which mean different things than what they are) * variable.lisp: (*unknown-reply-hook*): New variable for function to catch unhandled replies. Defaults to ignore unhandled replies. Modified: trunk/parse-message.lisp trunk/protocol.lisp trunk/variable.lisp Modified: trunk/parse-message.lisp ============================================================================== --- trunk/parse-message.lisp Sat Aug 18 14:58:37 2012 (r218) +++ trunk/parse-message.lisp Sun Sep 23 02:50:06 2012 (r219) @@ -12,12 +12,8 @@ (`no-such-reply') which gives you the opportunity to ignore the situation." (let ((name (assoc reply-number reply-names))) - (if name - (cadr name) - (progn - (cerror "Ignore unknown reply." - 'no-such-reply :reply-number reply-number) - :unknown-reply)))) + (when name + (cadr name)))) (defun return-source (string &key (start 0)) "Assuming `string' is a valid IRC message this function returns the @@ -198,14 +194,17 @@ ;; (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))) + (let* ((reply-number (parse-integer command)) + (reply-name (find-reply-name reply-number))) + (unless reply-name + (error "Ignore unknown reply." + 'no-such-reply :reply-number reply-number)) + (setf command reply-name) (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)))))) + (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 Modified: trunk/protocol.lisp ============================================================================== --- trunk/protocol.lisp Sat Aug 18 14:58:37 2012 (r218) +++ trunk/protocol.lisp Sun Sep 23 02:50:06 2012 (r219) @@ -280,8 +280,8 @@ (when *debug-p* (format *debug-stream* "~A" (describe message))) (when message - (irc-message-event connection message)) - message))) ; needed because of the "loop while" in read-message-loop + (irc-message-event connection message))) + t)) ;; connected -> continue processing (defvar *process-count* 0) @@ -311,34 +311,21 @@ (flet ((select-handler (fd) (declare (ignore fd)) (if (listen (network-stream connection)) - (handler-bind - ;; install sensible recovery: nobody can wrap the - ;; handler... - ((no-such-reply - #'(lambda (c) - (declare (ignore c)) - (invoke-restart 'continue)))) - (read-message connection)) - ;; select() returns with no - ;; available data if the stream - ;; has been closed on the other - ;; end (EPIPE) - (sb-sys:invalidate-descriptor - (sb-sys:fd-stream-fd - (network-stream connection)))))) + (read-message connection) + ;; select() returns with no + ;; available data if the stream + ;; has been closed on the other + ;; end (EPIPE) + (sb-sys:invalidate-descriptor + (sb-sys:fd-stream-fd + (network-stream connection)))))) (sb-sys:add-fd-handler (sb-sys:fd-stream-fd (network-stream connection)) :input #'select-handler)) #-(and sbcl (not sb-thread)) (flet ((do-loop () - (loop - (handler-bind - ((no-such-reply - #'(lambda (c) - (declare (ignore c)) - (invoke-restart 'continue)))) - (read-message-loop connection))))) + (read-message-loop connection))) (let ((name (format nil "irc-handler-~D" (incf *process-count*)))) (start-process #'do-loop name)))) @@ -357,19 +344,23 @@ (defgeneric read-message-loop (connection)) (defmethod read-message-loop (connection) - (loop while (read-message connection))) + (handler-bind + (loop while (read-message connection)) + (end-of-file () nil))) (defmethod read-irc-message ((connection connection)) - "Read and parse an IRC-message from the `connection'." - (handler-case - (let* ((msg-string (read-protocol-line connection)) - (message (when msg-string (create-irc-message msg-string)))) - (when message (setf (connection message) connection)) - message) - (end-of-file - ;; satisfy read-message-loop assumption of nil when no more messages - ()))) + "Read and parse an IRC message from the `connection'." + (let* ((msg-string (read-protocol-line connection)) + (message (when msg-string + (handler-case + (create-irc-message msg-string) + (no-such-reply () + (when *unknown-reply-hook* + (funcall *unknown-reply-hook* + connection msg-string))))))) + (when message (setf (connection message) connection)) + message)) (defmethod send-irc-message ((connection connection) command Modified: trunk/variable.lisp ============================================================================== --- trunk/variable.lisp Sat Aug 18 14:58:37 2012 (r218) +++ trunk/variable.lisp Sun Sep 23 02:50:06 2012 (r219) @@ -15,8 +15,8 @@ (format nil "CL IRC library, cl-irc:~A:~A ~A" *version* (machine-type) (machine-version))) -(defparameter *download-host* "ftp://common-lisp.net/") -(defparameter *download-directory* "/pub/project/cl-irc/") +(defparameter *download-host* "http://common-lisp.net/") +(defparameter *download-directory* "/project/cl-irc/") (defparameter *download-file* (format nil "cl-irc-~A.tar.gz" *version*)) @@ -28,6 +28,15 @@ (defvar *default-quit-message* "Common Lisp IRC library - http://common-lisp.net/project/cl-irc") +(defparameter *unknown-reply-hook* nil + "A function of two arguments, called with the related irc connection +object and the protocol message string upon detection of an unmappable +response code. + +The function should return a valid IRC-MESSAGE class or NIL. + +The parameter can be NIL to disable the hook.") + (defparameter *default-isupport-CHANMODES* "beI,kO,l,aimnpqsrt") (defparameter *default-isupport-PREFIX*

1 0

[cl-irc-cvs] r218 - trunk
by ehuelsmann＠common-lisp.net 18 Aug '12

18 Aug '12

Author: ehuelsmann Date: Sat Aug 18 14:58:37 2012 New Revision: 218 Log: Fix Quakenet authentication bug as reported by Reinout Steven in http://lists.common-lisp.net/pipermail/cl-irc-devel/2010-January/000273.html Modified: trunk/command.lisp Modified: trunk/command.lisp ============================================================================== --- trunk/command.lisp Sat Aug 18 14:36:49 2012 (r217) +++ trunk/command.lisp Sat Aug 18 14:58:37 2012 (r218) @@ -344,8 +344,10 @@ (defmethod ping ((connection connection) (server string)) (send-irc-message connection :ping server)) -(defmethod pong ((connection connection) (server string) &optional (server2 "")) - (send-irc-message connection :pong server server2)) +(defmethod pong ((connection connection) (server string) &optional server2) + (if server2 + (send-irc-message connection :pong server server2) + (send-irc-message connection :pong server))) (defmethod error- ((connection connection) (message string)) (send-irc-message connection :error message))

1 0

[cl-irc-cvs] r217 - trunk
by ehuelsmann＠common-lisp.net 18 Aug '12

18 Aug '12

Author: ehuelsmann Date: Sat Aug 18 14:36:49 2012 New Revision: 217 Log: Add response codes to help cl-irc log in on Freenode. Patch submitted by antoska (Antoni Grzymala). Modified: trunk/variable.lisp Modified: trunk/variable.lisp ============================================================================== --- trunk/variable.lisp Sat Aug 18 14:28:46 2012 (r216) +++ trunk/variable.lisp Sat Aug 18 14:36:49 2012 (r217) @@ -188,6 +188,7 @@ (304 :rpl_away) (305 :rpl_unaway) (306 :rpl_noaway) + (307 :rpl_whoisidentified) (311 :rpl_whoisuser) (312 :rpl_whoisserver) (313 :rpl_whoisoperator) @@ -205,7 +206,9 @@ (325 :rpl_uniqopis) (326 :rpl_whoisoperprivs) ; Seen in dancer ircd source (327 :rpl_whoisrealhost) ; Seen in dancer ircd source + (328 :rpl_channel_url) (329 :rpl_creationtime) ; Seen in dancer ircd source + (330 :rpl_whoisidentified) (331 :rpl_notopic) (332 :rpl_topic) (333 :rpl_topicwhotime) ; Seen in dancer ircd source @@ -245,6 +248,7 @@ (393 :rpl_users) (394 :rpl_endofusers) (395 :rpl_nousers) + (396 :rpl_hiddenhost) (399 :rpl_message) ; Seen in dancer ircd source (401 :err_nosuchnick) (402 :err_nosuchserver) @@ -315,5 +319,8 @@ (513 :err_maxforwarding) ; Seen in dancer ircd source (514 :err_noforwarding) ; Seen in dancer ircd source (515 :err_nounidentified) ; Seen in dancer ircd source - (516 :err_last_err_msg))) ; Seen in dancer ircd source + (516 :err_last_err_msg) ; Seen in dancer ircd source + (671 :rpl_secureconnection) + (710 :rpl_noidea) ;; ## what's the real event? + ))

1 0

[cl-irc-cvs] r216 - trunk
by ehuelsmann＠common-lisp.net 18 Aug '12

18 Aug '12

Author: ehuelsmann Date: Sat Aug 18 14:28:46 2012 New Revision: 216 Log: Add an ACTION convenience method. Patch submitted by Daniel Lowe. Modified: trunk/command.lisp Modified: trunk/command.lisp ============================================================================== --- trunk/command.lisp Sat Aug 18 14:22:58 2012 (r215) +++ trunk/command.lisp Sat Aug 18 14:28:46 2012 (r216) @@ -57,6 +57,7 @@ (defgeneric wallops (connection message)) (defgeneric userhost (connection nickname)) (defgeneric ison (connection user)) +(defgeneric action (connection target message)) (defgeneric ctcp (connection target message)) (defgeneric ctcp-reply (connection target message)) (defgeneric ctcp-chat-initiate (connection nickname &key passive) @@ -390,6 +391,16 @@ (defmethod ctcp-reply ((connection connection) target message) (send-irc-message connection :notice target (make-ctcp-message message))) +(defmethod action ((connection connection) (target string) (message string)) + (ctcp connection target (concatenate 'string "ACTION " message))) + +(defmethod action ((connection connection) (user user) (message string)) + (action connection (nickname user) message)) + +(defmethod action ((connection connection) (channel channel) (message string)) + (action connection (name channel) message)) + + ;; Intermezzo: Manage outstanding offers (defvar *passive-offer-sequence-token* 0)

1 0

[cl-irc-cvs] r215 - trunk
by ehuelsmann＠common-lisp.net 18 Aug '12

18 Aug '12

Author: ehuelsmann Date: Sat Aug 18 14:22:58 2012 New Revision: 215 Log: Add sockets keep alive on SBCL. Patch submitted by Daniel Lowe. Modified: trunk/command.lisp Modified: trunk/command.lisp ============================================================================== --- trunk/command.lisp Sat Aug 18 14:21:02 2012 (r214) +++ trunk/command.lisp Sat Aug 18 14:22:58 2012 (r215) @@ -300,6 +300,7 @@ :nickname nickname :username username :realname realname))) + #+sbcl (setf (sb-bsd-sockets::sockopt-keep-alive (usocket:socket socket)) t) (setf (user connection) user) (unless (null password) (pass connection password))

1 0

[cl-irc-cvs] r214 - trunk
by ehuelsmann＠common-lisp.net 18 Aug '12

18 Aug '12

Author: ehuelsmann Date: Sat Aug 18 14:21:02 2012 New Revision: 214 Log: Name threads on SBCL. Patch submitted by Daniel Lowe. Modified: trunk/protocol.lisp Modified: trunk/protocol.lisp ============================================================================== --- trunk/protocol.lisp Sat Aug 18 14:19:25 2012 (r213) +++ trunk/protocol.lisp Sat Aug 18 14:21:02 2012 (r214) @@ -292,7 +292,7 @@ #+allegro (mp:process-run-function name function) #+cmu (mp:make-process function :name name) #+lispworks (mp:process-run-function name nil function) - #+sb-thread (sb-thread:make-thread function) + #+sb-thread (sb-thread:make-thread function :name name) #+openmcl (ccl:process-run-function name function) #+armedbear (ext:make-thread function))

1 0

[cl-irc-cvs] r213 - trunk
by ehuelsmann＠common-lisp.net 18 Aug '12

18 Aug '12

Author: ehuelsmann Date: Sat Aug 18 14:19:25 2012 New Revision: 213 Log: Correct spelling error. Patch submitted by Daniel Lowe. Modified: trunk/protocol.lisp Modified: trunk/protocol.lisp ============================================================================== --- trunk/protocol.lisp Mon Mar 9 15:32:32 2009 (r212) +++ trunk/protocol.lisp Sat Aug 18 14:19:25 2012 (r213) @@ -339,7 +339,7 @@ (declare (ignore c)) (invoke-restart 'continue)))) (read-message-loop connection))))) - (let ((name (format nil "irc-hander-~D" (incf *process-count*)))) + (let ((name (format nil "irc-handler-~D" (incf *process-count*)))) (start-process #'do-loop name)))) (defun stop-background-message-handler (process)

1 0

[cl-irc-cvs] r212 - trunk
by Erik Huelsmann 09 Mar '09

09 Mar '09

Author: ehuelsmann Date: Mon Mar 9 22:32:32 2009 New Revision: 212 Log: Install sensible recovery routines for NO-SUCH-REPLY in the default message loop handlers: use the continue restart. Modified: trunk/protocol.lisp Modified: trunk/protocol.lisp ============================================================================== --- trunk/protocol.lisp (original) +++ trunk/protocol.lisp Mon Mar 9 22:32:32 2009 @@ -311,7 +311,14 @@ (flet ((select-handler (fd) (declare (ignore fd)) (if (listen (network-stream connection)) - (read-message connection) + (handler-bind + ;; install sensible recovery: nobody can wrap the + ;; handler... + ((no-such-reply + #'(lambda (c) + (declare (ignore c)) + (invoke-restart 'continue)))) + (read-message connection)) ;; select() returns with no ;; available data if the stream ;; has been closed on the other @@ -324,7 +331,14 @@ :input #'select-handler)) #-(and sbcl (not sb-thread)) - (flet ((do-loop () (read-message-loop connection))) + (flet ((do-loop () + (loop + (handler-bind + ((no-such-reply + #'(lambda (c) + (declare (ignore c)) + (invoke-restart 'continue)))) + (read-message-loop connection))))) (let ((name (format nil "irc-hander-~D" (incf *process-count*)))) (start-process #'do-loop name))))

1 0

[cl-irc-cvs] CVS cl-irc/example
by bmastenbrook 31 Oct '08

31 Oct '08

Update of /project/cl-irc/cvsroot/cl-irc/example In directory cl-net:/home/bmastenbrook/cl-irc/example Removed Files: words Log Message: Remove the words file

1 0

Jump to page:

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

2004

cl-irc-cvs