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