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