Author: ehuelsmann Date: Sun Jan 14 18:28:28 2007 New Revision: 151 Modified: usocket/trunk/backend/clisp.lisp usocket/trunk/backend/cmucl.lisp usocket/trunk/backend/sbcl.lisp usocket/trunk/package.lisp usocket/trunk/usocket.lisp Log: Server socket support (after basic testing) for - CLISP - CMUCL - SBCL (and probably ECL) Modified: usocket/trunk/backend/clisp.lisp ============================================================================== --- usocket/trunk/backend/clisp.lisp (original) +++ usocket/trunk/backend/clisp.lisp Sun Jan 14 18:28:28 2007 @@ -48,14 +48,30 @@ :buffered t))) (make-stream-socket :socket socket :stream socket))) ;; the socket is a stream too -;; :host host -;; :port port)) + +(defun socket-listen (host port &key reuseaddress (backlog 5)) + ;; clisp 2.39 sets SO_REUSEADDRESS to 1 by default; no need to + ;; to explicitly turn it on. + (let ((sock (apply #'socket:socket-server + (append (list port + :backlog backlog) + (when (not (eql host *wildcard-host*)) + (list :interface host)))))) + (make-stream-server-socket sock))) + +(defmethod socket-accept ((socket stream-server-usocket)) + (let ((stream (socket:socket-accept (socket socket)))) + (make-stream-socket :socket stream + :stream stream))) (defmethod socket-close ((usocket usocket)) "Close socket." (with-mapped-conditions (usocket) (close (socket usocket)))) +(defmethod socket-close ((usocket stream-server-usocket)) + (socket:socket-server-close (socket usocket))) + (defmethod get-local-name ((usocket usocket)) (multiple-value-bind (address port) Modified: usocket/trunk/backend/cmucl.lisp ============================================================================== --- usocket/trunk/backend/cmucl.lisp (original) +++ usocket/trunk/backend/cmucl.lisp Sun Jan 14 18:28:28 2007 @@ -69,6 +69,23 @@ (let ((err (unix:unix-errno))) (when err (cmucl-map-socket-error err)))))) +(defun socket-listen (host port &key reuseaddress (backlog 5)) + (let ((server-sock (apply #'ext:create-inet-listener + (append (list port :stream + :backlog backlog + :reuse-address reuseaddress) + (when (not (eql host *wildcard-host*)) + (list :host + (host-to-hbo host))))))) + (make-stream-server-socket server-sock))) + +(defmethod socket-accept ((usocket stream-server-usocket)) + (let* ((sock (ext:accept-tcp-connection (socket usocket))) + (stream (sys:make-fd-stream sock :input t :output t + :element-type (element-type usocket) + :buffering :full))) + (make-stream-socket :socket sock :stream stream))) + (defmethod socket-close ((usocket usocket)) "Close socket." (with-mapped-conditions (usocket) Modified: usocket/trunk/backend/sbcl.lisp ============================================================================== --- usocket/trunk/backend/sbcl.lisp (original) +++ usocket/trunk/backend/sbcl.lisp Sun Jan 14 18:28:28 2007 @@ -82,6 +82,22 @@ (sb-bsd-sockets:socket-connect socket ip port)) usocket)) +(defun socket-listen (host port &key reuseaddress (backlog 5)) + (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))) + +(defmethod socket-accept ((socket stream-server-usocket)) + (let ((sock (sb-bsd-sockets:socket-accept (socket socket)))) + (make-stream-socket :socket sock + :stream (sb-bsd-sockets:socket-make-stream sock + :input t :output t :buffering :full + :element-type (element-type socket))))) + (defmethod socket-close ((usocket usocket)) (with-mapped-conditions (usocket) (sb-bsd-sockets:socket-close (socket usocket)))) Modified: usocket/trunk/package.lisp ============================================================================== --- usocket/trunk/package.lisp (original) +++ usocket/trunk/package.lisp Sun Jan 14 18:28:28 2007 @@ -11,6 +11,8 @@ (defpackage :usocket (:use :cl) (:export #:socket-connect ; socket constructors and methods + #:socket-listen + #:socket-accept #:socket-close #:get-local-address #:get-peer-address @@ -22,6 +24,8 @@ #:with-connected-socket ; macros #:usocket ; socket object and accessors + #:stream-usocket + #:stream-server-usocket #:socket #:socket-stream Modified: usocket/trunk/usocket.lisp ============================================================================== --- usocket/trunk/usocket.lisp (original) +++ usocket/trunk/usocket.lisp Sun Jan 14 18:28:28 2007 @@ -5,7 +5,11 @@ (in-package :usocket) +(defparameter *wildcard-host* #(0 0 0 0) + "Hostname to pass when all interfaces in the current system are to be bound.") +(defparameter *auto-port* 0 + "Port number to pass when an auto-assigned port number is wanted.") (defclass usocket () ((socket @@ -17,9 +21,9 @@ (defclass stream-usocket (usocket) ((stream - :initarg :stream - :accessor socket-stream - :documentation "Stream instance associated with the socket. + :initarg :stream + :accessor socket-stream + :documentation "Stream instance associated with the socket. Iff an external-format was passed to `socket-connect' or `socket-listen' the stream is a flexi-stream. Otherwise the stream is implementation @@ -27,8 +31,14 @@ (:documentation "")) (defclass stream-server-usocket (usocket) - () - (:documentation "")) + ((element-type + :initarg :element-type + :initform 'character + :reader element-type + :documentation "Default element type for streams created by +`socket-accept'.")) + (:documentation "Socket which listens for stream connections to +be initiated from remote sockets.")) ;;Not in use yet: ;;(defclass datagram-usocket (usocket) @@ -46,10 +56,14 @@ :socket socket :stream stream)) -(defun make-stream-server-socket (socket) - "Create a usocket-server socket type from an implementation-specific socket -object." - (make-instance 'stream-server-usocket :socket socket)) +(defun make-stream-server-socket (socket &key (element-type 'character)) + "Create a usocket-server socket type from an +implementation-specific socket object. + +The returned value is a subtype of `stream-server-usocket'." + (make-instance 'stream-server-usocket + :socket socket + :element-type element-type)) (defgeneric socket-close (usocket) (:documentation "Close a previously opened `usocket'.")) @@ -62,13 +76,19 @@ "Returns the IP address of the peer the socket is connected to.")) (defgeneric get-local-port (socket) - (:documentation "Returns the IP port of the socket.")) + (:documentation "Returns the IP port of the socket. + +This function applies to both `stream-usocket' and `server-stream-usocket' +type objects.")) (defgeneric get-peer-port (socket) (:documentation "Returns the IP port of the peer the socket to.")) (defgeneric get-local-name (socket) - (:documentation "Returns the IP address and port of the socket as values.")) + (:documentation "Returns the IP address and port of the socket as values. + +This function applies to both `stream-usocket' and `server-stream-usocket' +type objects.")) (defgeneric get-peer-name (socket) (:documentation @@ -78,14 +98,25 @@ (defmacro with-connected-socket ((var socket) &body body) "Bind `socket' to `var', ensuring socket destruction on exit. +`body' is only evaluated when `var' is bound to a non-null value. + The `body' is an implied progn form." `(let ((,var ,socket)) (unwind-protect - (progn + (when ,var ,@body) (when ,var (socket-close ,var))))) +(defmacro with-server-socket ((var server-socket) &body body) + "Bind `server-socket' to `var', ensuring socket destruction on exit. + +`body' is only evaluated when `var' is bound to a non-null value. + +The `body' is an implied progn form." + `(with-connected-socket (var server-socket) + ,@body)) + ;; ;; IPv4 utility functions ;; @@ -201,11 +232,26 @@ ;; Documentation for the function ;; -;; (defun SOCKET-LISTEN (host port &key local-ip local-port -;; reuseaddress backlog) ..) - +;; (defun SOCKET-LISTEN (host port &key reuseaddress backlog) ..) +;;###FIXME: extend with default-element-type +(setf (documentation 'socket-listen 'function) + "Bind to interface `host' on `port'. `host' should be the +representation of an interface address. The implementation is not +required to do an address lookup, making no guarantees that hostnames +will be correctly resolved. If `*wildcard-host*' is passed for `host', +the socket will be bound to all available interfaces for the IPv4 +protocol in the system. `port' can be selected by the IP stack by +passing `*auto-port*'. + +Returns an object of type `stream-server-usocket'. + +`reuseaddress' and `backlog' are advisory parameters for setting socket +options at creation time. +") ;; Documentation for the function ;; -;; (defun SOCKET-ACCEPT (socket &key element-type external-format +;; (defun SOCKET-ACCEPT (socket &key element-type ;; buffered timeout) ..) +(setf (documentation 'socket-accept 'function) + "")