[usocket-cvs] r151 - in usocket/trunk: . backend
ehuelsmann at common-lisp.net
ehuelsmann at common-lisp.net
Sun Jan 14 23:28:29 UTC 2007
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
, at 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)
+ , at 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)
+ "")
More information about the usocket-cvs
mailing list