[usocket-cvs] r101 - public_html usocket/trunk usocket/trunk/backend
ehuelsmann at common-lisp.net
ehuelsmann at common-lisp.net
Thu Feb 16 23:36:47 UTC 2006
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=%2Fusocket%2Ftrunk%2Fnotes%2Faddress-apis.txt&rev=0&sc=0"
>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.
More information about the usocket-cvs
mailing list