# TCP networking example.

# TCP pipes are bidirectional, but it is usually easier to use them
# only in one direction, with servers reading and clients
# writing. this allows you to concentrate the difficult stuff on the
# server side.

# implementing a client that connects to a server is really easy, and
# not used here. simply do:
#
#   ("host.net" 1234) "w" open-connect
#   constant the-socket
#
# that will give you a stream you can put in a list or a variable or a
# constant as illustrated above. send out data like:
#
#   (message 1 2 3) the-socket write-atom
#

# because of the asynchronous nature, a TCP server is easiest to
# implement using PF tasks. each server (TCP port) has one task
# listening on a socket, and spawns new tasks whenever a connection is
# made.

# to integrate the received data in a program this example uses a
# global 'event buffer', where other tasks can gather the incoming
# data.

load-scheduler

() variable! network-events

variable server-socket
variable client-socket

: spawn-client-connection 
        1 fork
	
	# task starts here.

	# store the socket we get passed in a task variable
        client-socket local-variable      # declare var as local to task
	client-socket !

        begin 

           # if you leave out the try block, the task will just stop
           # when an error occurs.
	   client-socket @ 
	   try                        
	       read-atom           # read one atom from socket
	   recover
	       e_eof or-throw      # error not eof -> throw again
	       "disconnect:" p
	       client-socket @ p cr  # print error message 
	       finish                # kill task
           endtry

	   dup network-events queue  # save it to the event buffer
	   "GOT:" p p cr
        again ;

"( socket -- )\tSpawn a connection handler task." doc

: spawn-listener 
     1 fork  # pass 1 argument (port) to task

     # task starts here

     # open listening socket
     ("0.0.0.0") swap concat "r" 
     open-listen server-socket !

     # keep accepting new connections
     begin
	 server-socket @ "r" open-accept
	 "new connection:" p dup p cr
	 spawn-client-connection
     again ;

"( port -- )\tSpawn a listener on a TCP port." doc



: next-arg args pop ;

next-arg drop			# discard script name
next-arg interpret-string	# get port
spawn-listener

interactive