Author: ehuelsmann Date: Thu Feb 16 17:36:45 2006 New Revision: 101 Modified: public_html/index.shtml usocket/trunk/backend/allegro.lisp usocket/trunk/backend/armedbear.lisp usocket/trunk/backend/clisp.lisp usocket/trunk/backend/cmucl.lisp usocket/trunk/backend/lispworks.lisp usocket/trunk/backend/openmcl.lisp usocket/trunk/backend/sbcl.lisp usocket/trunk/usocket.lisp Log: First step at implementing socket addresses. Also update site. Modified: public_html/index.shtml ============================================================================== --- public_html/index.shtml (original) +++ public_html/index.shtml Thu Feb 16 17:36:45 2006 @@ -142,27 +142,37 @@ <td class="PASS">PASS</td> </tr> <tr> - <td rowspan="2">Add functions to retrieve socket properties:<br /> + <td rowspan="3">Add functions to retrieve socket properties:<br /> Local and remote IP address and port.</td> <td><a href="http://common-lisp.net/websvn/filedetails.php?repname=usocket&path=%2Fus..." >Investigate interfaces provided</a></td> - <td class="TODO">TODO</td> - <td class="TODO">TODO</td> - <td class="TODO">TODO</td> - <td class="TODO">TODO</td> - <td class="TODO">TODO</td> - <td class="TODO">TODO</td> - <td class="TODO">TODO</td> + <td class="DONE">DONE</td> <!-- SBCL --> + <td class="DONE">DONE</td> <!-- CMUCL --> + <td class="DONE">DONE</td> <!-- ABCL --> + <td class="DONE">DONE</td> <!-- clisp --> + <td class="DONE">DONE</td> <!-- Allegro --> + <td class="DONE">DONE</td> <!-- LispWorks --> + <td class="DONE">DONE</td> <!-- OpenMCL --> </tr> <tr> <td>Implement it.</td> - <td class="TODO">TODO</td> - <td class="TODO">TODO</td> - <td class="TODO">TODO</td> - <td class="TODO">TODO</td> - <td class="TODO">TODO</td> - <td class="TODO">TODO</td> - <td class="TODO">TODO</td> + <td class="WIP">WIP</td> + <td class="WIP">WIP</td> + <td class="WIP">WIP</td> + <td class="WIP">WIP</td> + <td class="WIP">WIP</td> + <td class="WIP">WIP</td> + <td class="WIP">WIP</td> + </tr> + <tr> + <td>Implementation test-suite status</td> + <td class="UNTESTED">?</td> + <td class="UNTESTED">?</td> + <td class="UNTESTED">?</td> + <td class="UNTESTED">?</td> + <td class="UNTESTED">?</td> + <td class="UNTESTED">?</td> + <td class="UNTESTED">?</td> </tr> <tr> <td rowspan="2">Add support for passive (connection-accepting/server) Modified: usocket/trunk/backend/allegro.lisp ============================================================================== --- usocket/trunk/backend/allegro.lisp (original) +++ usocket/trunk/backend/allegro.lisp Thu Feb 16 17:36:45 2006 @@ -50,6 +50,26 @@ (close (socket usocket)))) +(defmethod get-local-address ((usocket usocket)) + (hbo-to-vector-quad (socket:local-host (socket usocket)))) + +(defmethod get-peer-address ((usocket 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)) + (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)) + (values (get-peer-address usocket) + (get-peer-port usocket))) + (defun get-host-by-address (address) (with-mapped-conditions () Modified: usocket/trunk/backend/armedbear.lisp ============================================================================== --- usocket/trunk/backend/armedbear.lisp (original) +++ usocket/trunk/backend/armedbear.lisp Thu Feb 16 17:36:45 2006 @@ -24,7 +24,7 @@ (ext:socket-close (socket usocket)))) -#.(if (find-symbol "SOCKET-LOCAL-ADDRESS" :ext) +#.(if (null (find-symbol "SOCKET-LOCAL-ADDRESS" :ext)) ;; abcl 0.0.9 compat code '(progn (declaim (inline %socket-address %socket-port)) @@ -51,4 +51,26 @@ (defun socket-peer-port (socket) "Returns the peer port number of the given socket." (%socket-port socket "getPort"))) - '(progn)) + '(progn + (import (:socket-peer-port :socket-peer-address + :socket-local-port :socket-local-address) :ext))) + +(defmethod get-local-address ((usocket usocket)) + (dotted-quad-to-vector-quad (socket-local-address (socket usocket)))) + +(defmethod get-peer-address ((usocket usocket)) + (dotted-quad-to-vector-quad (socket-peer-address (socket usocket)))) + +(defmethod get-local-port ((usocket usocket)) + (socket-local-port (socket usocket))) + +(defmethod get-peer-port ((usocket usocket)) + (socket-peer-port (socket usocket))) + +(defmethod get-local-name ((usocket usocket)) + (values (get-local-address usocket) + (get-local-port usocket))) + +(defmethod get-peer-name ((usocket usocket)) + (values (get-peer-address usocket) + (get-peer-port usocket))) Modified: usocket/trunk/backend/clisp.lisp ============================================================================== --- usocket/trunk/backend/clisp.lisp (original) +++ usocket/trunk/backend/clisp.lisp Thu Feb 16 17:36:45 2006 @@ -56,3 +56,27 @@ (with-mapped-conditions (usocket) (close (socket usocket)))) +(defmethod get-local-name ((usocket usocket)) + (multiple-value-bind + (address port) + (socket:socket-stream-local (socket usocket) nil) + (values (dotted-quad-to-vector-quad address) port))) + +(defmethod get-peer-name ((usocket usocket)) + (multiple-value-bind + (address port) + (socket:socket-stream-peer (socket usocket) nil) + (values (dotted-quad-to-vector-quad address) port))) + +(defmethod get-local-address ((usocket usocket)) + (nth-value 1 (get-local-name usocket))) + +(defmethod get-peer-address ((usocket usocket)) + (nth-value 1 (get-peer-name usocket))) + +(defmethod get-local-port ((usocket usocket)) + (nth-value 2 (get-local-name usocket))) + +(defmethod get-peer-port ((usocket usocket)) + (nth-value 2 (get-peer-name usocket))) + Modified: usocket/trunk/backend/cmucl.lisp ============================================================================== --- usocket/trunk/backend/cmucl.lisp (original) +++ usocket/trunk/backend/cmucl.lisp Thu Feb 16 17:36:45 2006 @@ -74,6 +74,29 @@ (with-mapped-conditions (usocket) (ext:close-socket (socket usocket)))) +(defmethod get-local-name ((usocket usocket)) + (multiple-value-bind + (address port) + (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) + (ext:get-peer-host-and-port (socket usocket)) + (values (hbo-to-vector-quad address) port))) + +(defmethod get-local-address ((usocket usocket)) + (nth-value 1 (get-local-name usocket))) + +(defmethod get-peer-address ((usocket usocket)) + (nth-value 1 (get-peer-name usocket))) + +(defmethod get-local-port ((usocket usocket)) + (nth-value 2 (get-local-name usocket))) + +(defmethod get-peer-port ((usocket usocket)) + (nth-value 2 (get-peer-name usocket))) (defun get-host-by-address (address) Modified: usocket/trunk/backend/lispworks.lisp ============================================================================== --- usocket/trunk/backend/lispworks.lisp (original) +++ usocket/trunk/backend/lispworks.lisp Thu Feb 16 17:36:45 2006 @@ -64,3 +64,26 @@ "Close socket." (close (socket-stream usocket))) +(defmethod get-local-name ((usocket usocket)) + (multiple-value-bind + (address port) + (comm:get-socket-address (socket usocket)) + (values (hbo-to-vector-quad address) port))) + +(defmethod get-peer-name ((usocket usocket)) + (multiple-value-bind + (address port) + (comm:get-socket-peer-address (socket usocket)) + (values (hbo-to-vector-quad address) port))) + +(defmethod get-local-address ((usocket usocket)) + (nth-value 1 (get-local-name usocket))) + +(defmethod get-peer-address ((usocket usocket)) + (nth-value 1 (get-peer-name usocket))) + +(defmethod get-local-port ((usocket usocket)) + (nth-value 2 (get-local-name usocket))) + +(defmethod get-peer-port ((usocket usocket)) + (nth-value 2 (get-peer-name usocket))) Modified: usocket/trunk/backend/openmcl.lisp ============================================================================== --- usocket/trunk/backend/openmcl.lisp (original) +++ usocket/trunk/backend/openmcl.lisp Thu Feb 16 17:36:45 2006 @@ -51,3 +51,23 @@ (defmethod socket-close ((usocket usocket)) (with-mapped-conditions (usocket) (close (socket usocket)))) + +(defmethod get-local-address ((usocket usocket)) + (hbo-to-vector-quad (openmcl-socket:local-host (socket usocket)))) + +(defmethod get-peer-address ((usocket usocket)) + (hbo-to-vector-quad (openmcl-socket:remote-host (socket usocket)))) + +(defmethod get-local-port ((usocket usocket)) + (openmcl-socket:local-port (socket usocket))) + +(defmethod get-peer-port ((usocket usocket)) + (openmcl-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)) + (values (get-peer-address usocket) + (get-peer-port usocket))) Modified: usocket/trunk/backend/sbcl.lisp ============================================================================== --- usocket/trunk/backend/sbcl.lisp (original) +++ usocket/trunk/backend/sbcl.lisp Thu Feb 16 17:36:45 2006 @@ -61,7 +61,7 @@ (defun socket-connect (host port) (let* ((socket (make-instance 'sb-bsd-sockets:inet-socket - :type type :protocol :tcp)) + :type :stream :protocol :tcp)) (stream (sb-bsd-sockets:socket-make-stream socket :input t :output t @@ -78,6 +78,23 @@ (with-mapped-conditions (usocket) (sb-bsd-sockets:socket-close (socket usocket)))) +(defmethod get-local-name ((usocket usocket)) + (sb-bsd-sockets:socket-name (socket usocket))) + +(defmethod get-peer-name ((usocket usocket)) + (sb-bsd-sockets:socket-peername (socket usocket))) + +(defmethod get-local-address ((usocket usocket)) + (nth-value 1 (get-local-name usocket))) + +(defmethod get-peer-address ((usocket usocket)) + (nth-value 1 (get-peer-name usocket))) + +(defmethod get-local-port ((usocket usocket)) + (nth-value 2 (get-local-name usocket))) + +(defmethod get-peer-port ((usocket usocket)) + (nth-value 2 (get-peer-name usocket))) (defun get-host-by-address (address) Modified: usocket/trunk/usocket.lisp ============================================================================== --- usocket/trunk/usocket.lisp (original) +++ usocket/trunk/usocket.lisp Thu Feb 16 17:36:45 2006 @@ -30,6 +30,27 @@ (defgeneric socket-close (usocket) (:documentation "Close a previously opened `usocket'.")) +(defgeneric get-local-address (socket) + (:documentation "Returns the IP address of the socket.")) + +(defgeneric get-peer-address (socket) + (:documentation + "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.")) + +(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.")) + +(defgeneric get-peer-name (socket) + (:documentation + "Returns the IP address and port of the peer +the socket is connected to as values.")) + (defmacro with-connected-socket ((var socket) &body body) "Bind `socket' to `var', ensuring socket destruction on exit.