Author: ehuelsmann Date: Wed Oct 18 02:56:33 2006 New Revision: 119 Added: usocket/trunk/backend/scl.lisp usocket/trunk/notes/accept-apis.txt Modified: usocket/trunk/condition.lisp usocket/trunk/doc/design.txt usocket/trunk/usocket.asd usocket/trunk/usocket.lisp Log: Add Scieneer support. Donated by Douglas Crosher <dtc at scieneer dot com>. Added: usocket/trunk/backend/scl.lisp ============================================================================== --- (empty file) +++ usocket/trunk/backend/scl.lisp Wed Oct 18 02:56:33 2006 @@ -0,0 +1,101 @@ +;;;; $Id: scl.lisp$ +;;;; $URL: svn://common-lisp.net/project/usocket/svn/usocket/trunk/backend/scl.lisp $ + +;;;; See LICENSE for licensing information. + +(in-package :usocket) + +(defparameter +scl-error-map+ + (append +unix-errno-condition-map+ + +unix-errno-error-map+)) + +(defun scl-map-socket-error (err &key condition socket) + (let ((usock-err (cdr (assoc err +scl-error-map+ :test #'member)))) + (cond (usock-err + (if (subtypep usock-err 'error) + (error usock-err :socket socket) + (signal usock-err :socket socket))) + (t + (error 'unknown-error + :socket socket + :real-error condition))))) + +(defun handle-condition (condition &optional (socket nil)) + "Dispatch correct usocket condition." + (etypecase condition + (ext::socket-error + (format t "erron: ~D~%" (ext::socket-errno condition)) + (scl-map-socket-error (ext::socket-errno condition) + :socket socket + :condition condition)) + (error + (error 'unknown-error + :real-condition condition + :socket socket)))) + +(defun socket-connect (host port) + (let* ((socket + (with-mapped-conditions (nil) + (ext:connect-to-inet-socket (host-to-hbo host) port :kind :stream))) + (stream (sys:make-fd-stream socket :input t :output t + :element-type 'character + :buffering :full))) + ;;###FIXME the above line probably needs an :external-format + (make-socket :socket socket :stream stream))) + +(defmethod socket-close ((usocket usocket)) + "Close socket." + (with-mapped-conditions (usocket) + (ext:close-socket (socket usocket)))) + +(defmethod get-local-name ((usocket usocket)) + (multiple-value-bind (address port) + (with-mapped-conditions (usocket) + (ext:get-socket-host-and-port (socket usocket))) + (values (hbo-to-vector-quad address) port))) + +(defmethod get-peer-name ((usocket usocket)) + (multiple-value-bind (address port) + (with-mapped-conditions (usocket) + (ext:get-peer-host-and-port (socket usocket))) + (values (hbo-to-vector-quad address) port))) + +(defmethod get-local-address ((usocket usocket)) + (nth-value 0 (get-local-name usocket))) + +(defmethod get-peer-address ((usocket usocket)) + (nth-value 0 (get-peer-name usocket))) + +(defmethod get-local-port ((usocket usocket)) + (nth-value 1 (get-local-name usocket))) + +(defmethod get-peer-port ((usocket usocket)) + (nth-value 1 (get-peer-name usocket))) + + +(defun get-host-by-address (address) + (multiple-value-bind (host errno) + (ext:lookup-host-entry (host-byte-order address)) + (cond (host + (ext:host-entry-name host)) + (t + (let ((condition (cdr (assoc errno +unix-ns-error-map+)))) + (cond (condition + (error condition :host-or-ip address)) + (t + (error 'ns-unknown-error :host-or-ip address + :real-error errno)))))))) + +(defun get-hosts-by-name (name) + (multiple-value-bind (host errno) + (ext:lookup-host-entry name) + (cond (host + (mapcar #'hbo-to-vector-quad + (ext:host-entry-addr-list host))) + (t + (let ((condition (cdr (assoc errno +unix-ns-error-map+)))) + (cond (condition + (error condition :host-or-ip name)) + (t + (error 'ns-unknown-error :host-or-ip name + :real-error errno)))))))) Modified: usocket/trunk/condition.lisp ============================================================================== --- usocket/trunk/condition.lisp (original) +++ usocket/trunk/condition.lisp Wed Oct 18 02:56:33 2006 @@ -102,8 +102,8 @@ ;; isn't really an error: there's just no data to return. ;; with lisp, we just return NIL (indicating no data) instead of ;; raising an exception... - (ns-host-not-found - ns-no-recovery) + (ns-host-not-found-error + ns-no-recovery-error) (ns-error)) (define-condition ns-unknown-error (ns-error) Modified: usocket/trunk/doc/design.txt ============================================================================== --- usocket/trunk/doc/design.txt (original) +++ usocket/trunk/doc/design.txt Wed Oct 18 02:56:33 2006 @@ -13,7 +13,7 @@ * Motivation * Design goal * Functional requirements - + * Comments on the functional requirements  @@ -83,6 +83,33 @@ - OpenMCL +The lifetime of a socket can be described with these steps: + + 1. Socket creation (socket() function) + 2. Socket initializaiton (setsockopt(), bind() and listen()/connect() funcs) + 3. Socket use (accept() / recv[from], send[to]) + 4. Socket termination (shutdown()) + 5. Socket destruction (close()) + +While for most applications steps 1-3 can be condensed into 1 (which most +implementations do), if the library wants to be extensible into other +domains than IP, a means should be provided to do socket initialization +without knowing what parameters to accept beforehand: other protocols +require parameters for setsockopt we will not know about in advance. + +There are several possibilities to address this issue: + + a. Force the 3 steps apart [hard to get done with the current status + for some implementations, as they are currently integrated in the + public interface]. + b. Find a mechanism to pass options which we want setsockopt to + be called with. Problem: what to do with implementations which + don't support setting of all options *before* the bind() call? + Does it matter that some options may be set after the bind() + call? What if they're not set before connect() [buffer size changes + have to be set before connect()]? + c. ... ? + Comments on the design above ============================ Added: usocket/trunk/notes/accept-apis.txt ============================================================================== --- (empty file) +++ usocket/trunk/notes/accept-apis.txt Wed Oct 18 02:56:33 2006 @@ -0,0 +1,173 @@ + + -*- text -*- + +Part of 'Step 3': Server/passive tcp socket interfaces supplied by +the different implementations in order to provide the same externally. + + +ABCL +==== + + - ext:make-server-socket port + - ext:socket-accept socket + - ext:socket-close socket + +Allegro +======= + + - socket:make-socket :type :stream :connect :passive + :local-port <port> :reuse-address t :backlog <nr> + :local-host <host-ip> + - socket:accept-connection sock &key wait + - close + + +clisp +===== + + - socket:socket-server &optional port &key interface backlog + - socket:socket-server-close sock + - socket:socket-server-host sock + - socket:socket-server-port sock + - socket:socket-accept sock &key element-type external-format buffered timeout + - socket:socket-options sock &rest options + +... and ofcourse, there's the raw-sockets + +CMUCL +===== + + - ext:create-inet-listener port &optional kind + &key reuseaddress backlog interface + - ext:accept-tcp-connection socket + + +LispWorks +========= + + - comm::get-fd-from-socket (socket-os-fd lispworks-socket) + - comm::create-tcp-socket-for-service port + (may use comm::*use_so_reuseaddr* for that socket option) + misses the ability to specify an interface to bind to. + - comm::socket-close + + +OpenMCL +======= + + - openmcl-socket:accept-connection + - openmcl-socket:make-socket :local-host <if> :local-port port + :reuse-address t :type :stream :connect :passive + :backlog <nr> + - close + + +SBCL +==== + + - make-instance 'inet-socket + - sb-bsd-sockets:sockopt-* + - sb-bsd-sockets:socket-bind + - sb-bsd-sockets:socket-listen + - sb-bsd-sockets:socket-accept + + +;; +;; +;; The above APIs are good enough to implement a simple +;; accept interface, but doesn't give access to specifying +;; socket options before the socket is bound to the interface +;; ==> This may only actually be required for SO_REUSEADDRESS?!??? +;; +;; The other option would be to use lots of FFI - where needed - +;; and use the (mostly internal) glue routines from the implementations + + +ABCL +==== + + With ABCL - lacking a good sockets API - it's still possible to implement + whatever we need to get good access... + + +Allegro +======= + + Hmm. The accept function in this implementation does not allow limiting + connections to a given host/ip, but it does allow to create sockets + with mostly the right options. + + Is that enough reason to do this entirely in ffi?! + + Also, doing this in FFI would require to reverse engineer the creation + of socket streams. Maybe Franz tech support could help there though. + + Need to investigate the IPC_* symbols an the sockets package: + there are lots of functions which look like they should be useable. + + +clisp +===== + + This implementation allows access to the full sockets as described + in http://clisp.cons.org/impnotes/rawsock.html. + + +CMUCL +===== + + Provides (in unix package): + + - unix-accept + - unix-bind + - unix-listen + - unix-socket + + Provides (in extentions): + + - inet-sockaddr + - get-socket-option + - set-socket-option + - create-inet-listener port &key host reuse-address backlog + + +LispWorks +========= + + The implementation provides a lot of undocumented functions the library + could tap into: + + - comm::socket + - comm::bind + - comm::accept + - comm::getsockopt + - comm::setsockopt + - comm::initialize-sockaddr_in (helper) + - comm::streams-from-fd (helper) + + +OpenMCL +======= + + - make-socket provides all options which we'll need to set, + it doesn't however provide access to [gs]etsockopt... + + +SBCL +==== + + provides (in sb-bsd-sockets): + socket-bind + socket-accept + sokcet-listen + + provides (in sb-bsd-sockets-internal [sockint]): + getsockopt + setsockopt + + SO-* constants + TCP-* constant(s) + AF-* constants (and, since AF-* == IF-*, we don't need others) + + + Modified: usocket/trunk/usocket.asd ============================================================================== --- usocket/trunk/usocket.asd (original) +++ usocket/trunk/usocket.asd Wed Oct 18 02:56:33 2006 @@ -28,6 +28,8 @@ :depends-on ("condition")) #+cmu (:file "cmucl" :pathname "backend/cmucl" :depends-on ("condition")) + #+scl (:file "scl" :pathname "backend/scl" + :depends-on ("condition")) #+sbcl (:file "sbcl" :pathname "backend/sbcl" :depends-on ("condition")) #+lispworks (:file "lispworks" :pathname "backend/lispworks" Modified: usocket/trunk/usocket.lisp ============================================================================== --- usocket/trunk/usocket.lisp (original) +++ usocket/trunk/usocket.lisp Wed Oct 18 02:56:33 2006 @@ -164,8 +164,8 @@ (string (let ((ip (ignore-errors (dotted-quad-to-vector-quad host)))) (if (and ip (= 4 (length ip))) - ip - (host-to-hbo (get-host-by-name host))))) + (host-byte-order ip) + (host-to-hbo (get-host-by-name host))))) ((vector t 4) (host-byte-order host)) (integer host)))) @@ -186,9 +186,19 @@ ;; (setf (documentation 'socket-connect 'function) - "Connect to `host' on `port'. `host' is assumed to be a string of + "Connect to `host' on `port'. `host' is assumed to be a string or an IP address represented in vector notation, such as #(192 168 1 1). `port' is assumed to be an integer. Returns a usocket object.") +;; Documentation for the function +;; +;; (defun SOCKET-LISTEN (host port &key local-ip local-port +;; reuseaddress backlog) ..) + + +;; Documentation for the function +;; +;; (defun SOCKET-ACCEPT (socket &key element-type external-format +;; buffered timeout) ..)