- usocket-cvs@common-lisp.net - mailman3.common-lisp.net

[usocket-cvs] r558 - public_html
by Chun Tian 15 Sep '10

15 Sep '10

Author: ctian Date: Tue Sep 14 23:35:27 2010 New Revision: 558 Log: API documentation for SOCKET-SERVER was added. Modified: public_html/api-docs.shtml Modified: public_html/api-docs.shtml ============================================================================== --- public_html/api-docs.shtml (original) +++ public_html/api-docs.shtml Tue Sep 14 23:35:27 2010 @@ -1,7 +1,7 @@ <!DOCTYPE HTML PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd"> -<html xml:lang="en" xmlns="http://www.w3.org/1999/xhtml" lang="en"> +<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en"> <head> - <title>usocket API documentation</title> + <title>USOCKET API documentation</title> <link rel="stylesheet" type="text/css" href="style.css"> <meta http-equiv="Content-Type" content="text/html; charset=ISO-8859-1"> @@ -34,9 +34,8 @@ <li><a href="#docs">API documentation</a></li> <li><a href="#faqs">How do I ... (FAQ)</a></li> </ul> -<h1><a name="docs">usocket API documentation</a></h1> -$Id: api-docs.shtml 417 2008-08-07 20:29:51Z -ehuelsmann $ +<h1><a name="docs">USOCKET API documentation</a></h1> +$Id$ Work in progress. Please note that we're committed to the interface described below for the entire 0.x phase of the library. When 1.0 comes @@ -44,10 +43,15 @@ and guarantees may change because of it. <h2>Conventions</h2> <dl> - <dt>Specification of a host parameter</dt> - <dd>A host parameter may be any one of + <dt>Specification of a host or local-host +parameter</dt> + <dd>A host or local-host parameter may be any one +of <ul> <li>32-bit positive integer,</li> + <li>A four element integer list representing IPv4 address, i.e. +#(127 0 0 1) + </li> <li>a string containing an IP addres in dotted notation, or</li> <li> a host name to be resolved through DNS lookup.</li> </ul> @@ -63,16 +67,13 @@ and port specified. The return value is a socket object of class <a href="#stream-usocket">stream-usocket</a>, or - - - <a href="#datagram-usocket">datagram-usocket</a>. protocol should be <code>:stream</code> (default) or <code>:datagram</code>, which means TCP or -UDP. <cite>(Start from USOCKET 0.5)</cite> +UDP <cite>(Start from USOCKET 0.5)</cite> element-type argument is used in the construction of the associated stream, i.e. <code>'character</code> or <code>'(unsigned-byte 8)</code>, only used by TCP. @@ -169,7 +170,13 @@ the datagram socket -was created by <a href="#socket-connect">socket-connect</a> +was +created +by + + + + <a href="#socket-connect">socket-connect</a> with a timeout keyword argument, this function will block at most that timeout value (in seconds). (Start from USOCKET 0.5) socket should be a <a href="#datagram-usocket">datagram-usocket</a>. @@ -197,14 +204,16 @@ (EINTR).  The second value is a real number indicating the time remaining within the timeout period or nil if none. -Without the READY-ONLY arg, WAIT-FOR-INPUT will return all sockets in +Without the ready-only argument, WAIT-FOR-INPUT will return +all sockets in the original list you passed it. This prevents a new list from being consed up. Some users of USOCKET were reluctant to use it if it wouldn't behave that way, expecting it to cost significant performance to do the associated garbage collection. -Without the READY-ONLY arg, you need to check the socket STATE slot for -the values documented in usocket.lisp in the usocket class. +Without the ready-only arg, you need to check the socket +STATE slot for +the values documented in <a href="#usocket">usocket</a> class. </dd> <dt class="sym"><a name="socket-server"></a>socket-server @@ -213,8 +222,58 @@ multi-threading </dt> <dd> - Create a simple TCP or UDP socket server ... (Start from USOCKET -0.5) + Create a simple TCP or UDP socket server. (Start from USOCKET +0.5) + + host names a local interface, + port names a local port, + function names a function object, which is used to handle +TCP or UDP connections, the actual API of this function will be +explained later. + arguments is a list used for passing extra arguments to +user-defined function. + in-new-thread is a boolean, default is <code>nil</code>. +When it's <code>T</code>, the server will be created in a new thread +and socket-server returns immediately in current thread. + protocol could be either <code>:stream</code> (default) +or <code>:datagram</code>, which decide the socket server is TCP +server or UDP server. + timeout is UDP only, it provides the internal <a + href="#socket-receive">socket-receive</a> call (in UDP event +loop of the socket server) a read timeout, default value is 1 (second). + max-buffer-size is UDP only, it's the max UDP data buffer +size when handling UDP packets, default value is 65507. + element-type is TCP only, it's element-type of the stream +provided for user-defined function, + reuse-address is TCP only, it's a boolean option for +internal call of socket-listen in the socket server, + multi-threading is TCP only, it's a boolean, default value +is <code>nil</code>. When it's <code>T</code>, each client connection +will cause a new thread being created to handle that client, so that +the TCP server could handle multiple clients at the same time. (Note: +since UDP server is connectionless, it can always handle multiple +clients, as long as the handler function run fast enough) + + The handler function for TCP is stream-based. A template +function +is this one: + <pre>(defun default-tcp-handler (stream) ; null (declare (type stream stream)) (terpri stream))</pre> + Note: 1. you don't need to close the stream as <a + href="#socket-server">socket-server</a> +will do that for you. +2. More function arguments can be defined, and these extra arguments +must be feeded as the optional arguments of <a + href="#socket-server">socket-server</a>. + The handler function for UDP is buffer-based, that is, +you receive a buffer of data as input, and you return another buffer +for output. A template function is a simple UDP echo server: + <pre>(defun default-udp-handler (buffer) ; echo (declare (type (simple-array (unsigned-byte 8) *) buffer)) buffer)</pre> + Note: 1. data length is the length of the whole buffer. 2. +Sometimes you may want to know the client's IP address and sending +port, these informations are specially bounded on variables + <a href="#remote-host">*remote-host*</a> and <a + href="#remote-port">*remote-port*</a> when handler function +is running. </dd> </dl> <h2>Classes</h2> @@ -264,7 +323,10 @@ </dl> </dd> <dt class="sym"><a name="datagram-usocket">datagram-usocket -(Start from USOCKET 0.5) +(Start +from +USOCKET +0.5) </a></dt> <dd>Parent classes: usocket Slots: @@ -294,17 +356,29 @@ retrieved from the returned socket by calling <a href="#get-local-port">get-local-port</a>. </dd> - <dt class="sym">*remote-host*</dt> + <dt class="sym"><a name="remote-host"></a>*remote-host*</dt> <dd> Special variable used in <a href="#socket-server">socket-server</a>'s -handler function for getting current client address. (Start from +handler +function +for +getting +current +client +address. (Start from USOCKET 0.5) </dd> - <dt class="sym">*remote-port*</dt> + <dt class="sym"><a name="remote-port"></a>*remote-port*</dt> <dd> Special variable used in <a href="api-docs.shtml#socket-server">socket-server</a>'s -handler function for getting current client port. (Start from USOCKET +handler +function +for +getting +current +client +port. (Start from USOCKET 0.5) </dd> </dl>

1 0

[usocket-cvs] r557 - public_html
by Chun Tian 14 Sep '10

14 Sep '10

Author: ctian Date: Tue Sep 14 13:37:36 2010 New Revision: 557 Log: Updated USOCKET Web Documents Modified: public_html/api-docs.shtml Modified: public_html/api-docs.shtml ============================================================================== --- public_html/api-docs.shtml (original) +++ public_html/api-docs.shtml Tue Sep 14 13:37:36 2010 @@ -1,11 +1,10 @@ -<?xml version="1.0"?> -<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" - "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd"> -<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en"> +<!DOCTYPE HTML PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd"> +<html xml:lang="en" xmlns="http://www.w3.org/1999/xhtml" lang="en"> <head> <title>usocket API documentation</title> - <link rel="stylesheet" type="text/css" href="style.css"/> - <meta http-equiv="Content-Type" content="text/html; charset=ISO-8859-1"/> + <link rel="stylesheet" type="text/css" href="style.css"> + <meta http-equiv="Content-Type" + content="text/html; charset=ISO-8859-1"> <style type="text/css"> dt.sym { font-weight: normal; @@ -31,223 +30,346 @@ </style> </head> <body> - <ul> -<li><a href="#docs">API documentation</a></li> -<li><a href="#faqs">How do I ... (FAQ)</a></li> + <li><a href="#docs">API documentation</a></li> + <li><a href="#faqs">How do I ... (FAQ)</a></li> </ul> - <h1><a name="docs">usocket API documentation</a></h1> - -$Id$ - Work in progress. - +$Id: api-docs.shtml 417 2008-08-07 20:29:51Z +ehuelsmann $ +Work in progress. Please note that we're committed to the interface described -below for the entire 0.x phase of the library. When 1.0 comes +below for the entire 0.x phase of the library. When 1.0 comes some of the functionality may be split up in different functions and guarantees may change because of it. - - <h2>Conventions</h2> - - <dl> -<dt>Specification of a host parameter</dt> -<dd>A host parameter may be any one of + <dt>Specification of a host parameter</dt> + <dd>A host parameter may be any one of <ul> - <li>32-bit positive integer,</li> - <li>a string containing an IP addres in dotted notation, or</li> - <li> a host name to be resolved through DNS lookup.</li> + <li>32-bit positive integer,</li> + <li>a string containing an IP addres in dotted notation, or</li> + <li> a host name to be resolved through DNS lookup.</li> </ul> -</dd> + </dd> </dl> - <h2>Functions for socket creation and manipulation</h2> - <dl> -<dt class="sym">socket-connect host port &key element-type => socket</dt> + <dt class="sym"><a name="socket-connect">socket-connect</a> +host port &key protocol element-type timeout deadline nodelay +local-host local-port => socket</dt> + <dd> + Creates a TCP (stream) or UDP (datagram) socket to the host +and port specified. The return value is +a socket object of class <a href="#stream-usocket">stream-usocket</a>, +or -<dd> -Creates a tcp (stream) socket to the host and port specified. The return value is -a socket object of class <a href="#stream-usocket">stream-usocket</a>. - -The element-type argument is used in the -construction of the associated stream.</dd> - -<dt class="sym"> -socket-listen host port &key reuse-address backlog element-type => socket</dt> -<dd>Creates and returns a passive ("server") socket associated with host and port. - The object returned is of subtype <a href="#stream-server-usocket">stream-server-usocket</a>. - host names a local interface. - port names a local port, or 0 (zero) to request a random free port. - reuse-address is a boolean (t, nil) value signalling reuse of the address is requested (or not). - backlog is the length of the queue containing connections which haven't actually been accepted yet. - element-type is the default element type used for sockets created by socket-accept. character is - the default when it's not explicitly provided. - </dd> - - -<dt class="sym"><a name="socket-accept">socket-accept</a> socket &key element-type => new-socket</dt> -<dd>Creates and returns an active ("connected") stream socket new-socket from the - socket passed. The return value is a socket object of class - <a href="#stream-usocket">stream-usocket</a>. - element-type is the element type used to construct the associated stream. If it's not specified, - the element-type of socket (as used when it was created by the call to socket-listen) is - used. + + + <a href="#datagram-usocket">datagram-usocket</a>. + protocol should be <code>:stream</code> (default) or <code>:datagram</code>, +which +means +TCP +or +UDP. <cite>(Start from USOCKET 0.5)</cite> + element-type argument is used in the +construction of the associated stream, i.e. <code>'character</code> or + <code>'(unsigned-byte 8)</code>, only used by TCP. + timeout is a integer, it represents the socket option <code>SO_RCVTIMEO</code> +(read timeout), in seconds. + deadline is only supported in Clozure CL and Digitool MCL, +look up their documents please. + local-host and local-port, when specified, will +cause the socket calling bind() on local address. This is useful for +selecting interfaces to send, or listening on UDP port. Note: use only +one of them are allowed when reasonable (listen on wildcard address, or +bind to random free port). + + + </dd> + <dt class="sym"> <a name="socket-listen"></a>socket-listen +host port &key reuse-address backlog element-type => socket</dt> + <dd> + Creates and returns a passive ("server") socket associated with host +and port. The object returned is of subtype <a + href="#stream-server-usocket">stream-server-usocket</a>. + host names a local interface. + port names a local port, or 0 (zero) to request a random +free port. + reuse-address is a boolean (t, nil) value signalling reuse +of the address is requested (or not). + backlog is the length of the queue containing connections +which haven't actually been accepted yet. + element-type is the default element type used for sockets +created by socket-accept. character is the default when it's +not explicitly provided. + </dd> + <dt class="sym"><a name="socket-accept">socket-accept</a> +socket &key element-type => new-socket</dt> + <dd> + Creates and returns an active ("connected") stream socket new-socket +from the socket passed. The return value is a socket object +of class <a href="#stream-usocket">stream-usocket</a>. + element-type is the element type used to construct the +associated stream. If it's not specified, the element-type of socket +(as used when it was created by the call to socket-listen) is used. + </dd> + <dt class="sym"><a name="socket-close"></a>socket-close +socket</dt> + <dd> + Flushes the stream associated with the socket and closes the +socket connection. + </dd> + <dt class="sym"><a name="get-local-name"></a>get-local-name +socket => address, port + <a name="get-local-address"></a>get-local-address +socket => address + <a name="get-local-port"></a>get-local-port +socket => port</dt> + <dd> + Returns the local address and/or port information of socket. + </dd> + <dt class="sym"><a name="get-peer-name"></a>get-peer-name +socket => address, port + <a name="get-peer-address"></a>get-peer-address +socket => address + <a name="get-peer-port"></a>get-peer-port +socket => port</dt> + <dd> + Returns the remote address and/or port information of socket. +The socket passed to this function must be a connected socket. + </dd> + <dt class="sym"><a name="socket-send"></a>socket-send +socket buffer length &key host port + </dt> + <dd> + Send a (unsigned-byte 8) data buffer to a datagram socket, and +return the number of bytes sent. (Start from USOCKET 0.5) + socket should be a <a href="#datagram-usocket">datagram-usocket</a>. + buffer is a Lisp vector, type of <code>(simple-array +(unsigned-byte 8) *)</code>. + length is used to tell <a href="#socket-send">socket-send</a> +the actual useful length of data buffer for sending to socket. + host and port are used for unconnected datagram +sockets, for sending to specific destination. -</dd> + </dd> + <dt class="sym"><a name="socket-receive"></a>socket-receive +socket buffer length + </dt> + <dd> + Receive data from a datagram socket, and return 4 values: return-buffer, -<dt class="sym">socket-close socket</dt> -<dd>Flushes the stream associated with the socket and closes the socket connection.</dd> -<dt class="sym">get-local-name socket => address, port -get-local-name socket => address -get-local-port socket => port</dt> -<dd>Returns the local address and/or port information of socket.</dd> - -<dt class="sym">get-peer-name socket => address, port -get-peer-name socket => address -get-peer-port socket => port</dt> -<dd>Returns the remote address and/or port information of socket. - The socket passed to this function must be a connected socket.</dd> + return-length, remote-host, and remove-port. +If +the +datagram +socket +was created by <a href="#socket-connect">socket-connect</a> +with a timeout keyword argument, this function will block at +most that timeout value (in seconds). (Start from USOCKET 0.5) + socket should be a <a href="#datagram-usocket">datagram-usocket</a>. + buffer is a Lisp vector, type of <code>(simple-array +(unsigned-byte 8) *)</code>. Using <code>nil</code> here is also +allowed, new buffer will be created to hold data. + length is used to specify the length of a exist buffer for +receiving at most these data. Using nil here is allowed, and +the actual length of buffer will be used; when buffer +is also <code>nil</code>, a default maximum length (65507) will be +used. + + </dd> + <dt class="sym"><a name="wait-for-input"></a>wait-for-input +socket-or-sockets &key timeout ready-only + </dt> + <dd> + Waiting on one or multiple sockets for given time, and returns +once some of them are available of reading data. This is like UNIX's +"select" function. + +It returns two values: the first is the list of sockets which are +readable (or in case of server sockets acceptable). nil may be returned +for this value either when waiting timed out or when it was interrupted +(EINTR).  The second value is a real number indicating the time +remaining within the timeout period or nil if none. + +Without the READY-ONLY arg, WAIT-FOR-INPUT will return all sockets in +the original list you passed it. This prevents a new list from being +consed up. Some users of USOCKET were reluctant to use it if it +wouldn't behave that way, expecting it to cost significant performance +to do the associated garbage collection. + +Without the READY-ONLY arg, you need to check the socket STATE slot for +the values documented in usocket.lisp in the usocket class. + + </dd> + <dt class="sym"><a name="socket-server"></a>socket-server +host port function &optional arguments &key in-new-thread +protocol timeout max-buffer-size element-type reuse-address +multi-threading + </dt> + <dd> + Create a simple TCP or UDP socket server ... (Start from USOCKET +0.5) + </dd> </dl> - <h2>Classes</h2> - <dl> <dt class="sym"><a name="usocket">usocket</a></dt> <dd>Slots: <dl> - <dt>socket :accessor socket</dt> - <dd>Used to store sockets as used by the current implementation - may be any of socket handles, socket objects and stream objects</dd></dl> + <dt>socket :accessor socket + </dt> + <dd> + Used to store sockets as used by the current implementation +- may be any of socket handles, socket objects and stream objects + </dd> + <dt>state :accessor state + </dt> + <dd> + Used to store socket state: NIL (not ready), :READ (ready to +read). + + </dd> + </dl> </dd> - -<dt class="sym"><a name="stream-usocket">stream-usocket</a></dt> -<dd>Parent classes: usocket - Slots: + <dt class="sym"><a name="stream-usocket">stream-usocket</a></dt> + <dd>Parent classes: usocket +Slots: + <dl> + <dt>stream :accessor socket-stream</dt> + <dd> + Used to store the stream associated with the tcp socket +connection. +When you want to write to the socket stream, use this function. + </dd> + </dl> + </dd> + <dt class="sym"><a + name="stream-server-usocket">stream-server-usocket</a></dt> + <dd>Parent classes: usocket +Slots: <dl> - <dt>stream :accessor socket-stream</dt> - <dd>Used to store the stream associated with the tcp socket connection. - When you want to write to the socket stream, use this function.</dd></dl> -</dd> - -<dt class="sym"><a name="stream-server-usocket">stream-server-usocket</a></dt> -<dd>Parent classes: usocket - Slots: + <dt>element-type :reader +element-type</dt> + <dd> + Indicates the default element-type to be used when +constructing streams off this socket when no element type is specified +in the call to <a href="#socket-accept">socket-accept</a>. + </dd> + </dl> + </dd> + <dt class="sym"><a name="datagram-usocket">datagram-usocket +(Start from USOCKET 0.5) + </a></dt> + <dd>Parent classes: usocket +Slots: <dl> - <dt>element-type :reader element-type</dt> - <dd>Indicates the default element-type to be used when constructing streams off this socket when - no element type is specified in the call to <a href="#socket-accept">socket-accept</a>.</dd></dl> -</dd> + <dt>connected-p :accessor +connected-p</dt> + <dd> + Used to identify if the datagram is connected. It will be +setup by <a href="#socket-connect">socket-connect</a>, and +used by <a href="#socket-send">socket-send</a> and <a + href="#socket-receive">socket-receive</a>. + </dd> + </dl> + </dd> </dl> - <h2>Variables / constants</h2> - <dl> -<dt class="sym">*wildcard-host*</dt> -<dd>The host to use with socket-listen to make the socket listen on all available interfaces.</dd> -<dt class="sym">*auto-port*</dt> -<dd>The port number to use with socket-listen to make the socket listen on a random available port. The port number assigned can be - retrieved from the returned socket by calling <a href="#get-local-port">get-local-port</a>.</dd> + <dt class="sym">*wildcard-host*</dt> + <dd> + The host to use with <a href="#socket-listen">socket-listen</a> +to make the socket listen on all available interfaces. + </dd> + <dt class="sym">*auto-port*</dt> + <dd> + The port number to use with socket-listen to make the socket +listen on a random available port. The port number assigned can be +retrieved from the returned socket by calling <a + href="#get-local-port">get-local-port</a>. + </dd> + <dt class="sym">*remote-host*</dt> + <dd> + Special variable used in <a href="#socket-server">socket-server</a>'s +handler function for getting current client address. (Start from +USOCKET 0.5) + + </dd> + <dt class="sym">*remote-port*</dt> + <dd> + Special variable used in <a href="api-docs.shtml#socket-server">socket-server</a>'s +handler function for getting current client port. (Start from USOCKET +0.5) + </dd> </dl> - - <h1><a name="faqs">How do I ...</a></h1> - <dl class="faq"> -<dt>... force the output to be written to the network? -</dt> -<dd>When you write output to the stream, it may be buffered before - sent over the network - for optimal performance of small writes. You - can force the buffer to be flushed the same way as with normal streams: - -<pre>(format (socket-stream socket) "Hello there~%") ;; output into buffers -(force-output (socket-stream socket)) ;; <== flush the buffers, if any -</pre> -</dd> -<dt>... check whether the other end has closed my socket stream? -</dt> -<dd>Reading from a stream which has been closed at the remote end - signals an END-OF-FILE condition, meaning that reading from the stream - and detecting that condition is the way to do it. -</dd> -<dt>... check whether reading from a socket stream will block? -</dt> -<dd>When you want to check one stream for readiness of input, - call the - <a href="http://www.lisp.org/HyperSpec/Body/fun_listen.html">listen</a> - function on the stream object associated with the socket. - Example: -<pre>(listen (usocket:socket-stream your-socket)) - ==> NIL (if no input is available) -</pre> -</dd> -<dt>... wait for input to become available on (at least) one stream (of a set) -</dt> -<dd>Currently, that's hard to do efficiently if you want to use releases. - The next minor release (0.4.0) will include this functionality and - for all platforms (except SBCL and LispWorks; both Win32) it's already - available in trunk (svn://common-lisp.net/project/usocket/svn/usocket/trunk) - - If you want to use this code you're most welcome and feedback is appreciated. - Example to be used with trunk: -<pre>(usocket:wait-for-input (list socket1 socket2 socket3) :timeout <your optional timeout value>) - ==> list-of-sockets-to-read-from</pre> -</dd> -<dt>... convert my existing trivial-sockets based application to usocket? -</dt> -<dd>There are actually 3 answers to that question. - <ol> - <li>Rewrite your code to keep a usocket object instead of the stream - object returned by trivial-sockets.</li> - <li>The quick conversion with the good performance characteristics - (use only when you don't want to use the socket object): - Replace all your invocations of -<pre> - (trivial-sockets:open-socket-stream ....) - -with - (usocket:socket-stream (usocket:socket-connect ...)) -</pre> - + <dt>... force the output to be written to the network? </dt> + <dd>When you write output to the stream, it may be buffered before +sent over the network - for optimal performance of small writes. You +can force the buffer to be flushed the same way as with normal streams: + <pre>(format (socket-stream socket) "Hello there~%") ;; output into buffers (force-output (socket-stream socket)) ;; <== flush the buffers, if any </pre> + </dd> + <dt>... check whether the other end has closed my socket stream? </dt> + <dd>Reading from a stream which has been closed at the remote end +signals an END-OF-FILE condition, meaning that reading from the stream +and detecting that condition is the way to do it. </dd> + <dt>... check whether reading from a socket stream will block? </dt> + <dd>When you want to check one stream for readiness of input, +call the <a href="http://www.lisp.org/HyperSpec/Body/fun_listen.html">listen</a> +function on the stream object associated with the socket. +Example: + <pre>(listen (usocket:socket-stream your-socket)) ==> NIL (if no input is available) </pre> + </dd> + <dt>... wait for input to become available on (at least) one stream +(of a set) </dt> + <dd>Currently, that's hard to do efficiently if you want to use +releases. The next minor release (0.4.0) will include this +functionality and for all platforms (except SBCL and LispWorks; both +Win32) it's already available in trunk +(svn://common-lisp.net/project/usocket/svn/usocket/trunk). +If you want to use this code you're most welcome and feedback is +appreciated. +Example to be used with trunk: + <pre>(usocket:wait-for-input (list socket1 socket2 socket3) :timeout <your optional timeout value>) ==> list-of-sockets-to-read-from</pre> + </dd> + <dt>... convert my existing trivial-sockets based application to +usocket? </dt> + <dd>There are actually 3 answers to that question. + <ol> + <li>Rewrite your code to keep a usocket object instead of the +stream object returned by trivial-sockets.</li> + <li>The quick conversion with the good performance +characteristics (use only when you don't want to use the socket object): +Replace all your invocations of + <pre> (trivial-sockets:open-socket-stream ....) with (usocket:socket-stream (usocket:socket-connect ...)) </pre> And replace all invocations of -<pre> - (trivial-sockets:socket-accept ...) - -with - (usocket:socket-stream (usocket:socket-accept ...)) -</pre> - + <pre> (trivial-sockets:socket-accept ...) with (usocket:socket-stream (usocket:socket-accept ...)) </pre> And replace all invocations of -<pre> - (trivial-sockets:open-server ...) - -with - (usocket:socket-listen ...) -</pre></li> - <li>And the last option which provides a compatible - (but slower, because it uses Gray streams) interface is to use - trivial-usocket. - The trivial-usocket package provides a 1-1 mapped interface to - trivial-sockets, but uses Gray streams; that way, it's later possible - to retrieve the socket object from the stream returned and to use that - socket for other usocket operations. Use this approach as a migration - path where you're not rewriting your application at once, but in - small steps. + <pre> (trivial-sockets:open-server ...) with (usocket:socket-listen ...) </pre> </li> + <li>And the last option which provides a compatible (but slower, +because it uses Gray streams) interface is to use trivial-usocket. +The trivial-usocket package provides a 1-1 mapped interface to +trivial-sockets, but uses Gray streams; that way, it's later possible +to retrieve the socket object from the stream returned and to use that +socket for other usocket operations. Use this approach as a migration +path where you're not rewriting your application at once, but in small +steps. </li> </ol> -</dd> - + </dd> </dl> - - -<div style="float:left;font-size:x-small;font-weight:bold"> +<div style="float: left; font-size: x-small; font-weight: bold;"> Back to <a href="http://common-lisp.net/">Common-lisp.net</a>. </div> - <div class="check" style="float:right"> - <a href="http://validator.w3.org/check/referer">Valid XHTML 1.0 Strict</a> - </div> +<div class="check" style="float: right;"> <a + href="http://validator.w3.org/check/referer">Valid XHTML 1.0 Strict</a> +</div> </body> </html>

1 0

[usocket-cvs] r556 - in usocket/trunk: . backend
by Chun Tian 14 Sep '10

14 Sep '10

Author: ctian Date: Tue Sep 14 04:07:20 2010 New Revision: 556 Log: ABCL: basically working implementation of SOCKET-SEND/SOCKET-RECEIVE. Modified: usocket/trunk/README usocket/trunk/backend/abcl.lisp usocket/trunk/package.lisp usocket/trunk/usocket.lisp Modified: usocket/trunk/README ============================================================================== --- usocket/trunk/README (original) +++ usocket/trunk/README Tue Sep 14 04:07:20 2010 @@ -22,14 +22,14 @@ - SBCL - CMUCL - - ArmedBear (post feb 11th, 2006 CVS or 0.0.10 and higher) - - clisp + - ArmedBear Common Lisp + - GNU CLISP - Allegro Common Lisp - LispWorks - - OpenMCL + - Clozure CL - ECL - Scieneer Common Lisp - - <Your favorite Common Lisp here?> + - Macintosh Common Lisp If your favorite common lisp misses in the list above, please contact usocket-devel(a)common-lisp.net and submit a request. Please include Modified: usocket/trunk/backend/abcl.lisp ============================================================================== --- usocket/trunk/backend/abcl.lisp (original) +++ usocket/trunk/backend/abcl.lisp Tue Sep 14 04:07:20 2010 @@ -8,29 +8,15 @@ (in-package :usocket) -;;; Symbols in JAVA package -(eval-when (:compile-toplevel :load-toplevel :execute) - (defparameter *java-package-symbols* - '(java:jarray-length - java:jarray-ref - java:java-exception - java:java-exception-cause - java:jconstructor - java:jcall - java:jclass - java:jclass-of - java:jfield - java:jmethod - java:jnew - java:jstatic - java:make-immediate-object)) - (import *java-package-symbols*)) - ;;; Java Classes ($*...) (defvar $*boolean (jclass "boolean")) +(defvar $*byte (jclass "byte")) +(defvar $*byte[] (jclass "[B")) (defvar $*int (jclass "int")) (defvar $*long (jclass "long")) +(defvar $*|Byte| (jclass "java.lang.Byte")) (defvar $*DatagramChannel (jclass "java.nio.channels.DatagramChannel")) +(defvar $*DatagramPacket (jclass "java.net.DatagramPacket")) (defvar $*DatagramSocket (jclass "java.net.DatagramSocket")) (defvar $*Inet4Address (jclass "java.net.Inet4Address")) (defvar $*InetAddress (jclass "java.net.InetAddress")) @@ -48,6 +34,9 @@ (defvar $*String (jclass "java.lang.String")) ;;; Java Constructor ($%.../n) +(defvar $%Byte/0 (jconstructor $*|Byte| $*byte)) +(defvar $%DatagramPacket/3 (jconstructor $*DatagramPacket $*byte[] $*int $*int)) +(defvar $%DatagramPacket/5 (jconstructor $*DatagramPacket $*byte[] $*int $*int $*InetAddress $*int)) (defvar $%DatagramSocket/0 (jconstructor $*DatagramSocket)) (defvar $%DatagramSocket/1 (jconstructor $*DatagramSocket $*int)) (defvar $%DatagramSocket/2 (jconstructor $*DatagramSocket $*int $*InetAddress)) @@ -67,6 +56,7 @@ (defvar $@bind/ServerSocket/1 (jmethod $*ServerSocket "bind" $*SocketAddress)) (defvar $@bind/ServerSocket/2 (jmethod $*ServerSocket "bind" $*SocketAddress $*int)) (defvar $@bind/Socket/1 (jmethod $*Socket "bind" $*SocketAddress)) +(defvar $@byteValue/0 (jmethod $*|Byte| "byteValue")) (defvar $@channel/0 (jmethod $*SelectionKey "channel")) (defvar $@close/DatagramSocket/0 (jmethod $*DatagramSocket "close")) (defvar $@close/Selector/0 (jmethod $*Selector "close")) @@ -83,15 +73,19 @@ (defvar $@getChannel/DatagramSocket/0 (jmethod $*DatagramSocket "getChannel")) (defvar $@getChannel/ServerSocket/0 (jmethod $*ServerSocket "getChannel")) (defvar $@getChannel/Socket/0 (jmethod $*Socket "getChannel")) +(defvar $@getAddress/DatagramPacket/0 (jmethod $*DatagramPacket "getAddress")) (defvar $@getHostName/0 (jmethod $*InetAddress "getHostName")) (defvar $@getInetAddress/DatagramSocket/0 (jmethod $*DatagramSocket "getInetAddress")) (defvar $@getInetAddress/ServerSocket/0 (jmethod $*ServerSocket "getInetAddress")) (defvar $@getInetAddress/Socket/0 (jmethod $*Socket "getInetAddress")) +(defvar $@getLength/DatagramPacket/0 (jmethod $*DatagramPacket "getLength")) (defvar $@getLocalAddress/DatagramSocket/0 (jmethod $*DatagramSocket "getLocalAddress")) (defvar $@getLocalAddress/Socket/0 (jmethod $*Socket "getLocalAddress")) (defvar $@getLocalPort/DatagramSocket/0 (jmethod $*DatagramSocket "getLocalPort")) (defvar $@getLocalPort/ServerSocket/0 (jmethod $*ServerSocket "getLocalPort")) (defvar $@getLocalPort/Socket/0 (jmethod $*Socket "getLocalPort")) +(defvar $@getOffset/DatagramPacket/0 (jmethod $*DatagramPacket "getOffset")) +(defvar $@getPort/DatagramPacket/0 (jmethod $*DatagramPacket "getPort")) (defvar $@getPort/DatagramSocket/0 (jmethod $*DatagramSocket "getPort")) (defvar $@getPort/Socket/0 (jmethod $*Socket "getPort")) (defvar $@hasNext/0 (jmethod $*Iterator "hasNext")) @@ -101,10 +95,12 @@ (defvar $@open/Selector/0 (jmethod $*Selector "open")) (defvar $@open/ServerSocketChannel/0 (jmethod $*ServerSocketChannel "open")) (defvar $@open/SocketChannel/0 (jmethod $*SocketChannel "open")) +(defvar $@receive/1 (jmethod $*DatagramSocket "receive" $*DatagramPacket)) (defvar $@register/2 (jmethod $*SelectableChannel "register" $*Selector $*int)) (defvar $@select/0 (jmethod $*Selector "select")) (defvar $@select/1 (jmethod $*Selector "select" $*long)) (defvar $@selectedKeys/0 (jmethod $*Selector "selectedKeys")) +(defvar $@send/1 (jmethod $*DatagramSocket "send" $*DatagramPacket)) (defvar $@setReuseAddress/1 (jmethod $*ServerSocket "setReuseAddress" $*boolean)) (defvar $@setSoTimeout/DatagramSocket/1 (jmethod $*DatagramSocket "setSoTimeout" $*int)) (defvar $@setSoTimeout/Socket/1 (jmethod $*Socket "setSoTimeout" $*int)) @@ -137,6 +133,18 @@ ;;; HANDLE-CONTITION +(defparameter +abcl-error-map+ + `(("java.net.BindException" . operation-not-permitted-error) + ("java.net.ConnectException" . connection-refused-error) + ("java.net.NoRouteToHostException" . network-unreachable-error) ; untested + ("java.net.PortUnreachableException" . protocol-not-supported-error) ; untested + ("java.net.ProtocolException" . protocol-not-supported-error) ; untested + ("java.net.SocketException" . socket-type-not-supported-error) ; untested + ("java.net.SocketTimeoutException" . timeout-error))) + +(defparameter +abcl-nameserver-error-map+ + `(("java.net.UnknownHostException" . ns-host-not-found-error))) + (defun handle-condition (condition &optional (socket nil)) (typecase condition (java-exception @@ -153,27 +161,18 @@ (when usock-error (error usock-error :socket socket)))))))) -(defparameter +abcl-error-map+ - `(("java.net.ConnectException" . connection-refused-error) - ("java.net.SocketTimeoutException" . timeout-error) - ("java.net.BindException" . operation-not-permitted-error))) - -(defparameter +abcl-nameserver-error-map+ - `(("java.net.UnknownHostException" . ns-host-not-found-error))) - ;;; GET-HOSTS-BY-NAME (defun get-address (address) - (let* ((array (%get-address address)) - (length (jarray-length array))) - (labels ((jbyte (n) - (let ((byte (jarray-ref array n))) - (if (plusp byte) - byte - (+ 256 byte))))) - (if (= 4 length) - (vector (jbyte 0) (jbyte 1) (jbyte 2) (jbyte 3)) - nil)))) ; not a IPv4 address?! + (when address + (let* ((array (%get-address address)) + (length (jarray-length array))) + (labels ((jbyte (n) + (let ((byte (jarray-ref array n))) + (if (minusp byte) (+ 256 byte) byte)))) + (if (= 4 length) + (vector (jbyte 0) (jbyte 1) (jbyte 2) (jbyte 3)) + nil))))) ; not a IPv4 address?! (defun get-hosts-by-name (name) (with-mapped-conditions () @@ -225,7 +224,7 @@ (let ((address (jnew $%InetSocketAddress/2 (host-to-inet4 host) port))) (with-mapped-conditions () (jcall $@connect/DatagramChannel/1 channel address)))) - (setq usocket (make-datagram-socket socket)) + (setq usocket (make-datagram-socket socket :connected-p (if (and host port) t nil))) (when timeout (jcall $@setSoTimeout/DatagramSocket/1 socket (truncate (* 1000 timeout))))))) usocket)) @@ -316,14 +315,54 @@ ;;; SOCKET-SEND & SOCKET-RECEIVE -(defmethod socket-send ((socket datagram-usocket) buffer length &key host port) - (with-mapped-conditions (socket) - )) +(defun *->byte (data) + (declare (type (unsigned-byte 8) data)) ; required by SOCKET-SEND + (jnew $%Byte/0 (if (> data 127) (- data 256) data))) + +(defun byte->* (byte &optional (element-type '(unsigned-byte 8))) + (let* ((ub8 (if (minusp byte) (+ 256 byte) byte))) + (if (eq element-type 'character) + (code-char ub8) + ub8))) + +(defmethod socket-send ((usocket datagram-usocket) buffer length &key host port) + (let* ((socket (socket usocket)) + (real-length (or length (length buffer))) + (byte-array (jnew-array $*byte real-length)) + (packet (if (and host port) + (jnew $%DatagramPacket/5 byte-array 0 real-length (host-to-inet4 host) port) + (jnew $%DatagramPacket/3 byte-array 0 real-length)))) + ;; prepare sending data + (loop for i from 0 below real-length + do (setf (jarray-ref byte-array i) (*->byte (aref buffer i)))) + (with-mapped-conditions (usocket) + (jcall $@send/1 socket packet)) + real-length)) -(defmethod socket-receive ((socket datagram-usocket) buffer length +;;; TODO: return-host and return-port cannot be get ... +(defmethod socket-receive ((usocket datagram-usocket) buffer length &key (element-type '(unsigned-byte 8))) - (with-mapped-conditions (socket) - )) + (let* ((socket (socket usocket)) + (real-length (or length +max-datagram-packet-size+)) + (byte-array (jnew-array $*byte real-length)) + (packet (jnew $%DatagramPacket/3 byte-array 0 real-length))) + (with-mapped-conditions (usocket) + (jcall $@receive/1 socket packet)) + (let* ((receive-length (jcall $@getLength/DatagramPacket/0 packet)) + (return-buffer (or buffer (make-array receive-length :element-type element-type)))) + (loop for i from 0 below receive-length + do (setf (aref return-buffer i) + (byte->* (jarray-ref byte-array i) element-type))) + (let ((return-host (if (connected-p usocket) + (get-peer-address usocket) + (get-address (jcall $@getAddress/DatagramPacket/0 packet)))) + (return-port (if (connected-p usocket) + (get-peer-port usocket) + (jcall $@getPort/DatagramPacket/0 packet)))) + (values return-buffer + receive-length + return-host + return-port))))) ;;; WAIT-FOR-INPUT Modified: usocket/trunk/package.lisp ============================================================================== --- usocket/trunk/package.lisp (original) +++ usocket/trunk/package.lisp Tue Sep 14 04:07:20 2010 @@ -6,7 +6,7 @@ (in-package :usocket-system) (defpackage :usocket - (:use :common-lisp) + (:use :common-lisp #+abcl :java) (:export #:*wildcard-host* #:*auto-port* Modified: usocket/trunk/usocket.lisp ============================================================================== --- usocket/trunk/usocket.lisp (original) +++ usocket/trunk/usocket.lisp Tue Sep 14 04:07:20 2010 @@ -11,7 +11,7 @@ (defparameter *auto-port* 0 "Port number to pass when an auto-assigned port number is wanted.") -(defconstant +max-datagram-packet-size+ 65536) +(defconstant +max-datagram-packet-size+ 65507) (defclass usocket () ((socket

1 0

[usocket-cvs] r555 - in usocket/trunk: . backend vendor
by Chun Tian 13 Sep '10

13 Sep '10

Author: ctian Date: Mon Sep 13 11:33:20 2010 New Revision: 555 Log: ABCL: replace old JDI-based implementation with new implementation. Removed: usocket/trunk/backend/armedbear.lisp usocket/trunk/vendor/abcl-jdi.lisp Modified: usocket/trunk/backend/abcl.lisp usocket/trunk/package.lisp usocket/trunk/usocket.asd usocket/trunk/usocket.lisp Modified: usocket/trunk/backend/abcl.lisp ============================================================================== --- usocket/trunk/backend/abcl.lisp (original) +++ usocket/trunk/backend/abcl.lisp Mon Sep 13 11:33:20 2010 @@ -8,20 +8,49 @@ (in-package :usocket) +;;; Symbols in JAVA package +(eval-when (:compile-toplevel :load-toplevel :execute) + (defparameter *java-package-symbols* + '(java:jarray-length + java:jarray-ref + java:java-exception + java:java-exception-cause + java:jconstructor + java:jcall + java:jclass + java:jclass-of + java:jfield + java:jmethod + java:jnew + java:jstatic + java:make-immediate-object)) + (import *java-package-symbols*)) + ;;; Java Classes ($*...) (defvar $*boolean (jclass "boolean")) (defvar $*int (jclass "int")) +(defvar $*long (jclass "long")) +(defvar $*DatagramChannel (jclass "java.nio.channels.DatagramChannel")) (defvar $*DatagramSocket (jclass "java.net.DatagramSocket")) (defvar $*Inet4Address (jclass "java.net.Inet4Address")) (defvar $*InetAddress (jclass "java.net.InetAddress")) (defvar $*InetSocketAddress (jclass "java.net.InetSocketAddress")) +(defvar $*Iterator (jclass "java.util.Iterator")) +(defvar $*SelectableChannel (jclass "java.nio.channels.SelectableChannel")) +(defvar $*SelectionKey (jclass "java.nio.channels.SelectionKey")) +(defvar $*Selector (jclass "java.nio.channels.Selector")) (defvar $*ServerSocket (jclass "java.net.ServerSocket")) +(defvar $*ServerSocketChannel (jclass "java.nio.channels.ServerSocketChannel")) +(defvar $*Set (jclass "java.util.Set")) (defvar $*Socket (jclass "java.net.Socket")) (defvar $*SocketAddress (jclass "java.net.SocketAddress")) +(defvar $*SocketChannel (jclass "java.nio.channels.SocketChannel")) (defvar $*String (jclass "java.lang.String")) ;;; Java Constructor ($%.../n) (defvar $%DatagramSocket/0 (jconstructor $*DatagramSocket)) +(defvar $%DatagramSocket/1 (jconstructor $*DatagramSocket $*int)) +(defvar $%DatagramSocket/2 (jconstructor $*DatagramSocket $*int $*InetAddress)) (defvar $%InetSocketAddress/1 (jconstructor $*InetSocketAddress $*int)) (defvar $%InetSocketAddress/2 (jconstructor $*InetSocketAddress $*InetAddress $*int)) (defvar $%ServerSocket/0 (jconstructor $*ServerSocket)) @@ -34,23 +63,65 @@ ;;; Java Methods ($@...[/Class]/n) (defvar $@accept/0 (jmethod $*ServerSocket "accept")) -(defvar $@bind/1 (jmethod $*ServerSocket "bind" $*SocketAddress)) -(defvar $@bind/2 (jmethod $*ServerSocket "bind" $*SocketAddress $*int)) +(defvar $@bind/DatagramSocket/1 (jmethod $*DatagramSocket "bind" $*SocketAddress)) +(defvar $@bind/ServerSocket/1 (jmethod $*ServerSocket "bind" $*SocketAddress)) +(defvar $@bind/ServerSocket/2 (jmethod $*ServerSocket "bind" $*SocketAddress $*int)) +(defvar $@bind/Socket/1 (jmethod $*Socket "bind" $*SocketAddress)) +(defvar $@channel/0 (jmethod $*SelectionKey "channel")) +(defvar $@close/DatagramSocket/0 (jmethod $*DatagramSocket "close")) +(defvar $@close/Selector/0 (jmethod $*Selector "close")) (defvar $@close/ServerSocket/0 (jmethod $*ServerSocket "close")) (defvar $@close/Socket/0 (jmethod $*Socket "close")) -(defvar $@connect/1 (jmethod $*Socket "connect" $*SocketAddress)) -(defvar $@connect/2 (jmethod $*Socket "connect" $*SocketAddress $*int)) +(defvar $@configureBlocking/1 (jmethod $*SelectableChannel "configureBlocking" $*boolean)) +(defvar $@connect/DatagramChannel/1 (jmethod $*DatagramChannel "connect" $*SocketAddress)) +(defvar $@connect/Socket/1 (jmethod $*Socket "connect" $*SocketAddress)) +(defvar $@connect/Socket/2 (jmethod $*Socket "connect" $*SocketAddress $*int)) +(defvar $@connect/SocketChannel/1 (jmethod $*SocketChannel "connect" $*SocketAddress)) (defvar $@getAddress/0 (jmethod $*Inet4Address "getAddress")) (defvar $@getAllByName/1 (jmethod $*InetAddress "getAllByName" $*String)) (defvar $@getByName/1 (jmethod $*InetAddress "getByName" $*String)) +(defvar $@getChannel/DatagramSocket/0 (jmethod $*DatagramSocket "getChannel")) +(defvar $@getChannel/ServerSocket/0 (jmethod $*ServerSocket "getChannel")) +(defvar $@getChannel/Socket/0 (jmethod $*Socket "getChannel")) (defvar $@getHostName/0 (jmethod $*InetAddress "getHostName")) +(defvar $@getInetAddress/DatagramSocket/0 (jmethod $*DatagramSocket "getInetAddress")) (defvar $@getInetAddress/ServerSocket/0 (jmethod $*ServerSocket "getInetAddress")) (defvar $@getInetAddress/Socket/0 (jmethod $*Socket "getInetAddress")) +(defvar $@getLocalAddress/DatagramSocket/0 (jmethod $*DatagramSocket "getLocalAddress")) (defvar $@getLocalAddress/Socket/0 (jmethod $*Socket "getLocalAddress")) +(defvar $@getLocalPort/DatagramSocket/0 (jmethod $*DatagramSocket "getLocalPort")) (defvar $@getLocalPort/ServerSocket/0 (jmethod $*ServerSocket "getLocalPort")) (defvar $@getLocalPort/Socket/0 (jmethod $*Socket "getLocalPort")) +(defvar $@getPort/DatagramSocket/0 (jmethod $*DatagramSocket "getPort")) (defvar $@getPort/Socket/0 (jmethod $*Socket "getPort")) +(defvar $@hasNext/0 (jmethod $*Iterator "hasNext")) +(defvar $@iterator/0 (jmethod $*Set "iterator")) +(defvar $@next/0 (jmethod $*Iterator "next")) +(defvar $@open/DatagramChannel/0 (jmethod $*DatagramChannel "open")) +(defvar $@open/Selector/0 (jmethod $*Selector "open")) +(defvar $@open/ServerSocketChannel/0 (jmethod $*ServerSocketChannel "open")) +(defvar $@open/SocketChannel/0 (jmethod $*SocketChannel "open")) +(defvar $@register/2 (jmethod $*SelectableChannel "register" $*Selector $*int)) +(defvar $@select/0 (jmethod $*Selector "select")) +(defvar $@select/1 (jmethod $*Selector "select" $*long)) +(defvar $@selectedKeys/0 (jmethod $*Selector "selectedKeys")) (defvar $@setReuseAddress/1 (jmethod $*ServerSocket "setReuseAddress" $*boolean)) +(defvar $@setSoTimeout/DatagramSocket/1 (jmethod $*DatagramSocket "setSoTimeout" $*int)) +(defvar $@setSoTimeout/Socket/1 (jmethod $*Socket "setSoTimeout" $*int)) +(defvar $@setTcpNoDelay/1 (jmethod $*Socket "setTcpNoDelay" $*boolean)) +(defvar $@socket/DatagramChannel/0 (jmethod $*DatagramChannel "socket")) +(defvar $@socket/ServerSocketChannel/0 (jmethod $*ServerSocketChannel "socket")) +(defvar $@socket/SocketChannel/0 (jmethod $*SocketChannel "socket")) +(defvar $@validOps/0 (jmethod $*SelectableChannel "validOps")) + +;;; Java Field Variables ($+...) +(defvar $+op-accept (jfield $*SelectionKey "OP_ACCEPT")) +(defvar $+op-connect (jfield $*SelectionKey "OP_CONNECT")) +(defvar $+op-read (jfield $*SelectionKey "OP_READ")) +(defvar $+op-write (jfield $*SelectionKey "OP_WRITE")) + +(defconstant +java-true+ (make-immediate-object t :boolean)) +(defconstant +java-false+ (make-immediate-object nil :boolean)) ;;; Wrapper functions (return-type: java-object) (defun %get-address (address) @@ -60,6 +131,10 @@ (defun %get-by-name (string) (jstatic $@getByName/1 $*InetAddress string)) +(defun host-to-inet4 (host) + "USOCKET host formats to Java Inet4Address, used internally." + (%get-by-name (host-to-hostname host))) + ;;; HANDLE-CONTITION (defun handle-condition (condition &optional (socket nil)) @@ -79,8 +154,7 @@ (error usock-error :socket socket)))))))) (defparameter +abcl-error-map+ - `(;("java.io.IOException" . ) - ("java.net.ConnectException" . connection-refused-error) + `(("java.net.ConnectException" . connection-refused-error) ("java.net.SocketTimeoutException" . timeout-error) ("java.net.BindException" . operation-not-permitted-error))) @@ -105,11 +179,8 @@ (with-mapped-conditions () (map 'list #'get-address (%get-all-by-name name)))) -(defun host-to-inet4 (host) - "USOCKET host formats to Java Inet4Address, used internally." - (%get-by-name (host-to-hostname host))) - ;;; GET-HOST-BY-ADDRESS + (defun get-host-by-address (host) (let ((inet4 (host-to-inet4 host))) (with-mapped-conditions () @@ -120,83 +191,192 @@ (defun socket-connect (host port &key (protocol :stream) (element-type 'character) timeout deadline (nodelay t nodelay-supplied-p) local-host local-port) - (declare (type integer timeout)) - (if (eq protocol :stream) - (let* ((socket (with-mapped-conditions () - (if (or local-host local-port) - (jnew $%Socket/4 (host-to-inet4 host) port (host-to-inet4 local-host) local-port) - (if timeout - (let ((socket (jnew $%Socket/0)) - (address (jnew $%InetSocketAddress/2 (host-to-inet4 host) port))) - (jcall $@connect/2 socket address timeout) - socket) - (jnew $%Socket/2 (host-to-inet4 host) port))))) - (stream (ext:get-socket-stream socket :element-type element-type)) - (usocket (make-stream-socket :stream stream :socket socket))) - usocket) - (socket-connect-for-udp host port :timeout timeout :local-host local-host :local-port local-port))) + (when deadline (unsupported 'deadline 'socket-connect)) + (let (socket stream usocket) + (ecase protocol + (:stream ; TCP + (let ((channel (jstatic $@open/SocketChannel/0 $*SocketChannel)) + (address (jnew $%InetSocketAddress/2 (host-to-inet4 host) port))) + (setq socket (jcall $@socket/SocketChannel/0 channel)) + ;; bind to local address if needed + (when (or local-host local-port) + (let ((local-address (jnew $%InetSocketAddress/2 (host-to-inet4 local-host) (or local-port 0)))) + (with-mapped-conditions () + (jcall $@bind/Socket/1 socket local-address)))) + ;; connect to dest address + (with-mapped-conditions () + (jcall $@connect/SocketChannel/1 channel address)) + (setq stream (ext:get-socket-stream socket :element-type element-type) + usocket (make-stream-socket :stream stream :socket socket)) + (when nodelay-supplied-p + (jcall $@setTcpNoDelay/1 socket (if nodelay +java-true+ +java-false+))) + (when timeout + (jcall $@setSoTimeout/Socket/1 socket (truncate (* 1000 timeout)))))) + (:datagram ; UDP + (let ((channel (jstatic $@open/DatagramChannel/0 $*DatagramChannel))) + (setq socket (jcall $@socket/DatagramChannel/0 channel)) + ;; bind to local address if needed + (when (or local-host local-port) + (let ((local-address (jnew $%InetSocketAddress/2 (host-to-inet4 local-host) (or local-port 0)))) + (with-mapped-conditions () + (jcall $@bind/DatagramSocket/1 socket local-address)))) + ;; connect to dest address if needed + (when (and host port) + (let ((address (jnew $%InetSocketAddress/2 (host-to-inet4 host) port))) + (with-mapped-conditions () + (jcall $@connect/DatagramChannel/1 channel address)))) + (setq usocket (make-datagram-socket socket)) + (when timeout + (jcall $@setSoTimeout/DatagramSocket/1 socket (truncate (* 1000 timeout))))))) + usocket)) -(defun socket-connect-for-udp (host port &key timeout local-host local-port) - ) +;;; SOCKET-LISTEN -(defun socket-listen (host port &key reuseaddress (element-type 'character) +(defun socket-listen (host port &key (element-type 'character) (reuse-address nil reuse-address-supplied-p) (backlog 5 backlog-supplied-p)) - (let ((socket (jnew $%ServerSocket/0)) - (endpoint (jnew $%InetSocketAddress/2 (host-to-inet4 host) port))) - #+ignore ;; TODO: java.lang.IllegalArgumentException? + (declare (type boolean reuse-address)) + (let* ((channel (jstatic $@open/ServerSocketChannel/0 $*ServerSocketChannel)) + (socket (jcall $@socket/ServerSocketChannel/0 channel)) + (endpoint (jnew $%InetSocketAddress/2 (host-to-inet4 host) (or port 0)))) (when reuse-address-supplied-p - (jcall $@setReuseAddress/1 socket reuse-address)) + (jcall $@setReuseAddress/1 socket (if reuse-address +java-true+ +java-false+))) (with-mapped-conditions (socket) (if backlog-supplied-p - (jcall $@bind/2 socket endpoint backlog) - (jcall $@bind/1 socket endpoint))) + (jcall $@bind/ServerSocket/2 socket endpoint backlog) + (jcall $@bind/ServerSocket/1 socket endpoint))) (make-stream-server-socket socket :element-type element-type))) +;;; SOCKET-ACCEPT + (defmethod socket-accept ((socket stream-server-usocket) &key (element-type 'character)) (with-mapped-conditions (socket) (let* ((client-socket (jcall $@accept/0 socket)) (stream (ext:get-socket-stream client-socket :element-type element-type))) (make-stream-socket :stream stream :socket client-socket)))) +;;; SOCKET-CLOSE + (defmethod socket-close :before ((usocket usocket)) (when (wait-list usocket) (remove-waiter (wait-list usocket) usocket))) -(defmethod socket-close ((usocket usocket)) - (with-mapped-conditions (usocket) - (jcall $@close/Socket/0 (socket usocket)))) - (defmethod socket-close ((usocket stream-server-usocket)) (with-mapped-conditions (usocket) (jcall $@close/ServerSocket/0 (socket usocket)))) (defmethod socket-close ((usocket stream-usocket)) (with-mapped-conditions (usocket) - (close (socket-stream usocket)))) + (close (socket-stream usocket)) + (jcall $@close/Socket/0 (socket usocket)))) + +(defmethod socket-close ((usocket datagram-usocket)) + (with-mapped-conditions (usocket) + (jcall $@close/DatagramSocket/0 (socket usocket)))) + +;;; GET-LOCAL/PEER-NAME/ADDRESS/PORT (defmethod get-local-name ((usocket usocket)) (values (get-local-address usocket) (get-local-port usocket))) -(defmethod get-peer-name ((usocket stream-usocket)) +(defmethod get-peer-name ((usocket usocket)) (values (get-peer-address usocket) (get-peer-port usocket))) -(defmethod get-local-address ((usocket usocket)) +(defmethod get-local-address ((usocket stream-usocket)) (get-address (jcall $@getLocalAddress/Socket/0 (socket usocket)))) (defmethod get-local-address ((usocket stream-server-usocket)) (get-address (jcall $@getInetAddress/ServerSocket/0 (socket usocket)))) -(defmethod get-peer-address ((usocket usocket)) +(defmethod get-local-address ((usocket datagram-usocket)) + (get-address (jcall $@getLocalAddress/DatagramSocket/0 (socket usocket)))) + +(defmethod get-peer-address ((usocket stream-usocket)) (get-address (jcall $@getInetAddress/Socket/0 (socket usocket)))) -(defmethod get-local-port ((usocket usocket)) +(defmethod get-peer-address ((usocket datagram-usocket)) + (get-address (jcall $@getInetAddress/DatagramSocket/0 (socket usocket)))) + +(defmethod get-local-port ((usocket stream-usocket)) (jcall $@getLocalPort/Socket/0 (socket usocket))) (defmethod get-local-port ((usocket stream-server-usocket)) (jcall $@getLocalPort/ServerSocket/0 (socket usocket))) -(defmethod get-peer-port ((usocket usocket)) +(defmethod get-local-port ((usocket datagram-usocket)) + (jcall $@getLocalPort/DatagramSocket/0 (socket usocket))) + +(defmethod get-peer-port ((usocket stream-usocket)) (jcall $@getPort/Socket/0 (socket usocket))) + +(defmethod get-peer-port ((usocket datagram-usocket)) + (jcall $@getPort/DatagramSocket/0 (socket usocket))) + +;;; SOCKET-SEND & SOCKET-RECEIVE + +(defmethod socket-send ((socket datagram-usocket) buffer length &key host port) + (with-mapped-conditions (socket) + )) + +(defmethod socket-receive ((socket datagram-usocket) buffer length + &key (element-type '(unsigned-byte 8))) + (with-mapped-conditions (socket) + )) + +;;; WAIT-FOR-INPUT + +(defun socket-channel-class (usocket) + (cond ((stream-usocket-p usocket) $*SocketChannel) + ((stream-server-usocket-p usocket) $*ServerSocketChannel) + ((datagram-usocket-p usocket) $*DatagramChannel))) + +(defun get-socket-channel (usocket) + (let ((method (cond ((stream-usocket-p usocket) $@getChannel/Socket/0) + ((stream-server-usocket-p usocket) $@getChannel/ServerSocket/0) + ((datagram-usocket-p usocket) $@getChannel/DatagramSocket/0)))) + (jcall method (socket usocket)))) + +(defun wait-for-input-internal (wait-list &key timeout) + (let* ((sockets (wait-list-waiters wait-list)) + (ops (logior $+op-read $+op-accept)) + (selector (jstatic $@open/Selector/0 $*Selector)) + (channels (mapcar #'get-socket-channel sockets))) + (unwind-protect + (with-mapped-conditions () + (dolist (channel channels) + (jcall $@configureBlocking/1 channel +java-false+) + (jcall $@register/2 channel selector (logand ops (jcall $@validOps/0 channel)))) + (let ((ready-count (if timeout + (jcall $@select/1 selector (truncate (* timeout 1000))) + (jcall $@select/0 selector)))) + (when (plusp ready-count) + (let* ((keys (jcall $@selectedKeys/0 selector)) + (iterator (jcall $@iterator/0 keys)) + (%wait (wait-list-%wait wait-list))) + (loop while (jcall $@hasNext/0 iterator) + do (let* ((key (jcall $@next/0 iterator)) + (channel (jcall $@channel/0 key))) + (setf (state (gethash channel %wait)) :read))))))) + (jcall $@close/Selector/0 selector) + (dolist (channel channels) + (jcall $@configureBlocking/1 channel +java-true+))))) + +;;; WAIT-LIST + +;;; NOTE from original worker (Erik): +;;; Note that even though Java has the concept of the Selector class, which +;;; remotely looks like a wait-list, it requires the sockets to be non-blocking. +;;; usocket however doesn't make any such guarantees and is therefore unable to +;;; use the concept outside of the waiting routine itself (blergh!). + +(defun %setup-wait-list (wl) + (setf (wait-list-%wait wl) + (make-hash-table :test #'equal :rehash-size 1.3d0))) + +(defun %add-waiter (wl w) + (setf (gethash (get-socket-channel w) (wait-list-%wait wl)) w)) + +(defun %remove-waiter (wl w) + (remhash (get-socket-channel w) (wait-list-%wait wl))) Modified: usocket/trunk/package.lisp ============================================================================== --- usocket/trunk/package.lisp (original) +++ usocket/trunk/package.lisp Mon Sep 13 11:33:20 2010 @@ -5,10 +5,6 @@ (in-package :usocket-system) -#+lispworks -(eval-when (:compile-toplevel :load-toplevel :execute) - (require "comm")) - (defpackage :usocket (:use :common-lisp) (:export #:*wildcard-host* Modified: usocket/trunk/usocket.asd ============================================================================== --- usocket/trunk/usocket.asd (original) +++ usocket/trunk/usocket.asd Mon Sep 13 11:33:20 2010 @@ -23,20 +23,19 @@ :components ((:file "split-sequence") #+mcl (:file "kqueue") #+openmcl (:file "ccl-send") - #+armedbear (:file "abcl-jdi") (:file "spawn-thread"))) (:file "usocket" :depends-on ("vendor")) (:file "condition" :depends-on ("usocket")) (:module "backend" :depends-on ("condition") - :components (#+clisp (:file "clisp") + :components (#+abcl (:file "abcl") + #+clisp (:file "clisp") #+cmu (:file "cmucl") #+scl (:file "scl") #+(or sbcl ecl) (:file "sbcl") #+lispworks (:file "lispworks") #+mcl (:file "mcl") #+openmcl (:file "openmcl") - #+allegro (:file "allegro") - #+armedbear (:file "armedbear"))) + #+allegro (:file "allegro"))) (:file "server" :depends-on ("backend")))) (defmethod perform ((op test-op) (c (eql (find-system :usocket)))) Modified: usocket/trunk/usocket.lisp ============================================================================== --- usocket/trunk/usocket.lisp (original) +++ usocket/trunk/usocket.lisp Mon Sep 13 11:33:20 2010 @@ -431,7 +431,8 @@ ((or (vector t 4) (array (unsigned-byte 8) (4))) (vector-quad-to-dotted-quad host)) - (integer (hbo-to-dotted-quad host)))) + (integer (hbo-to-dotted-quad host)) + (null "0.0.0.0"))) (defun ip= (ip1 ip2) (etypecase ip1 @@ -452,7 +453,7 @@ ;; DNS helper functions ;; -#-(or clisp armedbear) +#-clisp (progn (defun get-host-by-name (name) (let ((hosts (get-hosts-by-name name)))

1 0

[usocket-cvs] r554 - in usocket/trunk: backend test
by Chun Tian 11 Sep '10

11 Sep '10

Author: ctian Date: Sat Sep 11 09:34:27 2010 New Revision: 554 Log: New ABCL backend using latest JAVA interface. Added: usocket/trunk/backend/abcl.lisp (contents, props changed) usocket/trunk/test/test-condition.lisp (contents, props changed) Added: usocket/trunk/backend/abcl.lisp ============================================================================== --- (empty file) +++ usocket/trunk/backend/abcl.lisp Sat Sep 11 09:34:27 2010 @@ -0,0 +1,202 @@ +;;;; $Id$ +;;;; $URL$ + +;;;; New ABCL networking support (replacement to old armedbear.lisp) +;;;; Author: Chun Tian (binghe) + +;;;; See LICENSE for licensing information. + +(in-package :usocket) + +;;; Java Classes ($*...) +(defvar $*boolean (jclass "boolean")) +(defvar $*int (jclass "int")) +(defvar $*DatagramSocket (jclass "java.net.DatagramSocket")) +(defvar $*Inet4Address (jclass "java.net.Inet4Address")) +(defvar $*InetAddress (jclass "java.net.InetAddress")) +(defvar $*InetSocketAddress (jclass "java.net.InetSocketAddress")) +(defvar $*ServerSocket (jclass "java.net.ServerSocket")) +(defvar $*Socket (jclass "java.net.Socket")) +(defvar $*SocketAddress (jclass "java.net.SocketAddress")) +(defvar $*String (jclass "java.lang.String")) + +;;; Java Constructor ($%.../n) +(defvar $%DatagramSocket/0 (jconstructor $*DatagramSocket)) +(defvar $%InetSocketAddress/1 (jconstructor $*InetSocketAddress $*int)) +(defvar $%InetSocketAddress/2 (jconstructor $*InetSocketAddress $*InetAddress $*int)) +(defvar $%ServerSocket/0 (jconstructor $*ServerSocket)) +(defvar $%ServerSocket/1 (jconstructor $*ServerSocket $*int)) +(defvar $%ServerSocket/2 (jconstructor $*ServerSocket $*int $*int)) +(defvar $%ServerSocket/3 (jconstructor $*ServerSocket $*int $*int $*InetAddress)) +(defvar $%Socket/0 (jconstructor $*Socket)) +(defvar $%Socket/2 (jconstructor $*Socket $*InetAddress $*int)) +(defvar $%Socket/4 (jconstructor $*Socket $*InetAddress $*int $*InetAddress $*int)) + +;;; Java Methods ($@...[/Class]/n) +(defvar $@accept/0 (jmethod $*ServerSocket "accept")) +(defvar $@bind/1 (jmethod $*ServerSocket "bind" $*SocketAddress)) +(defvar $@bind/2 (jmethod $*ServerSocket "bind" $*SocketAddress $*int)) +(defvar $@close/ServerSocket/0 (jmethod $*ServerSocket "close")) +(defvar $@close/Socket/0 (jmethod $*Socket "close")) +(defvar $@connect/1 (jmethod $*Socket "connect" $*SocketAddress)) +(defvar $@connect/2 (jmethod $*Socket "connect" $*SocketAddress $*int)) +(defvar $@getAddress/0 (jmethod $*Inet4Address "getAddress")) +(defvar $@getAllByName/1 (jmethod $*InetAddress "getAllByName" $*String)) +(defvar $@getByName/1 (jmethod $*InetAddress "getByName" $*String)) +(defvar $@getHostName/0 (jmethod $*InetAddress "getHostName")) +(defvar $@getInetAddress/ServerSocket/0 (jmethod $*ServerSocket "getInetAddress")) +(defvar $@getInetAddress/Socket/0 (jmethod $*Socket "getInetAddress")) +(defvar $@getLocalAddress/Socket/0 (jmethod $*Socket "getLocalAddress")) +(defvar $@getLocalPort/ServerSocket/0 (jmethod $*ServerSocket "getLocalPort")) +(defvar $@getLocalPort/Socket/0 (jmethod $*Socket "getLocalPort")) +(defvar $@getPort/Socket/0 (jmethod $*Socket "getPort")) +(defvar $@setReuseAddress/1 (jmethod $*ServerSocket "setReuseAddress" $*boolean)) + +;;; Wrapper functions (return-type: java-object) +(defun %get-address (address) + (jcall $@getAddress/0 address)) +(defun %get-all-by-name (string) ; return a simple vector + (jstatic $@getAllByName/1 $*InetAddress string)) +(defun %get-by-name (string) + (jstatic $@getByName/1 $*InetAddress string)) + +;;; HANDLE-CONTITION + +(defun handle-condition (condition &optional (socket nil)) + (typecase condition + (java-exception + (let ((java-cause (java-exception-cause condition))) + (let* ((usock-error (cdr (assoc (jclass-of java-cause) +abcl-error-map+ + :test #'string=))) + (usock-error (if (functionp usock-error) + (funcall usock-error condition) + usock-error)) + (nameserver-error (cdr (assoc (jclass-of java-cause) +abcl-nameserver-error-map+ + :test #'string=)))) + (if nameserver-error + (error nameserver-error :host-or-ip nil) + (when usock-error + (error usock-error :socket socket)))))))) + +(defparameter +abcl-error-map+ + `(;("java.io.IOException" . ) + ("java.net.ConnectException" . connection-refused-error) + ("java.net.SocketTimeoutException" . timeout-error) + ("java.net.BindException" . operation-not-permitted-error))) + +(defparameter +abcl-nameserver-error-map+ + `(("java.net.UnknownHostException" . ns-host-not-found-error))) + +;;; GET-HOSTS-BY-NAME + +(defun get-address (address) + (let* ((array (%get-address address)) + (length (jarray-length array))) + (labels ((jbyte (n) + (let ((byte (jarray-ref array n))) + (if (plusp byte) + byte + (+ 256 byte))))) + (if (= 4 length) + (vector (jbyte 0) (jbyte 1) (jbyte 2) (jbyte 3)) + nil)))) ; not a IPv4 address?! + +(defun get-hosts-by-name (name) + (with-mapped-conditions () + (map 'list #'get-address (%get-all-by-name name)))) + +(defun host-to-inet4 (host) + "USOCKET host formats to Java Inet4Address, used internally." + (%get-by-name (host-to-hostname host))) + +;;; GET-HOST-BY-ADDRESS +(defun get-host-by-address (host) + (let ((inet4 (host-to-inet4 host))) + (with-mapped-conditions () + (jcall $@getHostName/0 inet4)))) + +;;; SOCKET-CONNECT + +(defun socket-connect (host port &key (protocol :stream) (element-type 'character) + timeout deadline (nodelay t nodelay-supplied-p) + local-host local-port) + (declare (type integer timeout)) + (if (eq protocol :stream) + (let* ((socket (with-mapped-conditions () + (if (or local-host local-port) + (jnew $%Socket/4 (host-to-inet4 host) port (host-to-inet4 local-host) local-port) + (if timeout + (let ((socket (jnew $%Socket/0)) + (address (jnew $%InetSocketAddress/2 (host-to-inet4 host) port))) + (jcall $@connect/2 socket address timeout) + socket) + (jnew $%Socket/2 (host-to-inet4 host) port))))) + (stream (ext:get-socket-stream socket :element-type element-type)) + (usocket (make-stream-socket :stream stream :socket socket))) + usocket) + (socket-connect-for-udp host port :timeout timeout :local-host local-host :local-port local-port))) + +(defun socket-connect-for-udp (host port &key timeout local-host local-port) + ) + +(defun socket-listen (host port &key reuseaddress (element-type 'character) + (reuse-address nil reuse-address-supplied-p) + (backlog 5 backlog-supplied-p)) + (let ((socket (jnew $%ServerSocket/0)) + (endpoint (jnew $%InetSocketAddress/2 (host-to-inet4 host) port))) + #+ignore ;; TODO: java.lang.IllegalArgumentException? + (when reuse-address-supplied-p + (jcall $@setReuseAddress/1 socket reuse-address)) + (with-mapped-conditions (socket) + (if backlog-supplied-p + (jcall $@bind/2 socket endpoint backlog) + (jcall $@bind/1 socket endpoint))) + (make-stream-server-socket socket :element-type element-type))) + +(defmethod socket-accept ((socket stream-server-usocket) &key (element-type 'character)) + (with-mapped-conditions (socket) + (let* ((client-socket (jcall $@accept/0 socket)) + (stream (ext:get-socket-stream client-socket :element-type element-type))) + (make-stream-socket :stream stream :socket client-socket)))) + +(defmethod socket-close :before ((usocket usocket)) + (when (wait-list usocket) + (remove-waiter (wait-list usocket) usocket))) + +(defmethod socket-close ((usocket usocket)) + (with-mapped-conditions (usocket) + (jcall $@close/Socket/0 (socket usocket)))) + +(defmethod socket-close ((usocket stream-server-usocket)) + (with-mapped-conditions (usocket) + (jcall $@close/ServerSocket/0 (socket usocket)))) + +(defmethod socket-close ((usocket stream-usocket)) + (with-mapped-conditions (usocket) + (close (socket-stream usocket)))) + +(defmethod get-local-name ((usocket usocket)) + (values (get-local-address usocket) + (get-local-port usocket))) + +(defmethod get-peer-name ((usocket stream-usocket)) + (values (get-peer-address usocket) + (get-peer-port usocket))) + +(defmethod get-local-address ((usocket usocket)) + (get-address (jcall $@getLocalAddress/Socket/0 (socket usocket)))) + +(defmethod get-local-address ((usocket stream-server-usocket)) + (get-address (jcall $@getInetAddress/ServerSocket/0 (socket usocket)))) + +(defmethod get-peer-address ((usocket usocket)) + (get-address (jcall $@getInetAddress/Socket/0 (socket usocket)))) + +(defmethod get-local-port ((usocket usocket)) + (jcall $@getLocalPort/Socket/0 (socket usocket))) + +(defmethod get-local-port ((usocket stream-server-usocket)) + (jcall $@getLocalPort/ServerSocket/0 (socket usocket))) + +(defmethod get-peer-port ((usocket usocket)) + (jcall $@getPort/Socket/0 (socket usocket))) Added: usocket/trunk/test/test-condition.lisp ============================================================================== --- (empty file) +++ usocket/trunk/test/test-condition.lisp Sat Sep 11 09:34:27 2010 @@ -0,0 +1,28 @@ +;;;; $Id$ +;;;; $URL$ + +(in-package :usocket-test) + +(deftest ns-host-not-found-error.1 + (with-caught-conditions (usocket:ns-host-not-found-error nil) + (usocket:socket-connect "xxx" 123) + t) + nil) + +(deftest timeout-error.1 + (with-caught-conditions (usocket:timeout-error nil) + (usocket:socket-connect "common-lisp.net" 81 :timeout 1) + t) + nil) + +(deftest connection-refused-error.1 + (with-caught-conditions (usocket:connection-refused-error nil) + (usocket:socket-connect "common-lisp.net" 81) + t) + nil) + +(deftest operation-not-permitted-error.1 + (with-caught-conditions (usocket:operation-not-permitted-error nil) + (usocket:socket-listen "0.0.0.0" 81) + t) + nil)

1 0

[usocket-cvs] r553 - in usocket/trunk: . backend vendor
by Chun Tian 20 Jul '10

20 Jul '10

Author: ctian Date: Tue Jul 20 01:48:39 2010 New Revision: 553 Log: ABCL: move JDI into vendor directory. Added: usocket/trunk/vendor/abcl-jdi.lisp (contents, props changed) Modified: usocket/trunk/backend/armedbear.lisp usocket/trunk/usocket.asd Modified: usocket/trunk/backend/armedbear.lisp ============================================================================== --- usocket/trunk/backend/armedbear.lisp (original) +++ usocket/trunk/backend/armedbear.lisp Tue Jul 20 01:48:39 2010 @@ -5,178 +5,6 @@ (in-package :usocket) - -;;; Proposed contribution to the JAVA package - -(defpackage :jdi - (:use :cl) - (:export #:jcoerce - #:jop-deref - #:do-jmethod-call - #:do-jmethod - #:do-jstatic-call - #:do-jstatic - #:do-jnew-call - #:do-jfield - #:jequals)) -;; but still requires the :java package. - -(in-package :jdi) - -(defstruct (java-object-proxy (:conc-name :jop-) - :copier) - value - class) - -(defvar *jm-get-return-type* - (java:jmethod "java.lang.reflect.Method" "getReturnType")) - -(defvar *jf-get-type* - (java:jmethod "java.lang.reflect.Field" "getType")) - -(defvar *jc-get-declaring-class* - (java:jmethod "java.lang.reflect.Constructor" "getDeclaringClass")) - -(declaim (inline make-return-type-proxy)) -(defun make-return-type-proxy (jmethod jreturned-value) - (if (java:java-object-p jreturned-value) - (let ((rt (java:jcall *jm-get-return-type* jmethod))) - (make-java-object-proxy :value jreturned-value - :class rt)) - jreturned-value)) - -(defun make-field-type-proxy (jfield jreturned-value) - (if (java:java-object-p jreturned-value) - (let ((rt (java:jcall *jf-get-type* jfield))) - (make-java-object-proxy :value jreturned-value - :class rt)) - jreturned-value)) - -(defun make-constructor-type-proxy (jconstructor jreturned-value) - (if (java:java-object-p jreturned-value) - (let ((rt (java:jcall *jc-get-declaring-class* jconstructor))) - (make-java-object-proxy :value jreturned-value - :class rt)) - jreturned-value)) - -(defun jcoerce (instance &optional output-type-spec) - (cond - ((java-object-proxy-p instance) - (let ((new-instance (copy-structure (the java-object-proxy instance)))) - (setf (jop-class new-instance) - (java:jclass output-type-spec)) - new-instance)) - ((java:java-object-p instance) - (make-java-object-proxy :class (java:jclass output-type-spec) - :value instance)) - ((stringp instance) - (make-java-object-proxy :class "java.lang.String" - :value instance)) - ((keywordp output-type-spec) - ;; all that remains is creating an immediate type... - (let ((jval (java:make-immediate-object instance output-type-spec))) - (make-java-object-proxy :class output-type-spec - :value jval))) - )) - -(defun jtype-of (instance) ;;instance must be a jop - (cond - ((stringp instance) - "java.lang.String") - ((keywordp (jop-class instance)) - (string-downcase (symbol-name (jop-class instance)))) - (t - (java:jclass-name (jop-class instance))))) - -(declaim (inline jop-deref)) -(defun jop-deref (instance) - (if (java-object-proxy-p instance) - (jop-value instance) - instance)) - -(defun java-value-and-class (object) - (values (jop-deref object) - (jtype-of object))) - -(defun do-jmethod-call (object method-name &rest arguments) - (multiple-value-bind - (instance class-name) - (java-value-and-class object) - (let* ((argument-types (mapcar #'jtype-of arguments)) - (jm (apply #'java:jmethod class-name method-name argument-types)) - (rv (apply #'java:jcall jm instance - (mapcar #'jop-deref arguments)))) - (make-return-type-proxy jm rv)))) - -(defun do-jstatic-call (class-name method-name &rest arguments) - (let* ((argument-types (mapcar #'jtype-of arguments)) - (jm (apply #'java:jmethod class-name method-name argument-types)) - (rv (apply #'java:jstatic jm (java:jclass class-name) - (mapcar #'jop-deref arguments)))) - (make-return-type-proxy jm rv))) - -(defun do-jnew-call (class-name &rest arguments) - (let* ((argument-types (mapcar #'jtype-of arguments)) - (jm (apply #'java:jconstructor class-name argument-types)) - (rv (apply #'java:jnew jm (mapcar #'jop-deref arguments)))) - (make-constructor-type-proxy jm rv))) - -(defun do-jfield (class-or-instance-or-name field-name) - (let* ((class (cond - ((stringp class-or-instance-or-name) - (java:jclass class-or-instance-or-name)) - ((java:java-object-p class-or-instance-or-name) - (java:jclass-of class-or-instance-or-name)) - ((java-object-proxy-p class-or-instance-or-name) - (java:jclass (jtype-of class-or-instance-or-name))))) - (jf (java:jcall (java:jmethod "java.lang.Class" "getField" - "java.lang.String") - class field-name))) - (make-field-type-proxy jf - (java:jfield class field-name)))) ;;class)))) - -(defmacro do-jstatic (&rest arguments) - `(do-jstatic-call ,@arguments)) - -(defmacro do-jmethod (&rest arguments) - `(do-jmethod-call ,@arguments)) - -;; - -(defmacro jstatic-call (class-name (method-name &rest arg-spec) - &rest args) - (let ((class-sym (gensym))) - `(let ((,class-sym ,class-name)) - (java:jstatic - (java:jmethod ,class-sym ,method-name ,@arg-spec) - (java:jclass ,class-sym) ,@args)))) - -(defmacro jmethod-call (instance-and-class (method &rest arg-spec) &rest args) - (let ((isym (gensym))) - (multiple-value-bind - (instance class-name) - (if (listp instance-and-class) - (values (first instance-and-class) - (second instance-and-class)) - (values instance-and-class)) - (when (null class-name) - (setf class-name `(java:jclass-name (java:jclass-of ,isym)))) - `(let* ((,isym ,instance)) - (java:jcall (java:jmethod ,class-name ,method ,@arg-spec) - ,isym ,@args))))) - -(defun jequals (x y) - (do-jmethod-call (jcoerce x "java.lang.Object") "equals" - (jcoerce y "java.lang.Object"))) - -(defmacro jnew-call ((class &rest arg-spec) &rest args) - `(java:jnew (java:jconstructor ,class ,@arg-spec) - ,@args)) - - - -(in-package :usocket) - (defun get-host-name () (jdi:do-jmethod-call (jdi:do-jstatic-call "java.net.InetAddress" "getLocalHost") Modified: usocket/trunk/usocket.asd ============================================================================== --- usocket/trunk/usocket.asd (original) +++ usocket/trunk/usocket.asd Tue Jul 20 01:48:39 2010 @@ -23,6 +23,7 @@ :components ((:file "split-sequence") #+mcl (:file "kqueue") #+openmcl (:file "ccl-send") + #+armedbear (:file "abcl-jdi") (:file "spawn-thread"))) (:file "usocket" :depends-on ("vendor")) (:file "condition" :depends-on ("usocket")) Added: usocket/trunk/vendor/abcl-jdi.lisp ============================================================================== --- (empty file) +++ usocket/trunk/vendor/abcl-jdi.lisp Tue Jul 20 01:48:39 2010 @@ -0,0 +1,170 @@ +;;;; $Id$ +;;;; $URL$ + +;;;; Proposed contribution to the JAVA package, by Erik Huelsmann + +(defpackage :jdi + (:use :cl) + (:export #:jcoerce + #:jop-deref + #:do-jmethod-call + #:do-jmethod + #:do-jstatic-call + #:do-jstatic + #:do-jnew-call + #:do-jfield + #:jequals)) + +;; but still requires the :java package. + +(in-package :jdi) + +(defstruct (java-object-proxy (:conc-name :jop-) + :copier) + value + class) + +(defvar *jm-get-return-type* + (java:jmethod "java.lang.reflect.Method" "getReturnType")) + +(defvar *jf-get-type* + (java:jmethod "java.lang.reflect.Field" "getType")) + +(defvar *jc-get-declaring-class* + (java:jmethod "java.lang.reflect.Constructor" "getDeclaringClass")) + +(declaim (inline make-return-type-proxy)) +(defun make-return-type-proxy (jmethod jreturned-value) + (if (java:java-object-p jreturned-value) + (let ((rt (java:jcall *jm-get-return-type* jmethod))) + (make-java-object-proxy :value jreturned-value + :class rt)) + jreturned-value)) + +(defun make-field-type-proxy (jfield jreturned-value) + (if (java:java-object-p jreturned-value) + (let ((rt (java:jcall *jf-get-type* jfield))) + (make-java-object-proxy :value jreturned-value + :class rt)) + jreturned-value)) + +(defun make-constructor-type-proxy (jconstructor jreturned-value) + (if (java:java-object-p jreturned-value) + (let ((rt (java:jcall *jc-get-declaring-class* jconstructor))) + (make-java-object-proxy :value jreturned-value + :class rt)) + jreturned-value)) + +(defun jcoerce (instance &optional output-type-spec) + (cond + ((java-object-proxy-p instance) + (let ((new-instance (copy-structure (the java-object-proxy instance)))) + (setf (jop-class new-instance) + (java:jclass output-type-spec)) + new-instance)) + ((java:java-object-p instance) + (make-java-object-proxy :class (java:jclass output-type-spec) + :value instance)) + ((stringp instance) + (make-java-object-proxy :class "java.lang.String" + :value instance)) + ((keywordp output-type-spec) + ;; all that remains is creating an immediate type... + (let ((jval (java:make-immediate-object instance output-type-spec))) + (make-java-object-proxy :class output-type-spec + :value jval))) + )) + +(defun jtype-of (instance) ;;instance must be a jop + (cond + ((stringp instance) + "java.lang.String") + ((keywordp (jop-class instance)) + (string-downcase (symbol-name (jop-class instance)))) + (t + (java:jclass-name (jop-class instance))))) + +(declaim (inline jop-deref)) +(defun jop-deref (instance) + (if (java-object-proxy-p instance) + (jop-value instance) + instance)) + +(defun java-value-and-class (object) + (values (jop-deref object) + (jtype-of object))) + +(defun do-jmethod-call (object method-name &rest arguments) + (multiple-value-bind + (instance class-name) + (java-value-and-class object) + (let* ((argument-types (mapcar #'jtype-of arguments)) + (jm (apply #'java:jmethod class-name method-name argument-types)) + (rv (apply #'java:jcall jm instance + (mapcar #'jop-deref arguments)))) + (make-return-type-proxy jm rv)))) + +(defun do-jstatic-call (class-name method-name &rest arguments) + (let* ((argument-types (mapcar #'jtype-of arguments)) + (jm (apply #'java:jmethod class-name method-name argument-types)) + (rv (apply #'java:jstatic jm (java:jclass class-name) + (mapcar #'jop-deref arguments)))) + (make-return-type-proxy jm rv))) + +(defun do-jnew-call (class-name &rest arguments) + (let* ((argument-types (mapcar #'jtype-of arguments)) + (jm (apply #'java:jconstructor class-name argument-types)) + (rv (apply #'java:jnew jm (mapcar #'jop-deref arguments)))) + (make-constructor-type-proxy jm rv))) + +(defun do-jfield (class-or-instance-or-name field-name) + (let* ((class (cond + ((stringp class-or-instance-or-name) + (java:jclass class-or-instance-or-name)) + ((java:java-object-p class-or-instance-or-name) + (java:jclass-of class-or-instance-or-name)) + ((java-object-proxy-p class-or-instance-or-name) + (java:jclass (jtype-of class-or-instance-or-name))))) + (jf (java:jcall (java:jmethod "java.lang.Class" "getField" + "java.lang.String") + class field-name))) + (make-field-type-proxy jf + (java:jfield class field-name)))) ;;class)))) + +(defmacro do-jstatic (&rest arguments) + `(do-jstatic-call ,@arguments)) + +(defmacro do-jmethod (&rest arguments) + `(do-jmethod-call ,@arguments)) + +;; + +(defmacro jstatic-call (class-name (method-name &rest arg-spec) + &rest args) + (let ((class-sym (gensym))) + `(let ((,class-sym ,class-name)) + (java:jstatic + (java:jmethod ,class-sym ,method-name ,@arg-spec) + (java:jclass ,class-sym) ,@args)))) + +(defmacro jmethod-call (instance-and-class (method &rest arg-spec) &rest args) + (let ((isym (gensym))) + (multiple-value-bind + (instance class-name) + (if (listp instance-and-class) + (values (first instance-and-class) + (second instance-and-class)) + (values instance-and-class)) + (when (null class-name) + (setf class-name `(java:jclass-name (java:jclass-of ,isym)))) + `(let* ((,isym ,instance)) + (java:jcall (java:jmethod ,class-name ,method ,@arg-spec) + ,isym ,@args))))) + +(defun jequals (x y) + (do-jmethod-call (jcoerce x "java.lang.Object") "equals" + (jcoerce y "java.lang.Object"))) + +(defmacro jnew-call ((class &rest arg-spec) &rest args) + `(java:jnew (java:jconstructor ,class ,@arg-spec) + ,@args))

1 0

[usocket-cvs] r552 - in usocket/trunk: . backend test vendor
by Chun Tian 20 Jul '10

20 Jul '10

Author: ctian Date: Tue Jul 20 00:29:48 2010 New Revision: 552 Log: Update ignore properties for ECL. Modified: usocket/trunk/ (props changed) usocket/trunk/backend/ (props changed) usocket/trunk/test/ (props changed) usocket/trunk/vendor/ (props changed)

1 0

[usocket-cvs] r551 - in usocket/trunk: . backend vendor
by Chun Tian 20 Jul '10

20 Jul '10

Author: ctian Date: Tue Jul 20 00:27:18 2010 New Revision: 551 Log: Remove wrongly committed obj files Removed: usocket/trunk/backend/sbcl.obj usocket/trunk/condition.obj usocket/trunk/package.obj usocket/trunk/server.obj usocket/trunk/usocket.obj usocket/trunk/vendor/spawn-thread.obj usocket/trunk/vendor/split-sequence.obj

1 0

[usocket-cvs] r550 - in usocket/trunk: . backend vendor
by Chun Tian 20 Jul '10

20 Jul '10

Author: ctian Date: Tue Jul 20 00:25:42 2010 New Revision: 550 Log: ECL: first working WAIT-FOR-INPUT implementation on win32. Added: usocket/trunk/backend/sbcl.obj (contents, props changed) usocket/trunk/condition.obj (contents, props changed) usocket/trunk/package.obj (contents, props changed) usocket/trunk/server.obj (contents, props changed) usocket/trunk/usocket.obj (contents, props changed) usocket/trunk/vendor/spawn-thread.obj (contents, props changed) usocket/trunk/vendor/split-sequence.obj (contents, props changed) Modified: usocket/trunk/backend/sbcl.lisp usocket/trunk/usocket.lisp Modified: usocket/trunk/backend/sbcl.lisp ============================================================================== --- usocket/trunk/backend/sbcl.lisp (original) +++ usocket/trunk/backend/sbcl.lisp Tue Jul 20 00:25:42 2010 @@ -393,14 +393,12 @@ ;;; WAIT-FOR-INPUT support for SBCL on Windows platform (Chun Tian (binghe)) ;;; Based on LispWorks version written by Erik Huelsmann. -#+(and sbcl win32) -(eval-when (:compile-toplevel) +#+win32 ; shared by ECL and SBCL +(progn (defconstant +wsa-wait-failed+ #xffffffff) (defconstant +wsa-wait-event-0+ 0) - (defconstant +wsa-wait-timeout+ 258)) + (defconstant +wsa-wait-timeout+ 258) -#+(and sbcl win32) -(progn (defconstant fd-read 1) (defconstant fd-read-bit 0) (defconstant fd-write 2) @@ -424,6 +422,22 @@ (defconstant fd-max-events 10) (defconstant fionread 1074030207) + ;; Note: for ECL, socket-handle will return raw Windows Handle, + ;; while SBCL returns OSF Handle instead. + (defun socket-handle (usocket) + (sb-bsd-sockets:socket-file-descriptor (socket usocket))) + + (defun socket-ready-p (socket) + (if (typep socket 'stream-usocket) + (plusp (bytes-available-for-read socket)) + (%ready-p socket))) + + (defun waiting-required (sockets) + (notany #'socket-ready-p sockets)) +) ; progn + +#+(and sbcl win32) +(progn (sb-alien:define-alien-type ws-socket sb-alien:unsigned-int) (sb-alien:define-alien-type ws-dword sb-alien:unsigned-long) (sb-alien:define-alien-type ws-event sb-alien::hinstance) @@ -482,23 +496,12 @@ (defun os-socket-handle (usocket) (sockint::fd->handle (sb-bsd-sockets:socket-file-descriptor (socket usocket)))) - (defun socket-handle (usocket) - (sb-bsd-sockets:socket-file-descriptor (socket usocket))) - (defun bytes-available-for-read (socket) (sb-alien:with-alien ((int-ptr sb-alien:unsigned-long)) (maybe-wsa-error (wsa-ioctlsocket (os-socket-handle socket) fionread (sb-alien:addr int-ptr)) socket) int-ptr)) - (defun socket-ready-p (socket) - (if (typep socket 'stream-usocket) - (plusp (bytes-available-for-read socket)) - (%ready-p socket))) - - (defun waiting-required (sockets) - (notany #'socket-ready-p sockets)) - (defun wait-for-input-internal (wait-list &key timeout) (when (waiting-required (wait-list-waiters wait-list)) (let ((rv (wsa-wait-for-multiple-events 1 (wait-list-%wait wait-list) @@ -589,3 +592,87 @@ (defun %remove-waiter (wl w) (declare (ignore wl w))) ) ; progn + +#+(and ecl win32) +(progn + (defun maybe-wsa-error (rv &optional syscall) + (unless (zerop rv) + (sb-bsd-sockets::socket-error syscall))) + + (defun %setup-wait-list (wl) + (setf (wait-list-%wait wl) + (ffi:c-inline () () :int + "WSAEVENT event; + event = WSACreateEvent(); + @(return) = event;"))) + + (defun %add-waiter (wait-list waiter) + (let ((events (etypecase waiter + (stream-server-usocket (logior fd-connect fd-accept fd-close)) + (stream-usocket (logior fd-read)) + (datagram-usocket (logior fd-read))))) + (maybe-wsa-error + (ffi:c-inline ((socket-handle waiter) (wait-list-%wait wait-list) events) + (:fixnum :fixnum :fixnum) :fixnum + "int result; + result = WSAEventSelect((SOCKET)#0, (WSAEVENT)#1, (long)#2); + @(return) = result;") + '%add-waiter))) + + (defun %remove-waiter (wait-list waiter) + (maybe-wsa-error + (ffi:c-inline ((socket-handle waiter) (wait-list-%wait wait-list)) + (:fixnum :fixnum) :fixnum + "int result; + result = WSAEventSelect((SOCKET)#0, (WSAEVENT)#1, 0L); + @(return) = result;") + '%remove-waiter)) + + ;; TODO: how to handle error (result) in this call? + (defun bytes-available-for-read (socket) + (ffi:c-inline ((socket-handle socket)) (:fixnum) :fixnum + "u_long nbytes; + int result; + nbytes = 0L; + result = ioctlsocket((SOCKET)#0, FIONREAD, &nbytes); + @(return) = nbytes;")) + + (defun update-ready-and-state-slots (sockets) + (dolist (socket sockets) + (if (or (and (stream-usocket-p socket) + (listen (socket-stream socket))) + (%ready-p socket)) + (setf (state socket) :READ) + (let ((events (etypecase socket + (stream-server-usocket (logior fd-connect fd-accept fd-close)) + (stream-usocket (logior fd-read)) + (datagram-usocket (logior fd-read))))) + ;; TODO: check the iErrorCode array + (if (ffi:c-inline ((socket-handle socket) events) (:fixnum :fixnum) :bool + "WSANETWORKEVENTS network_events; + int i, result; + result = WSAEnumNetworkEvents((SOCKET)#0, 0, &network_events); + if (!result) { + @(return) = (#1 & network_events.lNetworkEvents)? Ct : Cnil; + } else + @(return) = Cnil;") + (setf (%ready-p socket) t + (state socket) :READ) + (sb-bsd-sockets::socket-error 'update-ready-and-state-slots)))))) + + (defun wait-for-input-internal (wait-list &key timeout) + (when (waiting-required (wait-list-waiters wait-list)) + (let ((rv (ffi:c-inline ((wait-list-%wait wait-list) (truncate (* 1000 timeout))) + (:fixnum :fixnum) :fixnum + "DWORD result; + WSAEVENT events[1]; + events[0] = (WSAEVENT)#0; + result = WSAWaitForMultipleEvents(1, events, NULL, #1, NULL); + @(return) = result;"))) + (ecase rv + ((#.+wsa-wait-event-0+ #.+wsa-wait-timeout+) + (update-ready-and-state-slots (wait-list-waiters wait-list))) + ((#.+wsa-wait-failed+) + (sb-bsd-sockets::socket-error 'wait-for-input-internal)))))) + +) ; progn Added: usocket/trunk/backend/sbcl.obj ============================================================================== Binary file. No diff available. Added: usocket/trunk/condition.obj ============================================================================== Binary file. No diff available. Added: usocket/trunk/package.obj ============================================================================== Binary file. No diff available. Added: usocket/trunk/server.obj ============================================================================== Binary file. No diff available. Modified: usocket/trunk/usocket.lisp ============================================================================== --- usocket/trunk/usocket.lisp (original) +++ usocket/trunk/usocket.lisp Tue Jul 20 00:25:42 2010 @@ -35,7 +35,7 @@ The last two remain unused in the current version. ") - #+(and win32 (or sbcl lispworks)) + #+(and win32 (or sbcl ecl lispworks)) (%ready-p :initform nil :accessor %ready-p @@ -304,11 +304,11 @@ (values (if ready-only socks socket-or-sockets) to))))) (let* ((start (get-internal-real-time)) (sockets-ready 0)) + #-(and win32 (or sbcl ecl)) (dolist (x (wait-list-waiters socket-or-sockets)) (when (setf (state x) (if (and (stream-usocket-p x) - (listen (socket-stream x)) - #+(and sbcl win32) nil) ; TODO: bug?! + (listen (socket-stream x))) :READ NIL)) (incf sockets-ready))) ;; the internal routine is responsibe for Added: usocket/trunk/usocket.obj ============================================================================== Binary file. No diff available. Added: usocket/trunk/vendor/spawn-thread.obj ============================================================================== Binary file. No diff available. Added: usocket/trunk/vendor/split-sequence.obj ============================================================================== Binary file. No diff available.

1 0

[usocket-cvs] r549 - usocket/trunk/backend
by Chun Tian 19 Jul '10

19 Jul '10

Author: ctian Date: Mon Jul 19 09:55:24 2010 New Revision: 549 Log: MCL: mark UDP (datagram) as unsupported. Modified: usocket/trunk/backend/mcl.lisp Modified: usocket/trunk/backend/mcl.lisp ============================================================================== --- usocket/trunk/backend/mcl.lisp (original) +++ usocket/trunk/backend/mcl.lisp Mon Jul 19 09:55:24 2010 @@ -72,7 +72,9 @@ (raise-error))))) (defun socket-connect (host port &key (element-type 'character) timeout deadline nodelay - local-host local-port) + local-host local-port (protocol :stream)) + (when (eq protocol :datagram) + (unsupported '(protocol :datagram) 'socket-connect)) (with-mapped-conditions () (let* ((socket (make-instance 'active-socket

1 0