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))))