\ $Id: echod.fr,v 1.1 2007/05/07 21:40:58 alex Exp alex $ \ ****************************************************************************** \ \ ECHOD - is a simple echo server that can handle multiple clients \ simultaneously. Clients connect to the server on port 10234. \ (An alternate port number can be specified by pushing it on the \ stack before loading this script.) Any data a client sends is \ echoed back to the client. If a client drops its connection, \ ECHOD drops it too. \ \ ECHOD revolves around an I/O event dispatcher. In the MAIN LOOP \ section at the bottom of this program, the dispatcher is created, \ the TCP/IP listening port is created, and the listening port is \ registered with the dispatcher as an input source. Control is \ then turned over to the dispatcher to monitor (i) the listening \ port for incoming connection requests and (ii) any future client \ connections. \ \ Whenever a client tries to connect to the server on port 10234, \ the dispatcher detects the pending connection request and invokes \ the NEW-CLIENT callback word. NEW-CLIENT accepts the connection \ request, the operating system creates a new data connection for \ the client, and the new data connection is registered with the \ the dispatcher as another input source. (Thus, at any given time, \ ECHOD will have the listening port and the data connections of all \ connected clients registered with the dispatcher.) \ \ When a client sends an arbitrary chunk of data to the server, \ the dispatcher detects the pending input on the client's data \ connection and invokes the ECHO-CLIENT callback word, passing \ it the client's TCP/IP endpoint (supplied when the client was \ registered with the dispatcher in NEW-CLIENT). \ \ ECHO-CLIENT checks to see if the client's network connection is \ still up and, if so, calls READ-CLIENT to read the chunk of data \ from the client connection and then WRITE-CLIENT to write the same \ chunk of data back to the client. If the network connection has \ gone down, ECHO-CLIENT closes the connection and removes its \ registration with the dispatcher. \ \ ****************************************************************************** 1 iox-debug 1 tcp-debug skt-startup abort" Unable to start up networking!\n" \ ****************************************************************************** \ ADD-INPUT - registers a TCP/IP listening or data endpoint as an input \ source with an I/O dispatcher. When input is detected on the endpoint, \ the dispatcher executes the specified word to handle the input. \ ****************************************************************************** : add-input \ ( dp ep xt -- cb ) -rot \ ( dp ep xt -- xt dp ep ) dup tcp-fd IOX_READ rot \ ( xt dp ep -- xt dp fd 1 ep ) 4 roll 4 roll \ ( xt dp fd 1 ep -- fd 1 ep xt dp ) iox-onio \ ( fd 1 ep xt dp -- cb ) ; \ ****************************************************************************** \ READ-CLIENT - reads a single chunk of data from a client connection \ and returns a dynamically allocated buffer holding the data. \ ****************************************************************************** 64 constant MAX_SIZE : read-client \ ( ep -- a-addr u ) MAX_SIZE allocate drop \ ( ... -- ep a-addr ) dup rot MAX_SIZE negate \ ( ... -- a-addr a-addr ep -n ) swap -1E+0 tcp-read \ ( ... -- a-addr u ior ) drop ; \ ****************************************************************************** \ WRITE-CLIENT - writes a single chunk of data to a client connection. \ The buffer holding the data, allocated by READ-CLIENT, is freed. \ ****************************************************************************** : write-client \ ( ep a-addr u -- ) over swap 3 roll \ ( ... -- a-addr a-addr u ep ) -1E+0 tcp-write \ ( ... -- a-addr u ior ) drop drop free drop ; \ ****************************************************************************** \ ECHO-CLIENT - is invoked by the I/O dispatcher when data is available to \ be read from a client. READ-CLIENT is called to read the data and \ WRITE-CLIENT is called to write the data back to the client. If the \ connection is no longer up, it is closed. \ ****************************************************************************** : echo-client \ ( cb c-addr n -- ) drop \ ( ... -- cb ep ) begin dup tcp-readable? \ ( ... -- cb ep f ) while dup dup \ ( ... -- cb ep ep ep ) read-client \ ( ... -- cb ep ep a-addr u ) write-client \ ( ... -- cb ep ) repeat dup tcp-up? \ ( cb ep -- cb ep f ) if drop drop else tcp-destroy drop iox-cancel then ; \ ****************************************************************************** \ NEW-CLIENT - is invoked by the I/O dispatcher when a client is requesting \ a network connection to the server. The connection request is \ accepted and the new client data connection is registered with the \ I/O dispatcher as an input source. When data is received on the \ connection, the I/O dispatcher automatically invokes READ-CLIENT \ to read and echo the data. \ ****************************************************************************** : new-client \ ( cb c-addr n -- ) drop -1E+0 tcp-answer drop \ ( cb ep -- cb ep ) s" Answered connection request" type cr swap iox-dispatcher swap \ ( cp ep -- dp ep ) ['] echo-client add-input drop \ ( dp ep xt -- ) ; \ ****************************************************************************** \ NEW-LISTENERS - creates a TCP/IP listening endpoint for each port number \ passed to this script on the data stack. It is assumed that the \ port numbers are the only things on the stack on entry to the script. \ If the stack is empty, default port 10234 is used. The listening \ endpoints are registered with the I/O dispatcher, after which \ NEW-CLIENT is invoked to handle incoming connection requests. \ ****************************************************************************** : new-listeners \ ( n0 ... nn dp -- dp ) depth 1 = if 10234 swap then depth 1- 0 ?do dup rot \ ( ... nn dp -- dp dp nn ) 0 tcp-listen drop \ ( ... dp dp nn -- dp dp ep ) ['] new-client add-input drop \ ( ... dp dp ep xt -- ... dp ) loop ; \ ****************************************************************************** \ MAIN LOOP - Create an I/O dispatcher, create the server's listening \ port(s), and loop forever. \ ****************************************************************************** iox-create drop \ Create the I/O dispatcher. s" Creating listening ports ..." type cr new-listeners \ Create the listening port(s). s" Monitoring ..." type cr -1E+0 iox-monitor \ Monitor connection requests and client I/O. s" Done monitoring?" type cr