This is the mail archive of the
kawa@sourceware.org
mailing list for the Kawa project.
Feature proposal: Kawa socket procedures
- From: Andrea Girotto <andrea dot girotto at gmail dot com>
- To: kawa at sourceware dot org
- Date: Sun, 27 Dec 2009 17:42:21 +0100
- Subject: Feature proposal: Kawa socket procedures
Developing a project of mine I found myself in the need of using a tcp stream.
At first I tried to code using the Java classes as if I were
developing in Java.
But then I thought how I would really like to write something as:
(call-with-socket "www.google.com" 80 client)
having:
(define (client socket :: <socket>)
(let ((input-port :: <input-port> (socket-input-port socket))
(output-port :: <output-port> (socket-output-port socket)) )
#| ... use the Scheme port connected to the network streams ... |# ) )
And also:
(with-ports-from-socket "www.google.com" 80 client-ports)
having:
(define (client-ports socket :: <socket>)
#|
| use (current-input-port) and (current-output-port) that
| are bound to the socket InputStream and OutputStream...
|# )
So the patch I'm attaching to this message is a library with
procedures (and a testsuite) that allows for example (searching Google
for "kawa language"):
(display (with-ports-from-socket "www.google.com" 80 client))(newline)
where the "client" procedure is (please take note that I'm using
standard I/O Scheme procedures and ports):
(define (client socket :: <socket>)
(set-socket-keep-alive! socket #f)
(let send-loop ((send-chars (string->list "GET
/search?q=kawa+language HTTP/1.0")))
(if (null? send-chars)
(begin
(write-char #\return)
(write-char #\newline)
(write-char #\return)
(write-char #\newline)
(force-output) )
(begin
(write-char (car send-chars))
(send-loop (cdr send-chars)) ) ) )
(let read-loop ((c (read-char))
(ret-val '()) )
(if (eof-object? c)
(list->string ret-val)
(read-loop (read-char) (append ret-val (list c))) ) )
)
The main aim of the library is to wrap the Java class in a Scheme-way
of coding, maintaining as strictly as possibile the Java compatibility
to give an already-known environment.
I implemented code to bind the input-port and output-port to the
socket's InputStream and OutputStream. But I still kept the ability to
use the Java object.
The type <socket> is implemented as a wrapper of java.net.Socket
(has-a relation) adding the "socket-java-implementation" procedure to
access the "native Java" socket (I had to do this way because
java.net.ServerSocket#accept returns a java.net.Socket).
Obviously "make-server-socket" returns a java.net.ServerSocket, and
"(server-socket-accept server-socket)" returns a <socket>.
The UDP and Multicast sockets where easier to wrap into Scheme procedures.
Attached to this feature request you'll find a patch (patch -p0 <
kawa-sockets.patch) against the svn release 6478.
I'm adding these files:
gnu/mapping/ServerSocket.java
gnu/mapping/Socket.java
kawa/lib/sockets.scm
testsuite/sockets.scm
and patching:
build.xml
gnu/mapping/Makefile.am
kawa/lib/Makefile.am
kawa/repl.java
kawa/standard/Scheme.java
testsuite/Makefile.am
gnu/expr/PrimProcedure.java
In the last file I'm adding:
((java.lang.reflect.Method)member).setAccessible(true);
before:
result = retType.coerceToObject(((java.lang.reflect.Method) member)
.invoke(ctx.value1, ctx.values));
to solve problems of accessing some sockets java "native" methods
during an interactive kawa session.
This is the list of the added procedures (see kawa/lib/sockets.scm):
socket?
make-socket
socket-bind
socket-connect
socket-input-port
socket-output-port
socket-local-endpoint
socket-remote-endpoint
socket-bound?
socket-connected?
socket-closed?
set-socket-keep-alive!
socket-keep-alive?
set-socket-reuse-address!
socket-reuse-address?
socket-shutdown-input
socket-input-shutdown?
socket-shutdown-output
socket-output-shutdown?
set-socket-tcp-no-delay!
socket-tcp-no-delay?
call-with-socket
with-ports-from-socket
socket-close
set-socket-out-of-band-inline!
socket-out-of-band-inline?
socket-urgent-data
socket-so-timeout set-socket-so-timeout!
socket-receive-buffer-size
set-socket-receive-buffer-size!
socket-send-buffer-size
set-socket-send-buffer-size!
socket-so-linger
set-socket-so-linger!
socket-traffic-class
set-socket-traffic-class!
socket-java-implementation
make-server-socket
server-socket?
server-socket-bind
server-socket-accept
server-socket-close
server-socket-local-endpoint
set-server-socket-reuse-address!
server-socket-reuse-address?
server-socket-bound?
server-socket-closed?
server-socket-so-timeout
set-server-socket-so-timeout!
server-socket-receive-buffer-size
set-server-socket-receive-buffer-size!
call-with-server-socket
make-datagram-packet
datagram-packet?
datagram-packet-remote-endpoint
set-datagram-packet-remote-endpoint!
datagram-packet-data
set-datagram-packet-data!
make-datagram-socket
datagram-socket?
datagram-socket-bind
datagram-socket-close
datagram-socket-connect
datagram-socket-disconnect
datagram-socket-broadcast?
set-datagram-socket-broadcast!
datagram-socket-local-endpoint
datagram-socket-remote-endpoint
datagram-socket-receive-buffer-size
set-datagram-socket-receive-buffer-size!
datagram-socket-reuse-address?
set-datagram-socket-reuse-address!
datagram-socket-so-timeout
set-datagram-socket-so-timeout!
datagram-socket-traffic-class
set-datagram-socket-traffic-class!
datagram-socket-bound?
datagram-socket-connected?
datagram-socket-closed?
datagram-socket-receive
datagram-socket-send
call-with-datagram-socket
multicast-socket?
make-multicast-socket
multicast-socket-bind
multicast-socket-connect
multicast-socket-disconnect
multicast-socket-broadcast?
set-multicast-socket-broadcast!
multicast-socket-local-endpoint
multicast-socket-remote-endpoint
multicast-socket-receive-buffer-size
set-multicast-socket-receive-buffer-size!
multicast-socket-so-timeout
set-multicast-socket-so-timeout!
multicast-socket-traffic-class
set-multicast-socket-traffic-class!
multicast-socket-bound?
multicast-socket-connected?
multicast-socket-close
multicast-socket-closed?
multicast-socket-receive
multicast-socket-send
multicast-socket-join-group
multicast-socket-leave-group
multicast-socket-time-to-live
set-multicast-socket-time-to-live!
call-with-multicast
Regards,
Andrea
Index: build.xml
===================================================================
--- build.xml (revision 6478)
+++ build.xml (working copy)
@@ -405,6 +405,7 @@
<include name="rnrs/sorting.scm"/>
<include name="rnrs/unicode.scm"/>
<include name="rnrs/programs.scm"/>
+ <include name="sockets.scm"/>
</fileset>
<target name="check-lib-scm-classes">
Index: gnu/expr/PrimProcedure.java
===================================================================
--- gnu/expr/PrimProcedure.java (revision 6478)
+++ gnu/expr/PrimProcedure.java (working copy)
@@ -282,8 +282,11 @@
System.arraycopy(arr, 0, result, 0, n);
}
else
+ {
+ ((java.lang.reflect.Method)member).setAccessible(true);
result = retType.coerceToObject(((java.lang.reflect.Method) member)
.invoke(ctx.value1, ctx.values));
+ }
if (! takesContext())
ctx.consumer.writeObject(result);
}
Index: gnu/mapping/Makefile.am
===================================================================
--- gnu/mapping/Makefile.am (revision 6478)
+++ gnu/mapping/Makefile.am (working copy)
@@ -57,7 +57,9 @@
ValueStack.java \
WrappedException.java \
WrongArguments.java \
- WrongType.java
+ WrongType.java \
+ Socket.java \
+ ServerSocket.java
EXTRA_DIST = package.html
Index: gnu/mapping/ServerSocket.java
===================================================================
--- gnu/mapping/ServerSocket.java (revision 0)
+++ gnu/mapping/ServerSocket.java (revision 0)
@@ -0,0 +1,54 @@
+package gnu.mapping;
+
+import gnu.lists.Consumer;
+import gnu.text.Printable;
+
+import java.io.IOException;
+import java.net.InetAddress;
+
+public class ServerSocket extends java.net.ServerSocket implements Printable {
+
+ public ServerSocket(int port, int backlog, InetAddress bindAddress) throws IOException {
+ super(port, backlog, bindAddress);
+ }
+
+ public ServerSocket(int port, int backlog) throws IOException {
+ super(port, backlog);
+ }
+
+ public ServerSocket(int port) throws IOException {
+ super(port);
+ }
+
+ public ServerSocket() throws IOException {
+ super();
+ }
+
+ public static ServerSocket serverSocketBind(int port, int backlog, InetAddress bindAddress) throws IOException {
+ return new ServerSocket(port, backlog, bindAddress);
+ }
+
+
+ public static ServerSocket valueOf() throws IOException {
+ return new ServerSocket();
+ }
+
+ public static ServerSocket valueOf(int port) throws IOException {
+ return new ServerSocket(port);
+ }
+
+ public static ServerSocket valueOf(int port, int backlog) throws IOException {
+ return new ServerSocket(port, backlog);
+ }
+
+ public static ServerSocket valueOf(int port, int backlog, InetAddress addr) throws IOException {
+ return new ServerSocket(port, backlog, addr);
+ }
+
+ public void print (Consumer out)
+ {
+ out.write("#<server-socket ");
+ out.write(super.toString());
+ out.write(">");
+ }
+}
Index: gnu/mapping/Socket.java
===================================================================
--- gnu/mapping/Socket.java (revision 0)
+++ gnu/mapping/Socket.java (revision 0)
@@ -0,0 +1,103 @@
+package gnu.mapping;
+import gnu.lists.Consumer;
+import gnu.text.Printable;
+
+import java.io.BufferedInputStream;
+import java.io.IOException;
+import java.io.InputStreamReader;
+import java.io.OutputStreamWriter;
+import java.io.Reader;
+import java.io.UnsupportedEncodingException;
+import java.io.Writer;
+import java.net.InetAddress;
+import java.net.SocketException;
+import java.net.UnknownHostException;
+
+public class Socket implements Printable
+{
+ OutPort outPort;
+ InPort inPort;
+ java.net.Socket socket;
+
+ public void bindInputPort() throws IOException {
+ if( !this.socket.isBound() || this.inPort!=null ) return;
+
+ final Object conv = Environment.user().get("port-char-encoding");
+ final BufferedInputStream is = new BufferedInputStream(this.socket.getInputStream());
+ final Reader reader;
+ if( conv!=null && conv!=Boolean.TRUE )
+ {
+ final String enc = conv==Boolean.FALSE ? "ISO-8859-1" : conv.toString();
+ reader = new InputStreamReader(is, enc);
+ }
+ else
+ {
+ reader = new InputStreamReader(is);
+ }
+
+ this.inPort = new InPort(reader);
+ }
+
+ public void bindOutputPort() throws IOException
+ {
+ if( !this.socket.isConnected() || this.outPort!=null ) return;
+
+ final Object conv = Environment.user().get("port-char-encoding");
+ final Writer writer;
+ if( conv!=null && conv!=Boolean.TRUE )
+ {
+ final String enc = conv==Boolean.FALSE ? "ISO-8859-1" : conv.toString();
+ writer = new OutputStreamWriter(this.socket.getOutputStream(), enc);
+ }
+ else
+ {
+ writer = new OutputStreamWriter(this.socket.getOutputStream());
+ }
+
+ this.outPort = new OutPort(writer);
+ }
+
+ public void bindPortsToStreams() throws IOException {
+ bindInputPort();
+ bindOutputPort();
+ }
+
+ public Socket(InetAddress address, int port) throws IOException {
+ this.socket = new java.net.Socket(address, port) ;
+ bindPortsToStreams();
+ }
+
+ public Socket(String address, int port) throws UnknownHostException, IOException {
+ this.socket = new java.net.Socket(address, port) ;
+ bindPortsToStreams();
+ }
+
+ Socket(java.net.Socket socket) throws IOException {
+ this.socket = socket;
+ if( this.socket.isConnected() ) bindPortsToStreams();
+ }
+
+ public static Socket valueOf(java.net.Socket s) throws IOException {
+ return new Socket(s);
+ }
+
+ public final InPort getInputPort() {
+ return this.inPort;
+ }
+
+ public final OutPort getOutputPort() {
+ return this.outPort;
+ }
+
+
+ public final java.net.Socket getJavaSocketImpl() {
+ return this.socket;
+ }
+
+ public void print (Consumer out)
+ {
+ out.write("#<client-socket ");
+ out.write(this.socket==null ? "not bound" : this.socket.toString());
+ out.write(">");
+ }
+}
Index: kawa/repl.java
===================================================================
--- kawa/repl.java (revision 6478)
+++ kawa/repl.java (working copy)
@@ -437,7 +437,7 @@
}
try
{
- Socket socket = new Socket(InetAddress.getByName(null), port);
+ java.net.Socket socket = new java.net.Socket(InetAddress.getByName(null), port);
Telnet conn = new Telnet(socket, true);
java.io.InputStream sin = conn.getInputStream();
java.io.OutputStream sout = conn.getOutputStream();
Index: kawa/lib/Makefile.am
===================================================================
--- kawa/lib/Makefile.am (revision 6478)
+++ kawa/lib/Makefile.am (working copy)
@@ -25,7 +25,8 @@
system.scm \
kawa/hashtable.scm kawa/regex.scm rnrs/hashtables.scm \
srfi95.scm rnrs/unicode.scm rnrs/sorting.scm rnrs/programs.scm \
- trace.scm
+ trace.scm \
+ sockets.scm
scm_WITH_AWT = windows.scm
EXTRA_DIST = $(java_SCM_ALWAYS) $(scm_WITH_AWT)
Index: kawa/lib/sockets.scm
===================================================================
--- kawa/lib/sockets.scm (revision 0)
+++ kawa/lib/sockets.scm (revision 0)
@@ -0,0 +1,657 @@
+(require <kawa.lib.prim_syntax>)
+(require <kawa.lib.std_syntax>)
+(require <kawa.lib.reflection>)
+(require <kawa.lib.syntax>)
+(require <kawa.lib.ports>)
+
+(module-export socket?
+ make-socket
+ socket-bind
+ socket-connect
+ socket-input-port
+ socket-output-port
+ socket-local-endpoint
+ socket-remote-endpoint
+ socket-bound?
+ socket-connected?
+ socket-closed?
+ set-socket-keep-alive! socket-keep-alive?
+ set-socket-reuse-address! socket-reuse-address?
+ socket-shutdown-input
+ socket-input-shutdown?
+ socket-shutdown-output
+ socket-output-shutdown?
+ set-socket-tcp-no-delay! socket-tcp-no-delay?
+ call-with-socket
+ with-ports-from-socket
+ socket-close
+ set-socket-out-of-band-inline! socket-out-of-band-inline?
+ socket-urgent-data
+ socket-so-timeout set-socket-so-timeout!
+ socket-receive-buffer-size set-socket-receive-buffer-size!
+ socket-send-buffer-size set-socket-send-buffer-size!
+ socket-so-linger set-socket-so-linger!
+ socket-traffic-class set-socket-traffic-class!
+ socket-java-implementation
+ make-server-socket
+ server-socket?
+ server-socket-bind
+ server-socket-accept
+ server-socket-close
+ server-socket-local-endpoint
+ set-server-socket-reuse-address! server-socket-reuse-address?
+ server-socket-bound?
+ server-socket-closed?
+ server-socket-so-timeout set-server-socket-so-timeout!
+ server-socket-receive-buffer-size set-server-socket-receive-buffer-size!
+ call-with-server-socket
+ make-datagram-packet
+ datagram-packet?
+ datagram-packet-remote-endpoint
+ set-datagram-packet-remote-endpoint!
+ datagram-packet-data
+ set-datagram-packet-data!
+ make-datagram-socket
+ datagram-socket?
+ datagram-socket-bind
+ datagram-socket-close
+ datagram-socket-connect
+ datagram-socket-disconnect
+ datagram-socket-broadcast? set-datagram-socket-broadcast!
+ datagram-socket-local-endpoint
+ datagram-socket-remote-endpoint
+ datagram-socket-receive-buffer-size
+ set-datagram-socket-receive-buffer-size!
+ datagram-socket-reuse-address?
+ set-datagram-socket-reuse-address!
+ datagram-socket-so-timeout
+ set-datagram-socket-so-timeout!
+ datagram-socket-traffic-class
+ set-datagram-socket-traffic-class!
+ datagram-socket-bound?
+ datagram-socket-connected?
+ datagram-socket-closed?
+ datagram-socket-receive
+ datagram-socket-send
+ call-with-datagram-socket
+ multicast-socket?
+ make-multicast-socket
+ multicast-socket-bind
+ multicast-socket-connect
+ multicast-socket-disconnect
+ multicast-socket-broadcast?
+ set-multicast-socket-broadcast!
+ multicast-socket-local-endpoint
+ multicast-socket-remote-endpoint
+ multicast-socket-receive-buffer-size
+ set-multicast-socket-receive-buffer-size!
+ multicast-socket-so-timeout
+ set-multicast-socket-so-timeout!
+ multicast-socket-traffic-class
+ set-multicast-socket-traffic-class!
+ multicast-socket-bound?
+ multicast-socket-connected?
+ multicast-socket-close
+ multicast-socket-closed?
+ multicast-socket-receive
+ multicast-socket-send
+ multicast-socket-join-group
+ multicast-socket-leave-group
+ multicast-socket-time-to-live
+ set-multicast-socket-time-to-live!
+ call-with-multicast-socket
+ )
+
+#|
+ | Parameter:
+ | socket the object
+ | Returns:
+ | true if object is a socket
+ |#
+(define (socket? x) :: <boolean>
+ (instance? x <socket>) )
+
+#|
+ | Creates a new socket
+ | Parameter:
+ | host String of the host to connect to (i.e. "www.gnu.org"
+ | port Port number to connect to
+ | Returns:
+ | the socket object
+ |#
+(define make-socket
+ (make-procedure
+ method: (lambda () (<socket> (java.net.Socket)))
+ method: (lambda (host port) (<socket> (java.net.Socket (*:to-string host) port))) ) )
+
+#|
+ | Gets the java implementation (java.net.Socket) of the socket
+ | Parameter:
+ | socket the object
+ | Returns:
+ | the java.net.Socket object that backs up the socket
+ |#
+(define (socket-java-implementation socket :: <socket>) :: <java.net.Socket>
+ (*:get-java-socket-impl socket) )
+
+#|
+ | Connects the socket to the server
+ | Parameter:
+ | socket the object
+ | host String of the host to connect to (i.e. "www.gnu.org"
+ | port Port number to connect to
+ | timeout
+ |#
+(define socket-connect
+ (make-procedure
+ method: (lambda (socket :: <socket> host port timeout)
+ (begin
+ (*:connect (socket-java-implementation socket)
+ (java.net.InetSocketAddress (*:to-string host) port)
+ timeout )
+ (*:bind-ports-to-streams socket) ) )
+ method: (lambda (socket :: <socket> host port)
+ (socket-connect socket host port 0) ) ) )
+
+(define socket-bind
+ (make-procedure
+ method: (lambda (socket :: <socket> host port)
+ (begin
+ (*:bind (socket-java-implementation socket)
+ (java.net.InetSocketAddress (*:to-string host) port) )
+ (*:bind-ports-to-streams socket) ) ) ) )
+
+#|
+ | Closes the socket
+ | Parameter:
+ | socket the socket object
+ | host String of the host to connect to (i.e. "www.gnu.org"
+ | port Port number to connect to
+ | timeout 0 means wait forever
+ |#
+(define (socket-close socket :: <socket>)
+ (begin
+ (force-output (socket-output-port socket))
+ (*:close (socket-java-implementation socket)) ) )
+
+#|
+ | Gets the socket's input port
+ | Parameter:
+ | socket the socket object
+ | Returns:
+ | the (scheme) input port bound to the socket's java.io.InputStream
+ |#
+(define (socket-input-port socket :: <socket>) :: <input-port>
+ (*:get-input-port socket))
+
+#|
+ | Gets the socket's output port
+ | Parameter:
+ | socket the socket object
+ | Returns:
+ | the (scheme) output port bound to the socket's java.io.OutputStream
+ |#
+(define (socket-output-port socket :: <socket>) :: <output-port>
+ (*:get-output-port socket))
+
+#|
+ | Gets the socket's local endpoint
+ | Parameter:
+ | socket the socket object
+ | Returns:
+ | a list: (local-host local-port)
+ |#
+(define (socket-local-endpoint socket :: <socket>)
+ (let ((j-socket :: <java.net.Socket> (socket-java-implementation socket)))
+ (list (*:get-host-address (*:get-local-address j-socket))
+ (*:get-local-port j-socket) ) ) )
+
+#|
+ | Gets the socket's remote endpoint
+ | Parameter:
+ | socket the socket object
+ | Returns:
+ | a list: (remote-host remote-port)
+ |#
+(define (socket-remote-endpoint socket :: <socket>)
+ (let ((j-socket :: <java.net.Socket> (socket-java-implementation socket)))
+ (list (*:get-host-address (*:get-inet-address j-socket))
+ (*:get-port j-socket) ) ) )
+
+; Enables/disables OOBINLINE: receipt of TCP urgent data
+(define (set-socket-out-of-band-inline! socket :: <socket> enable :: <boolean>)
+ (*:setOOBInline (socket-java-implementation socket) enable) )
+
+; true if OOBINLINE is enabled
+(define (socket-out-of-band-inline? socket :: <socket>) :: <boolean>
+ (*:getOOBInline (socket-java-implementation socket)) )
+
+(define (socket-urgent-data socket :: <socket> data :: <integer>)
+ (*:send-urgent-data (socket-java-implementation socket) data) )
+
+; Enables/disables TCP_NODELAY
+(define (set-socket-tcp-no-delay! socket :: <socket> enable :: <boolean>)
+ (*:set-tcp-no-delay (socket-java-implementation socket) enable) )
+
+; true if TCP_NODELAY is enabled
+(define (socket-tcp-no-delay? socket :: <socket>) :: <boolean>
+ (*:get-tcp-no-delay (socket-java-implementation socket)) )
+
+; Enable/disable SO_KEEPALIVE
+(define (set-socket-keep-alive! socket :: <socket> enable :: <boolean>)
+ (*:set-keep-alive (socket-java-implementation socket) enable) )
+
+; true if SO_KEEPALIVE
+(define (socket-keep-alive? socket :: <socket>) :: <boolean>
+ (*:get-keep-alive (socket-java-implementation socket)) )
+
+; Enables/disables the SO_REUSEADDR socket option
+(define (set-socket-reuse-address! socket :: <socket> enable :: <boolean>) :: <void>
+ (*:set-reuse-address (socket-java-implementation socket) enable) )
+
+; true if SO_REUSEADDR is enabled
+(define (socket-reuse-address? socket :: <socket>) :: <boolean>
+ (*:get-reuse-address (socket-java-implementation socket)) )
+
+#|
+ | Gets the socket's bind status
+ | Parameter:
+ | socket the socket object
+ | Returns:
+ | true if the socket is bound
+ |#
+(define (socket-bound? socket :: <socket>) :: <boolean>
+ (*:bound? (socket-java-implementation socket)) )
+
+#|
+ | Gets the socket's connection status
+ | Parameter:
+ | socket the socket object
+ | Returns:
+ | true if the socket is connected
+ |#
+(define (socket-connected? socket :: <socket>) :: <boolean>
+ (*:connected? (socket-java-implementation socket)) )
+
+; true if the socket is closed
+(define (socket-closed? socket :: <socket>) :: <boolean>
+ (*:closed? (socket-java-implementation socket)) )
+
+; Shutdown the input port
+(define (socket-shutdown-input socket :: <socket>) :: <void>
+ (*:shutdown-input (socket-java-implementation socket)) )
+
+; true if the input port is closed
+(define (socket-input-shutdown? socket :: <socket>) :: <boolean>
+ (*:input-shutdown? (socket-java-implementation socket)) )
+
+; Shutdown the output port
+(define (socket-shutdown-output socket :: <socket>) :: <void>
+ (*:shutdown-output (socket-java-implementation socket)) )
+
+; true if the output port is closed
+(define (socket-output-shutdown? socket :: <socket>) :: <boolean>
+ (*:output-shutdown? (socket-java-implementation socket)) )
+
+(define (call-with-socket remote-address remote-port proc)
+ (let ((socket :: <socket> (make-socket remote-address remote-port)))
+ (try-finally
+ (proc socket)
+ (socket-close socket) ) ) )
+
+(define (with-ports-from-socket remote-address remote-port proc)
+ (let* ((socket :: <socket> (make-socket remote-address remote-port))
+ (input-save :: <input-port> (gnu.mapping.InPort:inDefault))
+ (output-save :: <output-port> (gnu.mapping.OutPort:outDefault)) )
+ (try-finally
+ (begin
+ (gnu.mapping.InPort:setInDefault (socket-input-port socket))
+ (gnu.mapping.OutPort:setOutDefault (socket-output-port socket))
+ (proc socket) )
+ (begin
+ (gnu.mapping.InPort:setInDefault input-save)
+ (gnu.mapping.OutPort:setOutDefault output-save)
+ (socket-close socket) ) ) ) )
+
+(define (socket-so-timeout socket :: <socket>)
+ (*:get-so-timeout (socket-java-implementation socket)) )
+
+(define (set-socket-so-timeout! socket :: <socket> timeout :: <int>)
+ (*:set-so-timeout (socket-java-implementation socket) timeout) )
+
+(define (socket-receive-buffer-size socket :: <socket>)
+ (*:get-receive-buffer-size (socket-java-implementation socket)) )
+
+(define (set-socket-receive-buffer-size! socket :: <socket> size)
+ (*:set-receive-buffer-size (socket-java-implementation socket) size) )
+
+(define (socket-send-buffer-size socket :: <socket>)
+ (*:get-send-buffer-size (socket-java-implementation socket)) )
+
+(define (set-socket-send-buffer-size! socket :: <socket> size)
+ (*:set-send-buffer-size (socket-java-implementation socket) size) )
+
+(define (socket-so-linger socket :: <socket>)
+ (*:get-so-linger (socket-java-implementation socket)) )
+
+(define (set-socket-so-linger! socket :: <socket> flag linger)
+ (*:set-so-linger (socket-java-implementation socket) flag linger) )
+
+(define (socket-traffic-class socket :: <socket>)
+ (*:get-traffic-class (socket-java-implementation socket)) )
+
+(define (set-socket-traffic-class! socket :: <socket> tc)
+ (*:set-traffic-class (socket-java-implementation socket) tc) )
+
+
+(define (server-socket? x) :: <boolean>
+ (instance? x <server-socket>) )
+
+
+(define make-server-socket
+ (make-procedure
+ method: (lambda () (<server-socket>))
+ method: (lambda (port) (<server-socket> port))
+ method: (lambda (port backlog) (<server-socket> port backlog))
+ method: (lambda (port backlog local-address)
+ (let ((address :: java.net.InetAddress (if (eq? local-address #!null) #!null (java.net.InetAddress:getByName local-address))))
+ (<server-socket> port backlog address))) ) )
+
+(define (server-socket-bind server-socket :: <server-socket> local-port :: <int> #!optional (backlog :: <int> 0) (local-address #!null))
+ (let* ((str (if (eq? #!null local-address) "" local-address))
+ (address :: java.net.SocketAddress (java.net.InetSocketAddress (*:to-string str) local-port)))
+ (*:bind server-socket address backlog) ) )
+
+(define (server-socket-accept server-socket :: <server-socket>) :: <socket>
+ (<socket> (*:accept server-socket)) )
+
+(define (server-socket-close server-socket :: <server-socket>)
+ (*:close server-socket) )
+
+(define (server-socket-local-endpoint server-socket :: <server-socket>)
+ (list (*:get-host-address (*:get-inet-address server-socket)) (*:get-local-port server-socket)) )
+
+(define (set-server-socket-reuse-address! server-socket :: <server-socket> enable :: <boolean>)
+ (*:set-reuse-address server-socket enable) )
+
+(define (server-socket-reuse-address? server-socket :: <server-socket>)
+ (*:get-reuse-address server-socket) )
+
+(define (server-socket-bound? server-socket :: <server-socket>) :: <boolean>
+ (*:bound? server-socket) )
+
+(define (server-socket-closed? server-socket :: <server-socket>) :: <boolean>
+ (*:closed? server-socket) )
+
+(define (server-socket-so-timeout server-socket :: <server-socket>)
+ (*:get-so-timeout server-socket) )
+
+(define (set-server-socket-so-timeout! server-socket :: <server-socket> timeout)
+ (*:set-so-timeout server-socket timeout) )
+
+(define (server-socket-receive-buffer-size server-socket :: <server-socket>)
+ (*:get-receive-buffer-size server-socket) )
+
+(define (set-server-socket-receive-buffer-size! server-socket :: <server-socket> size)
+ (*:set-receive-buffer-size server-socket size) )
+
+(define (call-with-server-socket local-port proc)
+ (let ((server-socket :: <server-socket> (make-server-socket local-port)))
+ (try-finally
+ (proc server-socket)
+ (server-socket-close server-socket) ) ) )
+
+
+(define (datagram-packet? packet)
+ (instance? packet <java.net.DatagramPacket>) )
+
+(define make-datagram-packet
+ (make-procedure
+ method: (lambda (buf :: <byte[]> length :: <int>)
+ (<java.net.DatagramPacket> buf length))
+ method: (lambda (buf :: <byte[]> offset :: <int> length :: <int>)
+ (<java.net.DatagramPacket> buf offset length))
+ method: (lambda (buf :: <byte[]> offset :: <int> length :: <int> host port)
+ (let ((socket-address (java.net.InetSocketAddress (*:to-string host) port)))
+ (<java.net.DatagramPacket> buf offset length socket-address) ) ) ) )
+
+(define (datagram-packet-remote-endpoint packet :: <java.net.DatagramPacket>)
+ (list (*:get-host-address (*:get-address packet)) (*:get-port packet)) )
+
+(define (set-datagram-packet-remote-endpoint! packet :: <java.net.DatagramPacket> remote port)
+ (*:set-address packet (java.net.InetAddress:getByName remote))
+ (*:set-port packet port) )
+
+(define (datagram-packet-data packet :: <java.net.DatagramPacket>)
+ (list (*:get-data packet) (*:get-offset packet) (*:get-length packet)) )
+
+(define (set-datagram-packet-data! packet :: <java.net.DatagramPacket>
+ buf :: byte[]
+ offset :: <int>
+ length :: <int>)
+ (*:set-data packet buf offset length) )
+
+(define (datagram-socket? socket) :: <boolean>
+ (instance? socket <java.net.DatagramSocket>) )
+
+#|
+ | Make a new java.net.DatagramSocket
+ | Parameters:
+ | host local host
+ | port local port
+ | Returns:
+ | java.net.DatagramSocket
+ |#
+(define make-datagram-socket
+ (make-procedure
+ method: (lambda ()
+ (<java.net.DatagramSocket>) )
+ method: (lambda (port)
+ (<java.net.DatagramSocket> (as <int> port)) )
+ method: (lambda (host port)
+ (<java.net.DatagramSocket> (java.net.InetSocketAddress (*:to-string host) port)) ) ) )
+
+(define (datagram-socket-bind datagram-socket :: <java.net.DatagramSocket> host port) :: <void>
+ (*:bind datagram-socket (java.net.InetSocketAddress (*:to-string host) port)) )
+
+(define (datagram-socket-close datagram-socket :: <java.net.DatagramSocket>) :: <void>
+ (*:close datagram-socket) )
+
+; Connects the socket
+(define datagram-socket-connect
+ (make-procedure
+ method: (lambda (datagram-socket :: <java.net.DatagramSocket> host port )
+ (*:connect datagram-socket
+ (java.net.InetSocketAddress (*:to-string host) port) ) ) ) )
+
+; Disconnects the socket
+(define (datagram-socket-disconnect datagram-socket :: <java.net.DatagramSocket>) :: <void>
+ (*:disconnect datagram-socket) )
+
+; Gets the broadcast
+(define (datagram-socket-broadcast? datagram-socket :: <java.net.DatagramSocket>) :: <boolean>
+ (*:get-broadcast datagram-socket) )
+
+; Sets the broadcast
+(define (set-datagram-socket-broadcast! datagram-socket :: <java.net.DatagramSocket> enable :: <boolean>) :: <void>
+ (*:set-broadcast datagram-socket enable) )
+
+; Gets the local endpoint (host port) to which the socket is bound
+(define (datagram-socket-local-endpoint datagram-socket :: <java.net.DatagramSocket>)
+ (list (*:get-host-address (*:get-local-address datagram-socket))
+ (*:get-local-port datagram-socket) ) )
+
+; Gets the remote endpoint (host port) to which the socket is bound
+(define (datagram-socket-remote-endpoint datagram-socket :: <java.net.DatagramSocket>)
+ (list (*:get-host-address (*:get-inet-address datagram-socket))
+ (*:get-port datagram-socket) ) )
+
+
+(define (datagram-socket-receive-buffer-size datagram-socket :: <java.net.DatagramSocket>)
+ (*:get-receive-buffer-size datagram-socket) )
+
+(define (set-datagram-socket-receive-buffer-size! datagram-socket :: <java.net.DatagramSocket> size)
+ (*:set-receive-buffer-size datagram-socket size) )
+
+; Enables/disables the SO_REUSEADDR socket option
+(define (set-datagram-socket-reuse-address! datagram-socket :: <java.net.DatagramSocket> enable :: <boolean>) :: <void>
+ (*:set-reuse-address datagram-socket enable) )
+
+; true if SO_REUSEADDR is enabled
+(define (datagram-socket-reuse-address? datagram-socket :: <java.net.DatagramSocket>) :: <boolean>
+ (*:get-reuse-address datagram-socket) )
+
+(define (datagram-socket-so-timeout datagram-socket :: <java.net.DatagramSocket>)
+ (*:get-so-timeout datagram-socket) )
+
+(define (set-datagram-socket-so-timeout! datagram-socket :: <java.net.DatagramSocket> timeout :: <int>)
+ (*:set-so-timeout datagram-socket timeout) )
+
+(define (datagram-socket-traffic-class datagram-socket :: <java.net.DatagramSocket>)
+ (*:get-traffic-class datagram-socket) )
+
+(define (set-datagram-socket-traffic-class! datagram-socket :: <java.net.DatagramSocket> tc)
+ (*:set-traffic-class datagram-socket tc) )
+
+
+#|
+ | Binding status of the socket
+ | Parameter:
+ | datagram-socket the socket
+ | Returns:
+ | true if the socket is bound
+ |#
+(define (datagram-socket-bound? datagram-socket :: <java.net.DatagramSocket>) :: <boolean>
+ (*:bound? datagram-socket) )
+
+#|
+ | Connection status of the socket
+ | Parameter:
+ | datagram-socket the socket
+ | Returns:
+ | true if the socket is connected
+ |#
+(define (datagram-socket-connected? datagram-socket :: <java.net.DatagramSocket>) :: <boolean>
+ (*:connected? datagram-socket) )
+
+#|
+ | Status of the socket
+ | Parameter:
+ | datagram-socket the socket
+ | Returns:
+ | true if the socket is closed
+ |#
+(define (datagram-socket-closed? datagram-socket :: <java.net.DatagramSocket>) :: <boolean>
+ (*:closed? datagram-socket) )
+
+#|
+ | Receives a datagram packet
+ | Parameter:
+ | datagram-socket the socket
+ | packet a datagram packet to fill with the received data
+ | Returns:
+ | (data offset length) the data received
+ |#
+(define (datagram-socket-receive datagram-socket :: <java.net.DatagramSocket> packet :: <java.net.DatagramPacket>)
+ (begin
+ (*:receive datagram-socket packet)
+ (datagram-packet-data packet) ) )
+
+#|
+ | Sends a datagram packet
+ | Parameter:
+ | datagram-socket the socket
+ | packet a datagram packet with the sending data
+ |#
+(define (datagram-socket-send datagram-socket :: <java.net.DatagramSocket> packet :: <java.net.DatagramPacket>) :: <void>
+ (*:send datagram-socket packet) )
+
+#|
+ | Calls a procedure with a datagram packet
+ | Parameters:
+ | host local host
+ | port local port
+ | proc procedure to call
+ |#
+(define call-with-datagram-socket
+ (make-procedure
+ method: (lambda (proc)
+ (proc (make-datagram-socket)) )
+ method: (lambda (host port proc)
+ (proc (make-datagram-socket host port)) ) ) )
+
+
+
+
+(define (multicast-socket? socket) :: <boolean>
+ (instance? socket <java.net.MulticastSocket>) )
+
+#|
+ | Make a new java.net.MulticastSocket
+ | Parameters:
+ | host local host
+ | port local port
+ | Returns:
+ | java.net.DatagramSocket
+ |#
+(define make-multicast-socket
+ (make-procedure
+ method: (lambda ()
+ (<java.net.MulticastSocket>) )
+ method: (lambda (port)
+ (<java.net.MulticastSocket> (as <int> port)) )
+ method: (lambda (host port)
+ (<java.net.MulticastSocket> (java.net.InetSocketAddress (*:to-string host) port)) ) ) )
+
+(define (multicast-socket-join-group multicast-socket :: <java.net.MulticastSocket> group)
+ (*:joinGroup multicast-socket (<java.net.InetAddress>:getByName group)) )
+
+(define (multicast-socket-leave-group multicast-socket :: <java.net.MulticastSocket> group)
+ (*:leaveGroup multicast-socket (<java.net.InetAddress>:getByName group)) )
+
+(define (multicast-socket-time-to-live multicast-socket :: <java.net.MulticastSocket>) :: <int>
+ (*:getTimeToLive multicast-socket) )
+
+(define (set-multicast-socket-time-to-live! multicast-socket :: <java.net.MulticastSocket> ttl :: <int>)
+ (*:setTimeToLive multicast-socket ttl) )
+
+(define-alias multicast-socket-bind datagram-socket-bind)
+(define-alias multicast-socket-connect datagram-socket-connect)
+(define-alias multicast-socket-disconnect datagram-socket-disconnect)
+(define-alias multicast-socket-broadcast? datagram-socket-broadcast?)
+(define-alias set-multicast-socket-broadcast! set-datagram-socket-broadcast!)
+(define-alias multicast-socket-local-endpoint datagram-socket-local-endpoint)
+(define-alias multicast-socket-remote-endpoint datagram-socket-remote-endpoint)
+(define-alias multicast-socket-receive-buffer-size datagram-socket-receive-buffer-size)
+(define-alias set-multicast-socket-receive-buffer-size! set-datagram-socket-receive-buffer-size!)
+(define-alias multicast-socket-so-timeout datagram-socket-so-timeout)
+(define-alias set-multicast-socket-so-timeout! set-datagram-socket-so-timeout!)
+(define-alias multicast-socket-traffic-class datagram-socket-traffic-class)
+(define-alias set-multicast-socket-traffic-class! set-datagram-socket-traffic-class!)
+(define-alias multicast-socket-bound? datagram-socket-bound?)
+(define-alias multicast-socket-connected? datagram-socket-connected?)
+(define-alias multicast-socket-close datagram-socket-close)
+(define-alias multicast-socket-closed? datagram-socket-closed?)
+(define-alias multicast-socket-receive datagram-socket-receive)
+(define-alias multicast-socket-send datagram-socket-send)
+
+
+#|
+ | Calls a procedure with a datagram packet
+ | Parameters:
+ | host local host
+ | port local port
+ | proc procedure to call
+ |#
+(define call-with-multicast-socket
+ (make-procedure
+ method: (lambda (proc)
+ (proc (make-multicast-socket)) )
+ method: (lambda (host port proc)
+ (proc (make-multicast-socket host port)) ) ) )
+
+
+
+
+
+
\ No newline at end of file
Index: kawa/standard/Scheme.java
===================================================================
--- kawa/standard/Scheme.java (revision 6478)
+++ kawa/standard/Scheme.java (working copy)
@@ -812,6 +812,120 @@
defProcStFld("path-fragment", "kawa.lib.files");
defProcStFld("path-query", "kawa.lib.files");
+ final String kawaLibSockets[] = {
+ "socket?",
+ "make-socket",
+ "socket-connect",
+ "socket-input-port",
+ "socket-output-port",
+ "socket-local-endpoint",
+ "socket-remote-endpoint",
+ "socket-bind",
+ "socket-bound?",
+ "socket-connected?",
+ "socket-closed?",
+ "set-socket-keep-alive!",
+ "socket-keep-alive?",
+ "set-socket-reuse-address!",
+ "socket-reuse-address?",
+ "socket-shutdown-input",
+ "socket-input-shutdown?",
+ "socket-shutdown-output",
+ "socket-output-shutdown?",
+ "set-socket-tcp-no-delay!",
+ "socket-tcp-no-delay?",
+ "call-with-socket",
+ "with-ports-from-socket",
+ "socket-close",
+ "socket-out-of-band-inline",
+ "socket-out-of-band-inline?",
+ "socket-urgent-data",
+ "socket-so-timeout",
+ "set-socket-so-timeout!",
+ "socket-receive-buffer-size",
+ "set-socket-receive-buffer-size!",
+ "socket-send-buffer-size",
+ "set-socket-send-buffer-size!",
+ "socket-traffic-class",
+ "set-socket-traffic-class!",
+ "socket-java-implementation",
+
+ "server-socket?",
+ "make-server-socket",
+ "server-socket-bind",
+ "server-socket-accept",
+ "server-socket-close",
+ "server-socket-local-endpoint",
+ "set-server-socket-reuse-address!",
+ "server-socket-reuse-address?",
+ "server-socket-bound?",
+ "server-socket-closed?",
+ "server-socket-so-timeout",
+ "set-server-socket-so-timeout!",
+ "server-socket-receive-buffer-size",
+ "set-server-socket-receive-buffer-size!",
+ "call-with-server-socket",
+
+ "make-datagram-packet",
+ "datagram-packet?",
+ "datagram-packet-remote-endpoint",
+ "set-datagram-packet-remote-endpoint!",
+ "datagram-packet-data",
+ "set-datagram-packet-data!",
+
+ "make-datagram-socket",
+ "datagram-socket?",
+ "datagram-socket-bind",
+ "datagram-socket-connect",
+ "datagram-socket-disconnect",
+ "datagram-socket-broadcast?",
+ "set-datagram-socket-broadcast!",
+ "datagram-socket-local-endpoint",
+ "datagram-socket-remote-endpoint",
+ "datagram-socket-receive-buffer-size",
+ "set-datagram-socket-receive-buffer-size!",
+ "datagram-socket-so-timeout",
+ "set-datagram-socket-so-timeout!",
+ "datagram-socket-traffic-class",
+ "set-datagram-socket-traffic-class!",
+ "datagram-socket-bound?",
+ "datagram-socket-connected?",
+ "datagram-socket-close",
+ "datagram-socket-closed?",
+ "datagram-socket-receive",
+ "datagram-socket-send",
+ "call-with-datagram-socket",
+ "multicast-socket?",
+ "make-multicast-socket",
+ "multicast-socket-bind",
+ "multicast-socket-connect",
+ "multicast-socket-disconnect",
+ "multicast-socket-broadcast?",
+ "set-multicast-socket-broadcast!",
+ "multicast-socket-local-endpoint",
+ "multicast-socket-remote-endpoint",
+ "multicast-socket-receive-buffer-size",
+ "set-multicast-socket-receive-buffer-size!",
+ "multicast-socket-so-timeout",
+ "set-multicast-socket-so-timeout!",
+ "multicast-socket-traffic-class",
+ "set-multicast-socket-traffic-class!",
+ "multicast-socket-bound?",
+ "multicast-socket-connected?",
+ "multicast-socket-close",
+ "multicast-socket-closed?",
+ "multicast-socket-receive",
+ "multicast-socket-send",
+ "multicast-socket-join-group",
+ "multicast-socket-leave-group",
+ "multicast-socket-time-to-live",
+ "set-multicast-socket-time-to-live!",
+ "call-with-multicast-socket"
+ };
+ for( int i=0; i<kawaLibSockets.length; i++ ) {
+ defProcStFld(kawaLibSockets[i], "kawa.lib.sockets");
+ }
+
kawaEnvironment.setLocked();
}
@@ -994,6 +1108,9 @@
types.put ("f64vector", ClassType.make("gnu.lists.F64Vector"));
types.put ("document", ClassType.make("gnu.kawa.xml.KDocument"));
types.put ("readtable", ClassType.make("gnu.kawa.lispexpr.ReadTable"));
+
+ types.put ("socket", ClassType.make("gnu.mapping.Socket"));
+ types.put ("server-socket", ClassType.make("gnu.mapping.ServerSocket"));
}
Type type = (Type) types.get(name);
if (type == null
Index: testsuite/Makefile.am
===================================================================
--- testsuite/Makefile.am (revision 6478)
+++ testsuite/Makefile.am (working copy)
@@ -18,7 +18,8 @@
check: check2-no-full-tailcalls check1 check2-full-tailcalls check-no-inline \
check-interpreted-cycle $(SERVLET_TESTS) $(SAX2_TESTS) \
- check-inlining check-jmc check-use-slots check-load-require
+ check-inlining check-jmc check-use-slots check-load-require \
+ check-sockets
check2-no-full-tailcalls:
$(MAKE) check2 OPTIONS=--no-full-tailcalls
@@ -89,6 +90,11 @@
check-format: testing.zip
$(KAWA) "$(srcdir)/formatst.scm"
+check-sockets: testing.zip
+ $(KAWATEST) \
+ -f "$(srcdir)/sockets.scm" -e '(test-report)'
+
+
check-ppfile:
$(KAWA) -e "(require 'pprint-file)" \
-e '(define out (open-output-file "tmpP"))' \
Index: testsuite/sockets.scm
===================================================================
--- testsuite/sockets.scm (revision 0)
+++ testsuite/sockets.scm (revision 0)
@@ -0,0 +1,353 @@
+
+(test-begin "sockets" 51)
+
+(define *port* 32987)
+(define *host* "127.0.0.1")
+
+(define-namespace Thread <java.lang.Thread>)
+(define (start-thread runnable :: <java.lang.Runnable>)
+ (let ((thread :: <java.lang.Thread> (Thread runnable)))
+ (*:start thread)
+ thread) )
+(define (call-with-thread runnable :: <java.lang.Runnable> proc)
+ (let ((thread :: <java.lang.Thread> (Thread runnable)))
+ (*:start thread)
+ (sleep 0.5)
+ (proc)
+ (*:join thread) ) )
+
+
+(test-begin "Client Socket Test Group" 37)
+
+(define-simple-class HelloServer (java.lang.Runnable)
+ (server :: java.net.ServerSocket
+ init: (java.net.ServerSocket *port*) )
+
+ ((run) :: void
+ (begin
+ (let* ((connection (*:accept server))
+ (in (*:get-input-stream connection))
+ (out (*:get-output-stream connection)) )
+ (*:write out (*:get-bytes "\"server\""))
+ (*:write out (*:int-value #\newline))
+
+ (let loop ((c :: <int> (*:read in)))
+ (when (not (= c -1))
+ (begin
+ (*:write out c#;(*:int-value c))
+ (loop (*:read in)) ) ) )
+ (*:flush out)
+
+ (*:close connection)
+ (test-assert "Test client socket is closed?" (*:closed? connection))
+ (test-assert "Test client socket is bound?" (*:bound? connection))
+ (test-assert "Test client socket is connected?" (*:connected? connection))
+ )
+
+ (*:close server)
+ (test-equal "Test HelloServer is closed?" #t (*:closed? server))
+
+ ) ) )
+
+(define (client-ports socket :: <socket> input-port :: <input-port> output-port :: <output-port>)
+ (begin
+ (let ((addr (cons (car (socket-local-endpoint socket)) (socket-remote-endpoint socket))))
+ (write (string-append "hello " (read input-port)) output-port)
+ (force-output output-port)
+ (socket-shutdown-output socket)
+ (read-char input-port)
+ (append addr (list (read input-port))) ) ) )
+
+(define (client socket :: <socket>)
+ (let ((input-port :: <input-port> (socket-input-port socket))
+ (output-port :: <output-port> (socket-output-port socket)) )
+ (client-ports socket input-port output-port) ) )
+
+(call-with-thread
+ (HelloServer)
+ (lambda ()
+ (let ((socket (make-socket)))
+ (test-equal "Test: socket not closed?" #f (socket-closed? socket))
+ (test-equal "Test: socket not bound?" #f (socket-bound? socket))
+ (test-equal "Test: socket not connected?" #f (socket-connected? socket))
+ (socket-connect socket *host* *port*)
+ (test-assert "Test: socket is bound?" (socket-bound? socket))
+ (test-assert "Test: socket is connected?" (socket-connected? socket))
+ (test-equal "Test: socket input shutdown?" #f (socket-input-shutdown? socket))
+ (test-equal "Test: socket output shutdown?" #f (socket-output-shutdown? socket))
+ (try-finally
+ (client socket)
+ (begin
+ (test-assert "Test: socket output shutdown?" (socket-output-shutdown? socket))
+ (socket-shutdown-input socket)
+ (test-assert "Test: socket input shutdown?" (socket-input-shutdown? socket))
+ (socket-close socket)
+ (test-assert "Test: socket is closed?" (socket-closed? socket))
+ (test-assert "Test: socket is bound?" (socket-bound? socket))
+ (test-assert "Test: socket is connected?" (socket-connected? socket)) ) )
+ ) ) )
+
+ (call-with-thread
+ (HelloServer)
+ (lambda ()
+ (let ((socket (make-socket *host* *port*)))
+ (try-finally
+ (begin
+ (test-equal "Test: socket not closed?" #f (socket-closed? socket))
+ (test-assert "Test: socket bound?" (socket-bound? socket))
+ (test-assert "Test: socket not connected?" (socket-connected? socket))
+ (test-equal
+ "Test: (make-socket host port)"
+ (list *host* "127.0.0.1" *port* "hello server")
+ (client socket) ) )
+ (begin
+ (socket-close socket)
+ (test-assert "Test: socket not bound?" (socket-bound? socket))
+ (test-assert "Test: socket not connected?" (socket-connected? socket))
+ (test-assert "Test: socket closed?" (socket-closed? socket)) ) ) ) ) )
+
+
+#|
+ | Test call-with-socket
+ |#
+(define (proc-call-with-socket socket)
+ (test-equal
+ "Test: (call-with-socket host port proc)"
+ (list *host* "127.0.0.1" *port* "hello server")
+ (client socket) ) )
+
+(call-with-thread
+ (HelloServer)
+ (lambda ()
+ (call-with-socket *host* *port* proc-call-with-socket) ) )
+
+#|
+ | Test with-ports-from-socket
+ |#
+
+(define (client-default-ports socket :: <socket>)
+ (test-equal
+ "Test: (with-ports-from-socket host port proc"
+ (list *host* "127.0.0.1" *port* "hello server")
+ (client-ports socket (current-input-port) (current-output-port)) ) )
+
+
+(call-with-thread
+ (HelloServer)
+ (lambda ()
+ (with-ports-from-socket *host* *port* client-default-ports) ) )
+
+
+(test-end "Client Socket Test Group")
+
+
+(test-begin "Server Socket Test Group" 7)
+
+#|
+ | Test server-scoket-bound?
+ | server-socket-closed?
+ | server-socket-bind
+ | server-socket-close
+ |#
+
+(let ((server-socket (make-server-socket)))
+ (test-equal #f (server-socket-bound? server-socket))
+ (test-equal #f (server-socket-closed? server-socket))
+ (server-socket-bind server-socket *port*)
+ (test-assert "socket is bound" (server-socket-bound? server-socket))
+ (server-socket-close server-socket)
+ (test-assert "socket is closed" (server-socket-closed? server-socket)) )
+
+
+#|
+ | Test server-socket
+ |#
+
+(define-simple-class HelloWorker (java.lang.Runnable)
+ (socket :: <socket>)
+
+ ((*init* (s :: <socket>))
+ (set! socket s) )
+
+ ((run):: void
+ (let ((in-port (socket-input-port socket))
+ (out-port (socket-output-port socket)) )
+ (write "server" out-port)
+ (write-char #\newline out-port)
+ (force-output out-port)
+
+ (let loop ((c (read in-port)))
+ (when (not (eof-object? c))
+ (begin
+ (write c out-port)
+ (loop (read in-port)) ) ) )
+ (force-output out-port)
+ (socket-close socket) ) ) )
+
+
+(define (hello-scheme-server server-socket)
+ (let ((socket (server-socket-accept server-socket)))
+ (start-thread (HelloWorker socket)) ) )
+
+(define-simple-class HelloSchemeRunnable (java.lang.Runnable)
+ (server :: <server-socket>
+ init: (make-server-socket *port*) )
+
+ #;((*init* (s :: <server-socket>))
+ (set! server s) )
+
+ ((run) :: void
+ (begin
+ (test-assert "Test: server socket is bound?" (server-socket-bound? server))
+ (hello-scheme-server server)
+ (server-socket-close server) ) ) )
+
+(call-with-thread
+ (HelloSchemeRunnable)
+ (lambda ()
+ (call-with-socket *host* *port* proc-call-with-socket)) )
+
+
+#|
+ | Test call-with-server-socket
+ |#
+
+(define-simple-class ServerRunnable (java.lang.Runnable)
+ ((run) :: void
+ (call-with-server-socket *port* hello-scheme-server) ) )
+
+(call-with-thread
+ (ServerRunnable)
+ (lambda ()
+ (call-with-socket *host* *port* proc-call-with-socket)) )
+
+(test-end "Server Socket Test Group")
+
+(test-begin "Datagram Socket Test Group" 7)
+
+#|
+ | Test datagram packet creation
+ |#
+
+(define udp-pckt (<byte[]> (char->integer #\h)
+ (char->integer #\e)
+ (char->integer #\l)
+ (char->integer #\l)
+ (char->integer #\o) ) )
+
+(test-equal (list (char->integer #\h)
+ (char->integer #\e)
+ (char->integer #\l)
+ (char->integer #\l)
+ (char->integer #\o) )
+
+ (let ((data (datagram-packet-data (make-datagram-packet udp-pckt udp-pckt:length))))
+ (let loop ((buf (car data))
+ (offset (cadr data))
+ (length (caddr data)) )
+ (if (< offset length)
+ (cons (buf offset) (loop buf (+ offset 1) length))
+ '() ) ) ) )
+
+
+#|
+ | Test datagram socket send
+ |#
+
+; Datagram server in Java class
+(define-simple-class DatagramHelloServer (java.lang.Runnable)
+ (datagram-socket :: <java.net.DatagramSocket>
+ init: (<java.net.DatagramSocket> *port*) )
+
+ (buffer :: <byte[]>
+ init: (<byte[]> length: 64) )
+
+ (packet :: <java.net.DatagramPacket>
+ init: (make-datagram-packet buffer buffer:length) )
+
+ ((run) :: void
+ (begin
+ (test-equal "Test: datagram socket is not closed?" #f (*:closed? datagram-socket))
+ (test-assert "Test: datagram socket is bound?" (*:bound? datagram-socket))
+
+ (*:receive datagram-socket packet)
+
+ (test-equal
+ "Test: char received by the DatagramHelloServer"
+ (list (char->integer #\h) (char->integer #\e) (char->integer #\l) (char->integer #\l) (char->integer #\o) )
+ (let loop ((buffer (*:get-data packet))
+ (offset (*:get-offset packet))
+ (length (*:get-length packet)) )
+ (if (<= length 0)
+ '()
+ (cons (buffer offset) (loop buffer (+ offset 1) (- length 1)))
+ ) )
+ )
+
+ (*:close datagram-socket) ) ) )
+
+(define (test-datagram-send client-socket)
+ (let ((packet (make-datagram-packet udp-pckt udp-pckt:length)) )
+ (datagram-socket-connect client-socket *host* *port*)
+
+ (test-equal
+ (list *host* *port*)
+ (datagram-socket-remote-endpoint client-socket) )
+ (datagram-socket-send client-socket packet)
+ ) )
+
+(begin
+ (start-thread (DatagramHelloServer))
+ (sleep 0.5) ; wait for server
+ (test-datagram-send (make-datagram-socket)) )
+
+
+#|
+ | Test: datagram-socket-receive
+ | datagram-socket-close
+ | datagram-socket-closed?
+ |#
+(define-simple-class DatagramSchemeHelloServer (java.lang.Runnable)
+ (datagram-socket :: <java.net.DatagramSocket>
+ init: (make-datagram-socket *port*) )
+
+ (buffer :: <byte[]>
+ init: (<byte[]> length: 64) )
+
+ (packet :: <java.net.DatagramPacket>
+ init: (make-datagram-packet buffer buffer:length) )
+
+ ((run) :: void
+ (begin
+ (test-equal #f (datagram-socket-closed? s))
+
+ (test-equal (list (char->integer #\h)
+ (char->integer #\e)
+ (char->integer #\l)
+ (char->integer #\l)
+ (char->integer #\o) )
+ (let ((data (datagram-socket-receive datagram-socket packet)))
+ (let loop ((buffer (car data))
+ (offset (cadr data))
+ (length (caddr data)) )
+ (if (<= length 0)
+ '()
+ (cons (buffer offset) (loop buffer (+ offset 1) (- length 1))) ) ) )
+ )
+
+ (datagram-socket-close datagram-socket)
+ (test-assert "socket is closed" (datagram-socket-closed? datagram-socket)) ) ) )
+
+
+
+#|
+ | Test call-with-datagram-socket
+ |#
+(begin
+ (start-thread (DatagramSchemeHelloServer))
+ (sleep 0.5) ; wait for server
+ (call-with-datagram-socket test-datagram-send) )
+
+(test-end "Datagram Socket Test Group")
+
+(test-end)