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