Author: ehuelsmann
Date: Fri Jan 19 15:34:50 2007
New Revision: 178
Modified:
usocket/trunk/backend/allegro.lisp
usocket/trunk/backend/armedbear.lisp
usocket/trunk/backend/clisp.lisp
usocket/trunk/backend/cmucl.lisp
usocket/trunk/backend/lispworks.lisp
usocket/trunk/backend/openmcl.lisp
usocket/trunk/backend/sbcl.lisp
usocket/trunk/backend/scl.lisp
usocket/trunk/usocket.lisp
Log:
Add :element-type support for server sockets.
Modified: usocket/trunk/backend/allegro.lisp
==============================================================================
--- usocket/trunk/backend/allegro.lisp (original)
+++ usocket/trunk/backend/allegro.lisp Fri Jan 19 15:34:50 2007
@@ -36,14 +36,18 @@
:real-error condition
:socket socket))))))
+(defun to-format (element-type)
+ (if (subtypep element-type 'character)
+ :text
+ :binary))
+
(defun socket-connect (host port &key (element-type 'character))
(let ((socket))
(setf socket
(with-mapped-conditions (socket)
(socket:make-socket :remote-host (host-to-hostname host)
:remote-port port
- :format (if (subtypep element-type 'character)
- :text :binary))))
+ :format (to-format element-type))))
(make-stream-socket :socket socket :stream socket)))
(defmethod socket-close ((usocket usocket))
@@ -51,7 +55,10 @@
(with-mapped-conditions (usocket)
(close (socket usocket))))
-(defun socket-listen (host port &key reuseaddress (backlog 5))
+(defun socket-listen (host port
+ &key reuseaddress
+ (backlog 5)
+ (element-type 'character))
;; Allegro and OpenMCL socket interfaces bear very strong resemblence
;; whatever you change here, change it also for OpenMCL
(let ((sock (with-mapped-conditions ()
@@ -60,12 +67,12 @@
:reuse-address reuseaddress
:local-port port
:backlog backlog
- :format :bivalent
+ :format (to-format element-type)
;; allegro now ignores :format
)
(when (not (eql host *wildcard-host*))
(list :local-host host)))))))
- (make-stream-server-socket sock)))
+ (make-stream-server-socket sock :element-type element-type)))
(defmethod socket-accept ((socket stream-server-usocket))
(let ((stream-sock (socket:accept-connection (socket socket))))
Modified: usocket/trunk/backend/armedbear.lisp
==============================================================================
--- usocket/trunk/backend/armedbear.lisp (original)
+++ usocket/trunk/backend/armedbear.lisp Fri Jan 19 15:34:50 2007
@@ -31,7 +31,10 @@
:stream (ext:get-socket-stream sock
:element-type element-type)))))))
-(defun socket-listen (host port &key reuseaddress (backlog 5))
+(defun socket-listen (host port
+ &key reuseaddress
+ (backlog 5)
+ (element-type 'character))
(let* ((sock-addr (jnew-call ("java.net.InetSocketAddress"
"java.lang.String" "int")
(host-to-hostname host) port))
@@ -43,7 +46,7 @@
(jmethod-call sock
("bind" "java.net.SocketAddress" "int")
sock-addr backlog)
- (make-stream-server-socket sock)))
+ (make-stream-server-socket sock :element-type element-type)))
(defmethod socket-accept ((socket stream-server-usocket))
(let* ((jsock (socket socket))
Modified: usocket/trunk/backend/clisp.lisp
==============================================================================
--- usocket/trunk/backend/clisp.lisp (original)
+++ usocket/trunk/backend/clisp.lisp Fri Jan 19 15:34:50 2007
@@ -49,7 +49,10 @@
(make-stream-socket :socket socket
:stream socket))) ;; the socket is a stream too
-(defun socket-listen (host port &key reuseaddress (backlog 5))
+(defun socket-listen (host port
+ &key reuseaddress
+ (backlog 5)
+ (element-type 'character))
;; clisp 2.39 sets SO_REUSEADDRESS to 1 by default; no need to
;; to explicitly turn it on.
(let ((sock (apply #'socket:socket-server
@@ -57,10 +60,11 @@
:backlog backlog)
(when (not (eql host *wildcard-host*))
(list :interface host))))))
- (make-stream-server-socket sock)))
+ (make-stream-server-socket sock :element-type element-type)))
(defmethod socket-accept ((socket stream-server-usocket))
- (let ((stream (socket:socket-accept (socket socket))))
+ (let ((stream (socket:socket-accept (socket socket)
+ :element-type (element-type socket))))
(make-stream-socket :socket stream
:stream stream)))
Modified: usocket/trunk/backend/cmucl.lisp
==============================================================================
--- usocket/trunk/backend/cmucl.lisp (original)
+++ usocket/trunk/backend/cmucl.lisp Fri Jan 19 15:34:50 2007
@@ -69,7 +69,10 @@
(let ((err (unix:unix-errno)))
(when err (cmucl-map-socket-error err))))))
-(defun socket-listen (host port &key reuseaddress (backlog 5))
+(defun socket-listen (host port
+ &key reuseaddress
+ (backlog 5)
+ (element-type 'character))
(let ((server-sock (apply #'ext:create-inet-listener
(append (list port :stream
:backlog backlog
@@ -77,7 +80,7 @@
(when (not (eql host *wildcard-host*))
(list :host
(host-to-hbo host)))))))
- (make-stream-server-socket server-sock)))
+ (make-stream-server-socket server-sock :element-type element-type)))
(defmethod socket-accept ((usocket stream-server-usocket))
(let* ((sock (ext:accept-tcp-connection (socket usocket)))
Modified: usocket/trunk/backend/lispworks.lisp
==============================================================================
--- usocket/trunk/backend/lispworks.lisp (original)
+++ usocket/trunk/backend/lispworks.lisp Fri Jan 19 15:34:50 2007
@@ -56,13 +56,16 @@
:stream stream)
(error 'unknown-error))))
-(defun socket-listen (host port &key reuseaddress (backlog 5))
+(defun socket-listen (host port
+ &key reuseaddress
+ (backlog 5)
+ (element-type 'base-char))
(let* ((comm::*use_so_reuseaddr* reuseaddress)
(sock (with-mapped-conditions ()
#-lispworks4.1 (comm::create-tcp-socket-for-service
port :address host :backlog backlog)
#+lispworks4.1 (comm::create-tcp-socket-for-service port))))
- (make-stream-server-socket sock)))
+ (make-stream-server-socket sock :element-type element-type)))
(defmethod socket-accept ((usocket stream-server-usocket))
(let* ((sock (comm::get-fd-from-socket (socket usocket)))
Modified: usocket/trunk/backend/openmcl.lisp
==============================================================================
--- usocket/trunk/backend/openmcl.lisp (original)
+++ usocket/trunk/backend/openmcl.lisp Fri Jan 19 15:34:50 2007
@@ -40,27 +40,33 @@
(error (error 'unknown-error :socket socket :real-error condition))
(condition (signal 'unknown-condition :real-condition condition))))
+(defun to-format (element-type)
+ (if (subtypep element-type 'character)
+ :text
+ :binary))
+
(defun socket-connect (host port &key (element-type 'character))
(with-mapped-conditions ()
(let ((mcl-sock
(openmcl-socket:make-socket :remote-host (host-to-hostname host)
:remote-port port
- :format (if (subtypep element-type
- 'character)
- :text :binary))))
+ :format (to-format element-type))))
(openmcl-socket:socket-connect mcl-sock)
(make-stream-socket :stream mcl-sock :socket mcl-sock))))
-(defun socket-listen (host port &key reuseaddress (backlog 5))
+(defun socket-listen (host port
+ &key reuseaddress
+ (backlog 5)
+ (element-type 'character))
(let* ((sock (apply #'openmcl-socket:make-socket
(append (list :connect :passive
:reuse-address reuseaddress
:local-port port
:backlog backlog
- :format :bivalent)
+ :format (to-format element-type))
(when (not (eql host *wildcard-host*))
(list :local-host host))))))
- (make-stream-server-socket sock)))
+ (make-stream-server-socket sock :element-type element-type)))
(defmethod socket-accept ((usocket stream-server-usocket))
(let ((sock (openmcl-socket:accept-connection (socket usocket))))
Modified: usocket/trunk/backend/sbcl.lisp
==============================================================================
--- usocket/trunk/backend/sbcl.lisp (original)
+++ usocket/trunk/backend/sbcl.lisp Fri Jan 19 15:34:50 2007
@@ -82,14 +82,17 @@
(sb-bsd-sockets:socket-connect socket ip port))
usocket))
-(defun socket-listen (host port &key reuseaddress (backlog 5))
+(defun socket-listen (host port
+ &key reuseaddress
+ (backlog 5)
+ (element-type 'character))
(let* ((ip (host-to-vector-quad host))
(sock (make-instance 'sb-bsd-sockets:inet-socket
:type :stream :protocol :tcp)))
(setf (sb-bsd-sockets:sockopt-reuse-address sock) reuseaddress)
(sb-bsd-sockets:socket-bind sock ip port)
(sb-bsd-sockets:socket-listen sock backlog)
- (make-stream-server-socket sock)))
+ (make-stream-server-socket sock :element-type element-type)))
(defmethod socket-accept ((socket stream-server-usocket))
(let ((sock (sb-bsd-sockets:socket-accept (socket socket))))
Modified: usocket/trunk/backend/scl.lisp
==============================================================================
--- usocket/trunk/backend/scl.lisp (original)
+++ usocket/trunk/backend/scl.lisp Fri Jan 19 15:34:50 2007
@@ -41,7 +41,10 @@
:buffering :full)))
(make-stream-socket :socket socket :stream stream)))
-(defun socket-listen (host port &key reuseaddress (backlog 5))
+(defun socket-listen (host port
+ &key reuseaddress
+ (backlog 5)
+ (element-type 'character))
(let* ((host (if (eql host *wildcard-host*)
0
(host-to-hbo host)))
@@ -49,7 +52,7 @@
:host host
:reuse-address reuseaddress
:backlog backlog)))
- (make-stream-server-socket server-sock)))
+ (make-stream-server-socket server-sock :element-type element-type)))
(defmethod socket-accept ((usocket stream-server-usocket))
(let* ((sock (ext:accept-tcp-connection (socket usocket)))
Modified: usocket/trunk/usocket.lisp
==============================================================================
--- usocket/trunk/usocket.lisp (original)
+++ usocket/trunk/usocket.lisp Fri Jan 19 15:34:50 2007
@@ -249,7 +249,8 @@
Returns an object of type `stream-server-usocket'.
`reuseaddress' and `backlog' are advisory parameters for setting socket
-options at creation time.
+options at creation time. `element-type' is the element type of the
+streams to be created by `socket-accept'.
")
;; Documentation for the function
