[usocket-cvs] r178 - in usocket/trunk: . backend - usocket-cvs@common-lisp.net - mailman3.common-lisp.net

19 Jan 2007

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

    