[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
Erik Enge
eenge at common-lisp.net
Fri Nov 7 15:40:19 UTC 2003
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)
More information about the Net-nittin-irc-cvs
mailing list