cl-irc-cvs

cl-irc-cvs@common-lisp.net

220 discussions

[cl-irc-cvs] r191 - trunk
by ehuelsmann＠common-lisp.net 22 Apr '07

22 Apr '07

Author: ehuelsmann Date: Sun Apr 22 17:05:11 2007 New Revision: 191 Modified: trunk/parse-message.lisp Log: Add a list of DCC session types. Modified: trunk/parse-message.lisp ============================================================================== --- trunk/parse-message.lisp (original) +++ trunk/parse-message.lisp Sun Apr 22 17:05:11 2007 @@ -125,14 +125,38 @@ (dcc (string-upcase (first args))) (type (string-upcase (second args)))) (when (string= dcc "DCC") - (case type - (:dcc-chat-request - (when (string= type "CHAT") - :dcc-chat-request)) - (:dcc-send-request - (when (string= type "SEND") - :dcc-send-request)) - (otherwise nil))))) + (let ((r + ;; the list below was found on Wikipedia and in kvirc docs + (second (assoc type '(("CHAT" :dcc-chat-request) + ("SEND" :dcc-send-request) + ("XMIT" :dcc-xmit-request) + ("SCHAT" :dcc-schat-request) + ("SSEND" :dcc-ssend-request) + ("REVERSE" :dcc-reverse-request) + ("RSEND" :dcc-rsend-request) + ("TSEND" :dcc-tsend-request) + ("STSEND" :dcc-stsend-request) + ("TSSEND" :dcc-stsend-request) + ("RESUME" :dcc-resume-request) + ("ACCEPT" :dcc-accept-request) + ;; GET + ;; TGET + ;; STGET + ;; TSGET + ;; RECV + ;; SRECV + ;; TRECV + ;; STRECV + ;; TSRECV + ;; RSEND + ;; SRSEND + ;; TRSEND + ;; STRSEND + ;; TSRSEND + ;; VOICE + ) :test #'string=)))) + (when (eq r type) + type))))) (defun ctcp-message-type (string) "If `string' is a CTCP message, return the type of the message or

1 0

[cl-irc-cvs] r190 - trunk
by ehuelsmann＠common-lisp.net 22 Apr '07

22 Apr '07

Author: ehuelsmann Date: Sun Apr 22 16:01:44 2007 New Revision: 190 Modified: trunk/parse-message.lisp Log: Other DCC protocols starting with an #\S have been introduced now (SCHAT,SSEND). Modified: trunk/parse-message.lisp ============================================================================== --- trunk/parse-message.lisp (original) +++ trunk/parse-message.lisp Sun Apr 22 16:01:44 2007 @@ -118,17 +118,21 @@ 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) - :dcc-chat-request)) - (:dcc-send-request - (when (string-equal (char string 5) #\S) - :dcc-send-request)) - (otherwise nil))) + (let* ((args (tokenize-string (string-trim (list +soh+) string))) + (dcc (string-upcase (first args))) + (type (string-upcase (second args)))) + (when (string= dcc "DCC") + (case type + (:dcc-chat-request + (when (string= type "CHAT") + :dcc-chat-request)) + (:dcc-send-request + (when (string= type "SEND") + :dcc-send-request)) + (otherwise nil))))) (defun ctcp-message-type (string) "If `string' is a CTCP message, return the type of the message or

1 0

[cl-irc-cvs] r189 - trunk
by ehuelsmann＠common-lisp.net 22 Apr '07

22 Apr '07

Author: ehuelsmann Date: Sun Apr 22 04:12:22 2007 New Revision: 189 Modified: trunk/protocol.lisp trunk/utility.lisp Log: Move 2 utility routines. Modified: trunk/protocol.lisp ============================================================================== --- trunk/protocol.lisp (original) +++ trunk/protocol.lisp Sun Apr 22 04:12:22 2007 @@ -334,46 +334,6 @@ (defun read-message-loop (connection) (loop while (read-message connection))) -(defun try-decode-line (line external-formats) - (loop for external-format in external-formats - for decoded = nil - for error = nil - do (multiple-value-setq (decoded error) - (handler-case - (flexi-streams:with-input-from-sequence (in line) - (let* ((ex-fmt (external-format-fixup external-format)) - (flexi (flexi-streams:make-flexi-stream - in - ;; :element-type 'character - :external-format ex-fmt))) - (read-line flexi nil nil))) - (flexi-streams:flexi-stream-encoding-error () - nil))) - if decoded - do (return decoded))) - -(defun read-protocol-line (connection) - "Reads a line from the input network stream, returning a -character array with the input read." - (multiple-value-bind - (buf buf-len) - ;; Note: we cannot use read-line here (or any other - ;; character based functions), since they may cause - ;; (at this time unwanted) character conversion - (read-sequence-until (network-stream connection) - (make-array 1024 - :element-type '(unsigned-byte 8) - :fill-pointer t) - '(10)) - (when (< 0 buf-len) - (setf (fill-pointer buf) - ;; remove all trailing CR and LF characters - ;; (This allows non-conforming clients to send CRCRLF - ;; as a line separator too). - (or (position-if #'(lambda (x) (member x '(10 13))) - buf :from-end t :end buf-len) - buf-len)) - (try-decode-line buf *default-incoming-external-formats*)))) (defmethod read-irc-message ((connection connection)) "Read and parse an IRC-message from the `connection'." Modified: trunk/utility.lisp ============================================================================== --- trunk/utility.lisp (original) +++ trunk/utility.lisp Sun Apr 22 04:12:22 2007 @@ -106,6 +106,24 @@ (setf (getf (cdr new-format) :eol-style) :crlf) new-format)) +(defun try-decode-line (line external-formats) + (loop for external-format in external-formats + for decoded = nil + for error = nil + do (multiple-value-setq (decoded error) + (handler-case + (flexi-streams:with-input-from-sequence (in line) + (let* ((ex-fmt (external-format-fixup external-format)) + (flexi (flexi-streams:make-flexi-stream + in + ;; :element-type 'character + :external-format ex-fmt))) + (read-line flexi nil nil))) + (flexi-streams:flexi-stream-encoding-error () + nil))) + if decoded + do (return decoded))) + (defun read-byte-no-hang (stream &optional eof-error-p eof-value) (declare (optimize (speed 3) (debug 0) (safety 0))) (when (listen stream) @@ -140,6 +158,30 @@ (= limit-cur limit-max)) do (return (values target (1+ targ-cur) nil))))) +(defun read-protocol-line (connection) + "Reads a line from the input network stream, returning a +character array with the input read." + (multiple-value-bind + (buf buf-len) + ;; Note: we cannot use read-line here (or any other + ;; character based functions), since they may cause + ;; (at this time unwanted) character conversion + (read-sequence-until (network-stream connection) + (make-array 1024 + :element-type '(unsigned-byte 8) + :fill-pointer t) + '(10)) + (when (< 0 buf-len) + (setf (fill-pointer buf) + ;; remove all trailing CR and LF characters + ;; (This allows non-conforming clients to send CRCRLF + ;; as a line separator too). + (or (position-if #'(lambda (x) (member x '(10 13))) + buf :from-end t :end buf-len) + buf-len)) + (try-decode-line buf *default-incoming-external-formats*)))) + + (defun substring (string start &optional end) (let* ((end-index (if end end (length string))) (seq-len (- end-index start)))

1 0

[cl-irc-cvs] r188 - trunk
by ehuelsmann＠common-lisp.net 22 Apr '07

22 Apr '07

Author: ehuelsmann Date: Sat Apr 21 18:50:10 2007 New Revision: 188 Modified: trunk/protocol.lisp trunk/utility.lisp Log: Fix off-by-one error and make sure we don't keep looping when the network stream is lost. Modified: trunk/protocol.lisp ============================================================================== --- trunk/protocol.lisp (original) +++ trunk/protocol.lisp Sat Apr 21 18:50:10 2007 @@ -365,21 +365,22 @@ :element-type '(unsigned-byte 8) :fill-pointer t) '(10)) - (setf (fill-pointer buf) - ;; remove all trailing CR and LF characters - ;; (This allows non-conforming clients to send CRCRLF - ;; as a line separator too). - (or (position-if #'(lambda (x) (member x '(10 13))) - buf :from-end t :end buf-len) - buf-len)) - (try-decode-line buf *default-incoming-external-formats*))) + (when (< 0 buf-len) + (setf (fill-pointer buf) + ;; remove all trailing CR and LF characters + ;; (This allows non-conforming clients to send CRCRLF + ;; as a line separator too). + (or (position-if #'(lambda (x) (member x '(10 13))) + buf :from-end t :end buf-len) + buf-len)) + (try-decode-line buf *default-incoming-external-formats*)))) (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 (create-irc-message msg-string))) - (setf (connection message) 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 Modified: trunk/utility.lisp ============================================================================== --- trunk/utility.lisp (original) +++ trunk/utility.lisp Sat Apr 21 18:50:10 2007 @@ -129,7 +129,7 @@ ;; For others, if this becomes an efficiency problem, please report... (loop for next-elt = (funcall read-fun stream nil nil) if (null next-elt) - do (return (values target targ-cur t)) + do (return (values target (1+ targ-cur) t)) else do (setf (elt target (incf targ-cur)) next-elt) (if (eql next-elt (aref limit-vector limit-cur))

1 0

[cl-irc-cvs] r187 - trunk
by ehuelsmann＠common-lisp.net 22 Apr '07

22 Apr '07

Author: ehuelsmann Date: Sat Apr 21 18:06:51 2007 New Revision: 187 Modified: trunk/protocol.lisp Log: Fix termination condition in read-protocol-line. Modified: trunk/protocol.lisp ============================================================================== --- trunk/protocol.lisp (original) +++ trunk/protocol.lisp Sat Apr 21 18:06:51 2007 @@ -365,15 +365,13 @@ :element-type '(unsigned-byte 8) :fill-pointer t) '(10)) - ;; remove all trailing CR*LF characters (This allows CRCRLF as a line - ;; separator too. - (do ((ch (aref buf (1- buf-len)) - (aref buf (1- buf-len)))) - ((or (not (or (eq ch 10) - (eq ch 13))) - (= buf-len 0))) - (decf buf-len)) - (setf (fill-pointer buf) buf-len) + (setf (fill-pointer buf) + ;; remove all trailing CR and LF characters + ;; (This allows non-conforming clients to send CRCRLF + ;; as a line separator too). + (or (position-if #'(lambda (x) (member x '(10 13))) + buf :from-end t :end buf-len) + buf-len)) (try-decode-line buf *default-incoming-external-formats*))) (defmethod read-irc-message ((connection connection))

1 0

[cl-irc-cvs] r186 - trunk
by ehuelsmann＠common-lisp.net 21 Apr '07

21 Apr '07

Author: ehuelsmann Date: Sat Apr 21 17:02:06 2007 New Revision: 186 Modified: trunk/event.lisp trunk/protocol.lisp Log: Silence UNHANDLED messages on the debug stream when they are in fact handled. Modified: trunk/event.lisp ============================================================================== --- trunk/event.lisp (original) +++ trunk/event.lisp Sat Apr 21 17:02:06 2007 @@ -12,8 +12,8 @@ (defmethod irc-message-event (connection (message irc-message)) (declare (ignore connection)) - (apply-to-hooks message) - (client-log (connection message) message "UNHANDLED-EVENT:")) + (unless (apply-to-hooks message) + (client-log (connection message) message "UNHANDLED-EVENT:"))) (defgeneric default-hook (message) Modified: trunk/protocol.lisp ============================================================================== --- trunk/protocol.lisp (original) +++ trunk/protocol.lisp Sat Apr 21 17:02:06 2007 @@ -993,10 +993,17 @@ (car (last (arguments 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)))) + "Applies any applicable hooks to `message'. + +Returns non-nil if any of the hooks do." + (let ((connection (connection message)) + (result nil)) + (dolist (hook (get-hooks connection (class-name (class-of message))) + result) + (setf result (or (funcall hook message) + result))))) ;; ;; CTCP Message

1 0

[cl-irc-cvs] r185 - trunk
by ehuelsmann＠common-lisp.net 21 Apr '07

21 Apr '07

Author: ehuelsmann Date: Sat Apr 21 03:40:46 2007 New Revision: 185 Modified: trunk/protocol.lisp Log: Fix typo, some refactoring and be more lenient on non-conforming input (allow CRCRLF line terminators too). Modified: trunk/protocol.lisp ============================================================================== --- trunk/protocol.lisp (original) +++ trunk/protocol.lisp Sat Apr 21 03:40:46 2007 @@ -142,7 +142,7 @@ :initarg :client-stream :accessor client-stream :initform t - :documentation "Messages coming back from the server is sent to + :documentation "Messages coming back from the server are sent to this stream.") (channels :initarg :channels @@ -341,34 +341,52 @@ do (multiple-value-setq (decoded error) (handler-case (flexi-streams:with-input-from-sequence (in line) - (let ((flexi (flexi-streams:make-flexi-stream in -;; :element-type 'character - :external-format - (external-format-fixup external-format)))) + (let* ((ex-fmt (external-format-fixup external-format)) + (flexi (flexi-streams:make-flexi-stream + in + ;; :element-type 'character + :external-format ex-fmt))) (read-line flexi nil nil))) (flexi-streams:flexi-stream-encoding-error () nil))) if decoded do (return decoded))) +(defun read-protocol-line (connection) + "Reads a line from the input network stream, returning a +character array with the input read." + (multiple-value-bind + (buf buf-len) + ;; Note: we cannot use read-line here (or any other + ;; character based functions), since they may cause + ;; (at this time unwanted) character conversion + (read-sequence-until (network-stream connection) + (make-array 1024 + :element-type '(unsigned-byte 8) + :fill-pointer t) + '(10)) + ;; remove all trailing CR*LF characters (This allows CRCRLF as a line + ;; separator too. + (do ((ch (aref buf (1- buf-len)) + (aref buf (1- buf-len)))) + ((or (not (or (eq ch 10) + (eq ch 13))) + (= buf-len 0))) + (decf buf-len)) + (setf (fill-pointer buf) buf-len) + (try-decode-line buf *default-incoming-external-formats*))) + (defmethod read-irc-message ((connection connection)) "Read and parse an IRC-message from the `connection'." (handler-case - (multiple-value-bind - (buf buf-len) - ;; Note: we cannot use read-line here (or any other - ;; character based functions), since they may cause conversion - (read-sequence-until (network-stream connection) - (make-array 1024 - :element-type '(unsigned-byte 8) - :fill-pointer t) - '(13 10)) - (setf (fill-pointer buf) buf-len) - (let* ((message (create-irc-message (try-decode-line buf *default-incoming-external-formats*)))) - (setf (connection message) connection) - message)) - (end-of-file ()))) - ;; satisfy read-message-loop assumption of nil when no more messages + (let* ((msg-string (read-protocol-line connection)) + (message (create-irc-message msg-string))) + (setf (connection message) connection) + message) + (end-of-file + ;; satisfy read-message-loop assumption of nil when no more messages + ()))) + (defmethod send-irc-message ((connection connection) command &rest arguments)

1 0

[cl-irc-cvs] r184 - trunk/test
by ehuelsmann＠common-lisp.net 19 Apr '07

19 Apr '07

Author: ehuelsmann Date: Thu Apr 19 17:54:49 2007 New Revision: 184 Modified: trunk/test/test-parse-message.lisp (contents, props changed) trunk/test/test-protocol.lisp (contents, props changed) Log: Harmonize keyword expansion in tests/ directory. Modified: trunk/test/test-parse-message.lisp ============================================================================== --- trunk/test/test-parse-message.lisp (original) +++ trunk/test/test-parse-message.lisp Thu Apr 19 17:54:49 2007 @@ -1,5 +1,5 @@ ;;;; $Id$ -;;;; $Source$ +;;;; $URL$ ;;;; See the LICENSE file for licensing information. Modified: trunk/test/test-protocol.lisp ============================================================================== --- trunk/test/test-protocol.lisp (original) +++ trunk/test/test-protocol.lisp Thu Apr 19 17:54:49 2007 @@ -1,5 +1,5 @@ ;;;; $Id$ -;;;; $Source$ +;;;; $URL$ ;;;; See the LICENSE file for licensing information.

1 0

[cl-irc-cvs] r183 - trunk
by ehuelsmann＠common-lisp.net 19 Apr '07

19 Apr '07

Author: ehuelsmann Date: Thu Apr 19 17:50:36 2007 New Revision: 183 Modified: trunk/package.lisp trunk/utility.lisp Log: No idea why I wrote this, but I think it's generally usefull: hostmask matching. Modified: trunk/package.lisp ============================================================================== --- trunk/package.lisp (original) +++ trunk/package.lisp Thu Apr 19 17:50:36 2007 @@ -86,6 +86,7 @@ :remove-user :self-message-p :user-eq-me-p + :mask-matches-p :pass :nick :user- Modified: trunk/utility.lisp ============================================================================== --- trunk/utility.lisp (original) +++ trunk/utility.lisp Thu Apr 19 17:50:36 2007 @@ -473,3 +473,44 @@ (find-user connection (pop arguments)) (pop arguments)))) ops))))))))))) + +;;; +;;; Hostmask matcher +;;; + +(defun do-mask-match (mask hostname mask-consumed host-consumed) + (if (= (length mask) (1+ mask-consumed)) + ;; we're out of mask to match, hopefully, we're out of hostname too + (= (length hostname) (1+ host-consumed)) + (let ((mask-char (char mask (1+ mask-consumed)))) + (cond + ((eq mask-char #\?) + ;; match any character, if there is one + (do-mask-match mask hostname (1+ mask-consumed) (1+ host-consumed))) + ((eq mask-char #\*) + ;; match any number of characters (including zero) + (do ((match (do-mask-match mask hostname + (incf mask-consumed) + host-consumed) + (do-mask-match mask hostname + mask-consumed + (incf host-consumed)))) + ((or (= (length hostname) (1+ host-consumed)) + match) + match))) + ((= (1+ host-consumed) (length hostname)) + ;; we're out of hostname... + nil) + (t + ;; match other characters by exact matches + (when (eq mask-char (char hostname (1+ host-consumed))) + (do-mask-match mask hostname + (1+ mask-consumed) (1+ host-consumed)))))))) + + (defun mask-matches-p (mask hostname) + "Wildcard matching. + +Uses `*' to match any number of characters and `?' to match exactly any +one character. The routine does not enforce hostmask matching patterns, +but can be used for the purpose." + (do-mask-match mask hostname -1 -1))

1 0

[cl-irc-cvs] r182 - in public_html: . releases
by ehuelsmann＠common-lisp.net 19 Apr '07

19 Apr '07

Author: ehuelsmann Date: Thu Apr 19 16:31:12 2007 New Revision: 182 Added: public_html/releases/cl-irc-0.8.1.tar.gz (contents, props changed) public_html/releases/cl-irc-0.8.1.tar.gz.asc Modified: public_html/index.html public_html/releases/cl-irc_latest.tar.gz public_html/releases/cl-irc_latest.tar.gz.asc Log: Update the website according to the 0.8.1 release (and upload release files). Modified: public_html/index.html ============================================================================== --- public_html/index.html (original) +++ public_html/index.html Thu Apr 19 16:31:12 2007 @@ -5,7 +5,7 @@ <body> <div class="header"> - <h1>cl-irc 0.8.0</h1> + <h1>cl-irc 0.8.1</h1> </div> <div class="body"> @@ -28,7 +28,8 @@ <h2>News</h2> <div class="level"> <ul> - <li>Version 0.8.0 released (user and channel mode tracking, characterset support on the irc network) + <li>Version 0.8.1 released (small fixes: KICK message processing, channel mode tracking)</li> + <li>Version 0.8.0 released (user and channel mode tracking, characterset support on the irc network)</li> <li>Version 0.7.0 released (RPL_ISUPPORT, many small tweaks and fixes)</li> <li>Version 0.6.0 released (interim release while common-lisp.net was down)</li> <li>Version 0.5.0 released (package rename and minor changes)</li> Added: public_html/releases/cl-irc-0.8.1.tar.gz ============================================================================== Binary file. No diff available. Added: public_html/releases/cl-irc-0.8.1.tar.gz.asc ============================================================================== --- (empty file) +++ public_html/releases/cl-irc-0.8.1.tar.gz.asc Thu Apr 19 16:31:12 2007 @@ -0,0 +1,7 @@ +-----BEGIN PGP SIGNATURE----- +Version: GnuPG v1.4.6 (GNU/Linux) + +iD8DBQBGJ+yQi5O0Epaz9TkRAqNfAJ9zGgX2qWrUvNjew8xnrEry8yPhAwCeKEl9 +PaVl6xRO9UWtLQUqLWmCpBY= +=iOtY +-----END PGP SIGNATURE----- Modified: public_html/releases/cl-irc_latest.tar.gz ============================================================================== --- public_html/releases/cl-irc_latest.tar.gz (original) +++ public_html/releases/cl-irc_latest.tar.gz Thu Apr 19 16:31:12 2007 @@ -1 +1 @@ -link cl-irc-0.8.0.tar.gz \ No newline at end of file +link cl-irc-0.8.1.tar.gz \ No newline at end of file Modified: public_html/releases/cl-irc_latest.tar.gz.asc ============================================================================== --- public_html/releases/cl-irc_latest.tar.gz.asc (original) +++ public_html/releases/cl-irc_latest.tar.gz.asc Thu Apr 19 16:31:12 2007 @@ -1 +1 @@ -link cl-irc-0.8.0.tar.gz.asc \ No newline at end of file +link cl-irc-0.8.1.tar.gz.asc \ No newline at end of file

1 0

← Newer
1
2
3
4
5
6
7
8
9
...
22
Older →

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