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)