From mvilleneuve at common-lisp.net Sun Sep 19 18:58:56 2004 From: mvilleneuve at common-lisp.net (Matthieu Villeneuve) Date: Sun, 19 Sep 2004 20:58:56 +0200 Subject: [Unetwork-cvs] CVS update: unetwork/src/base-cmu.lisp Message-ID: Update of /project/unetwork/cvsroot/unetwork/src In directory common-lisp.net:/tmp/cvs-serv16125 Modified Files: base-cmu.lisp Log Message: Allow specifying stream element-type in server-socket-accept Date: Sun Sep 19 20:58:56 2004 Author: mvilleneuve Index: unetwork/src/base-cmu.lisp diff -u unetwork/src/base-cmu.lisp:1.2 unetwork/src/base-cmu.lisp:1.3 --- unetwork/src/base-cmu.lisp:1.2 Tue Mar 23 14:02:21 2004 +++ unetwork/src/base-cmu.lisp Sun Sep 19 20:58:55 2004 @@ -41,14 +41,14 @@ "Open a server socket on localhost on specified port." (ext:create-inet-listener port)) -(defun server-socket-accept (server-socket &key timeout) +(defun server-socket-accept (server-socket &key (type 'character) timeout) "Accept a connection on a server socket. Return the resulting socket." (when (sys:wait-until-fd-usable server-socket :input timeout) (let* ((sock (ext:accept-tcp-connection server-socket)) (stream (sys:make-fd-stream sock :input t :output t - :element-type '(unsigned-byte 8)))) + :element-type type))) (make-instance 'socket :sock sock :stream stream)))) (defun close-server-socket (server-socket) From mvilleneuve at common-lisp.net Sun Sep 19 20:41:34 2004 From: mvilleneuve at common-lisp.net (Matthieu Villeneuve) Date: Sun, 19 Sep 2004 22:41:34 +0200 Subject: [Unetwork-cvs] CVS update: unetwork/src/base-cmu.lisp Message-ID: Update of /project/unetwork/cvsroot/unetwork/src In directory common-lisp.net:/tmp/cvs-serv15499 Modified Files: base-cmu.lisp Log Message: Unify interface wrt. stream types Date: Sun Sep 19 22:41:34 2004 Author: mvilleneuve Index: unetwork/src/base-cmu.lisp diff -u unetwork/src/base-cmu.lisp:1.3 unetwork/src/base-cmu.lisp:1.4 --- unetwork/src/base-cmu.lisp:1.3 Sun Sep 19 20:58:55 2004 +++ unetwork/src/base-cmu.lisp Sun Sep 19 22:41:34 2004 @@ -22,16 +22,15 @@ (defun open-socket (host port &key (type :text)) "Open a socket on specified host and port. Keyword argument TYPE can be either :TEXT or :BINARY (defaults to :TEXT)." - (handler-case - (let* ((sock (ext:connect-to-inet-socket host port)) - (stream (sys:make-fd-stream - sock - :input t :output t - :element-type (if (eq type :text) - 'base-char - '(unsigned-byte 8))))) - (make-instance 'socket :sock sock :stream stream)) - (simple-error () (error 'connection-error :host host)))) + (let ((type (translate-type type))) + (handler-case + (let* ((sock (ext:connect-to-inet-socket host port)) + (stream (sys:make-fd-stream + sock + :input t :output t + :element-type type))) + (make-instance 'socket :sock sock :stream stream)) + (simple-error () (error 'connection-error :host host))))) (defun close-socket (socket) "Close a socket." @@ -39,18 +38,24 @@ (defun open-server-socket (port) "Open a server socket on localhost on specified port." - (ext:create-inet-listener port)) + (ext:create-inet-listener port :stream :reuse-address t)) -(defun server-socket-accept (server-socket &key (type 'character) timeout) - "Accept a connection on a server socket. Return the -resulting socket." - (when (sys:wait-until-fd-usable server-socket :input timeout) - (let* ((sock (ext:accept-tcp-connection server-socket)) - (stream (sys:make-fd-stream sock - :input t :output t - :element-type type))) - (make-instance 'socket :sock sock :stream stream)))) +(defun server-socket-accept (server-socket &key (type :text) timeout) + "Accept a connection on a server socket. Return the resulting socket. +Keyword argument TYPE can be either :TEXT or :BINARY (defaults to :TEXT)." + (let ((type (translate-type type))) + (when (sys:wait-until-fd-usable server-socket :input timeout) + (let* ((sock (ext:accept-tcp-connection server-socket)) + (stream (sys:make-fd-stream sock + :input t :output t + :element-type type))) + (make-instance 'socket :sock sock :stream stream))))) (defun close-server-socket (server-socket) "Close a server socket." (unix:unix-close server-socket)) + +(defun translate-type (type) + (ecase type + (:text 'base-char) + (:binary '(unsigned-byte 8))))