- 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
+ * (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.
+
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
-
-
-
+