From ehuelsmann at common-lisp.net Fri Apr 15 16:01:24 2005 From: ehuelsmann at common-lisp.net (Erik Huelsmann) Date: Fri, 15 Apr 2005 18:01:24 +0200 (CEST) Subject: [Cl-irc-cvs] CVS update: cl-irc/package.lisp Message-ID: <20050415160124.6C7A188665@common-lisp.net> Update of /project/cl-irc/cvsroot/cl-irc In directory common-lisp.net:/tmp/cvs-serv27599 Modified Files: package.lisp Log Message: Export forgotten symbol for mode-tracking class. Date: Fri Apr 15 18:01:23 2005 Author: ehuelsmann Index: cl-irc/package.lisp diff -u cl-irc/package.lisp:1.7 cl-irc/package.lisp:1.8 --- cl-irc/package.lisp:1.7 Mon Mar 21 23:32:35 2005 +++ cl-irc/package.lisp Fri Apr 15 18:01:22 2005 @@ -1,4 +1,4 @@ -;;;; $Id: package.lisp,v 1.7 2005/03/21 22:32:35 ehuelsmann Exp $ +;;;; $Id: package.lisp,v 1.8 2005/04/15 16:01:22 ehuelsmann Exp $ ;;;; $Source: /project/cl-irc/cvsroot/cl-irc/package.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -18,6 +18,7 @@ :server-name :no-such-reply :irc-mode + :boolean-value-mode :single-value-mode :list-value-mode :add-mode From ehuelsmann at common-lisp.net Sun Apr 17 19:45:44 2005 From: ehuelsmann at common-lisp.net (Erik Huelsmann) Date: Sun, 17 Apr 2005 21:45:44 +0200 (CEST) Subject: [Cl-irc-cvs] CVS update: cl-irc/protocol.lisp cl-irc/command.lisp cl-irc/utility.lisp Message-ID: <20050417194544.18BB718C6FC@common-lisp.net> Update of /project/cl-irc/cvsroot/cl-irc In directory common-lisp.net:/tmp/cvs-serv5039 Modified Files: protocol.lisp command.lisp utility.lisp Log Message: Share connecting code between normal and dcc connections. Also remove 'socket' slot from 'dcc-connection' as it has been removed from 'connection'. Date: Sun Apr 17 21:45:43 2005 Author: ehuelsmann Index: cl-irc/protocol.lisp diff -u cl-irc/protocol.lisp:1.22 cl-irc/protocol.lisp:1.23 --- cl-irc/protocol.lisp:1.22 Sun Mar 27 23:40:30 2005 +++ cl-irc/protocol.lisp Sun Apr 17 21:45:41 2005 @@ -1,4 +1,4 @@ -;;;; $Id: protocol.lisp,v 1.22 2005/03/27 21:40:30 ehuelsmann Exp $ +;;;; $Id: protocol.lisp,v 1.23 2005/04/17 19:45:41 ehuelsmann Exp $ ;;;; $Source: /project/cl-irc/cvsroot/cl-irc/protocol.lisp,v $ ;;;; See LICENSE for licensing information. @@ -394,12 +394,7 @@ (output-stream :initarg :output-stream :accessor output-stream - :initform t) - (socket - :initarg :socket - :accessor socket - :documentation "The actual socket object for the connection -between the two users."))) + :initform t))) (defmethod print-object ((object dcc-connection) stream) "Print the object for the Lisp reader." @@ -414,23 +409,10 @@ (remote-address nil) (remote-port nil) (output-stream t)) - #+sbcl - (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 output-stream)) - #+openmcl - (let ((socket-stream (ccl:make-socket :remote-host remote-address - :remote-port remote-port))) - (make-instance 'dcc-connection - :user user - :stream socket-stream - :output-stream output-stream)) - #-(or openmcl sbcl) - (warn "make-dcc-connection not supported for this implementation.")) + (make-instance 'dcc-connection + :user user + :stream (socket-stream remote-address remote-port) + :output-stream output-stream)) (defgeneric dcc-close (connection)) (defgeneric send-dcc-message (connection message)) Index: cl-irc/command.lisp diff -u cl-irc/command.lisp:1.9 cl-irc/command.lisp:1.10 --- cl-irc/command.lisp:1.9 Sat Mar 19 17:53:38 2005 +++ cl-irc/command.lisp Sun Apr 17 21:45:42 2005 @@ -1,4 +1,4 @@ -;;;; $Id: command.lisp,v 1.9 2005/03/19 16:53:38 ehuelsmann Exp $ +;;;; $Id: command.lisp,v 1.10 2005/04/17 19:45:42 ehuelsmann Exp $ ;;;; $Source: /project/cl-irc/cvsroot/cl-irc/command.lisp,v $ ;;;; See LICENSE for licensing information. @@ -230,7 +230,7 @@ (defmethod stats ((connection connection) &optional (query "") (target "")) (send-irc-message connection :stats nil query target)) - + (defmethod links ((connection connection) &optional (remote-server "") (server-mask "")) (send-irc-message connection :links nil remote-server server-mask)) @@ -238,38 +238,6 @@ (defmethod time- ((connection connection) &optional (target "")) (send-irc-message connection :time nil target)) -(defun connect-to-server-socket (host port) - #+sbcl - (let ((s (make-instance 'sb-bsd-sockets:inet-socket - :type :stream - :protocol :tcp))) - (sb-bsd-sockets:socket-connect s (car (sb-bsd-sockets:host-ent-addresses - (sb-bsd-sockets:get-host-by-name host))) port) - s) - ) - -(defun socket-stream (socket) - #+sbcl - (sb-bsd-sockets:socket-make-stream socket - :element-type 'character - :input t - :output t - :buffering :none) - #+openmcl - socket) - -(defun socket-connect (server port) - #+lispworks (comm:open-tcp-stream server port :errorp t) - #+cmu (sys:make-fd-stream (ext:connect-to-inet-socket server port) - :input t - :output t - :element-type 'character) - #+allegro (socket:make-socket :remote-host server :remote-port port) - #+sbcl (socket-stream (connect-to-server-socket server port)) - #+openmcl (ccl:make-socket :remote-host server :remote-port port) - #+armedbear (ext:get-socket-stream (ext:make-socket server port)) - ) - (defun connect (&key (nickname *default-nickname*) (username nil) (realname nil) Index: cl-irc/utility.lisp diff -u cl-irc/utility.lisp:1.6 cl-irc/utility.lisp:1.7 --- cl-irc/utility.lisp:1.6 Mon Mar 21 19:14:32 2005 +++ cl-irc/utility.lisp Sun Apr 17 21:45:42 2005 @@ -1,4 +1,4 @@ -;;;; $Id: utility.lisp,v 1.6 2005/03/21 18:14:32 ehuelsmann Exp $ +;;;; $Id: utility.lisp,v 1.7 2005/04/17 19:45:42 ehuelsmann Exp $ ;;;; $Source: /project/cl-irc/cvsroot/cl-irc/utility.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -105,6 +105,41 @@ (third (ldb (byte 8 8) integer)) (fourth (ldb (byte 8 0) integer))) (vector first second third fourth))) + +(defun connect-to-server-socket (host port) + #+sbcl + (let ((s (make-instance 'sb-bsd-sockets:inet-socket + :type :stream + :protocol :tcp))) + (sb-bsd-sockets:socket-connect s (car (sb-bsd-sockets:host-ent-addresses + (sb-bsd-sockets:get-host-by-name host))) port) + s) + ) + +(defun socket-stream (socket) + #+sbcl + (sb-bsd-sockets:socket-make-stream socket + :element-type 'character + :input t + :output t + :buffering :none) + ) + +(defun socket-connect (server port) + "Create a socket connected to `server':`port' and return stream for it." + #+lispworks (comm:open-tcp-stream server port :errorp t) + #+cmu (sys:make-fd-stream (ext:connect-to-inet-socket server port) + :input t + :output t + :element-type 'character) + #+allegro (socket:make-socket :remote-host server :remote-port port) + #+sbcl (socket-stream (connect-to-server-socket server port)) + #+openmcl (ccl:make-socket :remote-host server :remote-port port) + #+armedbear (ext:get-socket-stream (ext:make-socket server port)) + #-(or lispworks cmu allegro sbcl openmcl armedbear) + (warn "socket-connect not supported for this implementation.") + ) + (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 From ehuelsmann at common-lisp.net Sun Apr 17 21:14:35 2005 From: ehuelsmann at common-lisp.net (Erik Huelsmann) Date: Sun, 17 Apr 2005 23:14:35 +0200 (CEST) Subject: [Cl-irc-cvs] CVS update: cl-irc/protocol.lisp Message-ID: <20050417211435.92C0D18C6FC@common-lisp.net> Update of /project/cl-irc/cvsroot/cl-irc In directory common-lisp.net:/tmp/cvs-serv9455 Modified Files: protocol.lisp Log Message: Remove *all* references to 'socket'. Close the stream the same way 'quit' does. Date: Sun Apr 17 23:14:30 2005 Author: ehuelsmann Index: cl-irc/protocol.lisp diff -u cl-irc/protocol.lisp:1.23 cl-irc/protocol.lisp:1.24 --- cl-irc/protocol.lisp:1.23 Sun Apr 17 21:45:41 2005 +++ cl-irc/protocol.lisp Sun Apr 17 23:14:30 2005 @@ -1,4 +1,4 @@ -;;;; $Id: protocol.lisp,v 1.23 2005/04/17 19:45:41 ehuelsmann Exp $ +;;;; $Id: protocol.lisp,v 1.24 2005/04/17 21:14:30 ehuelsmann Exp $ ;;;; $Source: /project/cl-irc/cvsroot/cl-irc/protocol.lisp,v $ ;;;; See LICENSE for licensing information. @@ -432,10 +432,11 @@ ;; argh. I want to name this quit but that gives me issues with ;; generic functions. need to resolve. (defmethod dcc-close ((connection dcc-connection)) + #+(and sbcl (not sb-thread)) + (sb-sys:invalidate-descriptor (sb-sys:fd-stream-fd (stream connection))) (close (dcc-stream connection)) (setf (user connection) nil) (setf *dcc-connections* (remove connection *dcc-connections*)) - #+sbcl (sb-bsd-sockets:socket-close (socket connection)) ) (defmethod connectedp ((connection dcc-connection))