[Unetwork-cvs] CVS update: unetwork/src/base-cmu.lisp

[Matthieu Villeneuve]

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