Author: ehuelsmann Date: Tue Jan 16 17:59:49 2007 New Revision: 162
Modified: usocket/trunk/backend/allegro.lisp usocket/trunk/backend/openmcl.lisp Log: Add OpenMCL and Allegro server sockets.
Modified: usocket/trunk/backend/allegro.lisp ============================================================================== --- usocket/trunk/backend/allegro.lisp (original) +++ usocket/trunk/backend/allegro.lisp Tue Jan 16 17:59:49 2007 @@ -51,24 +51,43 @@ (with-mapped-conditions (usocket) (close (socket usocket))))
+(defun socket-listen (host port &key reuseaddress (backlog 5)) + ;; Allegro and OpenMCL socket interfaces bear very strong resemblence + ;; whatever you change here, change it also for OpenMCL + (let ((sock (with-mapped-conditions () + (apply #'socket:make-socket + (append (list :connect :passive + :reuse-address reuseaddress + :local-port port + :backlog backlog + :format :bivalent + ;; allegro now ignores :format + ) + (when (not (eql host *wildcard-host*)) + (list :local-host host))))))) + (make-stream-server-socket :socket socket))) + +(defmethod socket-accept ((socket stream-server-usocket)) + (let ((stream-sock (socket:accept-connection (socket socket)))) + (make-stream-socket :socket stream-sock :stream stream-sock)))
(defmethod get-local-address ((usocket usocket)) (hbo-to-vector-quad (socket:local-host (socket usocket))))
-(defmethod get-peer-address ((usocket usocket)) +(defmethod get-peer-address ((usocket stream-server-usocket)) (hbo-to-vector-quad (socket:remote-host (socket usocket))))
(defmethod get-local-port ((usocket usocket)) (socket:local-port (socket usocket)))
-(defmethod get-peer-port ((usocket usocket)) +(defmethod get-peer-port ((usocket stream-server-usocket)) (socket:remote-port (socket usocket)))
(defmethod get-local-name ((usocket usocket)) (values (get-local-address usocket) (get-local-port usocket)))
-(defmethod get-peer-name ((usocket usocket)) +(defmethod get-peer-name ((usocket stream-server-usocket)) (values (get-peer-address usocket) (get-peer-port usocket)))
Modified: usocket/trunk/backend/openmcl.lisp ============================================================================== --- usocket/trunk/backend/openmcl.lisp (original) +++ usocket/trunk/backend/openmcl.lisp Tue Jan 16 17:59:49 2007 @@ -51,6 +51,21 @@ (openmcl-socket:socket-connect mcl-sock) (make-stream-socket :stream mcl-sock :socket mcl-sock))))
+(defun socket-listen (host port &key reuseaddress (backlog 5)) + (let* ((sock (apply #'openmcl-socket:make-socket + (append (list :connect :passive + :reuse-address reuseaddress + :local-port port + :backlog backlog + :format :bivalent) + (when (not (eql host *wildcard-host*)) + (list :local-host host)))))) + (make-stream-server-socket sock))) + +(defmethod socket-accept ((usocket stream-server-usocket)) + (let ((sock (openmcl-socket:accept-connection (socket usocket)))) + (make-stream-socket :socket sock :stream sock))) + (defmethod socket-close ((usocket usocket)) (with-mapped-conditions (usocket) (close (socket usocket))))