Add Scieneer support.

  Donated by Douglas Crosher <dtc at scieneer dot com>.

backend/scl.lisp

@@ -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))))))))

condition.lisp

@@ -102,8 +102,8 @@ condition available."))
   ;; 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)

doc/design.txt

@@ -13,7 +13,7 @@ Contents
  * Motivation
  * Design goal
  * Functional requirements
-
+ * Comments on the functional requirements
 
 
 
@@ -83,6 +83,33 @@ Minimally, I'd like to support:
  - 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
 ============================
 

notes/accept-apis.txt

@@ -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)
+
+
+

usocket.asd

@@ -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"

usocket.lisp

@@ -164,8 +164,8 @@ to a vector quad."
       (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 @@ to a vector quad."
 ;;
 
 (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) ..)