program TCPPAR,1.0(103)
!---------------------------------------------------------------------
!Test Parent/Child TCP architecture.
!Note: this this is currently only available under UNIX, since
!A-Shell/Windows does not support SUBMIT.  The program still works
!though; in Windows it just executes the "child" process as 
!a subroutine.
!Requires TCPCH1 (child program) under UNIX
!---------------------------------------------------------------------
!Edit history of TCPTST.BAS-
!
!Version 1.0:-
![100] November 13, 2004 01:27 PM      Edited by Jack
!	Created (based on TCPTST.BAS) to test new TCPX features for 
!	implementing a parent service that spawns child tasks in order
!	to "stay open for business" with requests coming rapidly.
![101] June 29, 2006 01:27 PM      Edited by Jack
!	Experiment with launching child under Windows; add auto
!       loop option to generate 99 fast requests 
![102] June 20, 2008 02:14 PM      Edited by Jack
!	Misc fixes, switch to modern symbols from ashell.def
![103] September 25, 2009 07:50 AM      Edited by jacques
!       Add logic to handle spurious STATUS -1 return from TCPOP_CHECK
!       (caused by child termination signal); fix confusion in 
!       S'CLOSE closing listening socket instead of server socket /jdm
!---------------------------------------------------------------------
++include ashinc:ashell.def         ! [102]

MAP1 TCP'PACKET			! (data of arbitrary layout and size)
	MAP2 TCP'STRING,S,1024

MAP1 MISC
	MAP2 STATUS,F
	MAP2 C'SOCKPORT,F		! client connection socket
	MAP2 S'SOCKPORT,F		! server connection socket
        MAP2 S'DUPSOCK,F                ! [101] dup socket for child
	MAP2 LISTENSOCK,F		! server listening socket
	MAP2 SERVERPORT,F		! server listening port #
	MAP2 TCP'OP,F
	MAP2 MODE,F
	MAP2 HOSTNAME,S,32
	MAP2 ERRORMSG,S,80
	MAP2 TCP'FLAGS,F,6
	MAP2 PRGVER$,S,20
	MAP2 TCP'TIMER,B,4		! timeout in ms
	MAP2 BLOCK$,S,1			! "Y" if we want blocking
	MAP2 A$,S,1	
	MAP2 RQNO,F
	MAP2 DIRSEP$,S,1		! directory sep char / or \
	MAP2 FILJOB,S,20
	MAP2 I,F
        MAP2 CHPID,B,2                
        MAP2 LOOPS,F,6
        MAP2 ERRCNT,B,1                 ! [103] count consecutive errors

![102] replace these with the standard symbols from ashell.def
!MAP1 TCP'OP'NAMES
!	MAP2 TCPOP'CONNECT,B,1	,9	! generic client connect		
!	MAP2 TCPOP'CONNACK,B,1	,1	! client connect w/ ack returned
!	MAP2 TCPOP'ACCEPT,B,1	,1	! server create
!	MAP2 TCPOP'WRITE,B,1	,2	! read	
!	MAP2 TCPOP'READ,B,1	,4	! read	
!	MAP2 TCPOP'CLOSE,B,1	,6	! close
!	MAP2 TCPOP'CHK,B,1 	,7	! check (rtn 0=none, 1=some)
!	MAP2 TCPOP'CHKCNT,B,1	,8	! check (rtn # bytes, UNIX only)
!
!MAP1 TCPXFLG'SYMBOLS
!	MAP2 TCPXFLG'BLOCK,B,1	,1	! blocking connection
!	MAP2 TCPXFLG'LISTEN,B,1 ,4 	! open listen sock & return
!	MAP2 TCPXFLG'ASYNC,B,1	,8	! accept based on listening socket
!	MAP2 TCPXFLG'KEEPLISTEN,b,1,16  ! leave listening socket open
!-[102]
!----------------------------------------------------------------------------
!
!   XCALL TCPX,OP,STATUS,DATA,SOCKPORT{,FLAGS{,TIMER{,HOSTNAME}}}
!
!   OP (numeric) :
!       1   Wait for and accept a connection (server)
!       2   Write data in DATA to client
!       4   Read data from client into DATA
!       5
!       6   Close socket
!       7   Check for data (return STATUS=1 if data avl)
!       8   Check how much data avail to read
!       9   Generic client connect
!       10  New code for old TCPCLI opcode 1 (usage deprecated now,
!           with 9 being the preferred way of establishing a connection
!           from the client side.)
!
!   STATUS (float) :
!       <0  error (-errno)
!           a postive number is the number of charactors read or written.
! 
!   DATA (string or unformatted or array):
!       Packet of data to read or write.  No particular length limitation.
!       Returned on read, sent on write.  Also, on connect (OP 10), it returns
!       the server's ACKMSG, which is limited to 32 bytes.  See FLAGS for to see
!       how number of bytes to send/receive is actually determined.
!
!   SOCKPORT (numeric): 
!       on connect or accept (OP 1,9 or 10), app must supply the port to connect to
!       or to listen on; socket is returned and must be supplied to all other calls.
!       If <0 on connect or accept, indicates which function failed.
!       
!   FLAGS (numeric, optional)
!       Usage varies with OP:
!       OP 1,9,10 (connect/accept):
!	  TCPXFLG_BLOCK) - Establish connection being accepted as blocking.
!	  TCPXFLG_LISTEN - Causes TCPX to return with the listening SOCKET
!                          (in SOCKPORT) w/o waiting to accept a connection.
!	  TCPXFLG_ASYNC - Accept connection on previously opened listening
!                        socket.  (SOCKPORT must be the listening socket.)
!	  TCPXFLG_KEEPLISTEN - Combined with TCPXFLG_ASYNC to keep the 
!                        listening socket open after accepting the 
!                        connection.
!       OP 2 (write): specifies # of bytes to write.  Must be <= size of DATA,
!           unless DATA is subscripted, in which case we just trust the FLAGS value.
!           0 (or FLAGS not specified) means write entire DATA block.  
!           If FLAGS non-zero, we set the send buffer lo water mark so that we don't
!           attempt operation unless buffer has sufficient space.  
!       OP 4 (read): specifies # of bytes to read.  0 is equivalent to size of DATA.
!           For blocking connections, subroutine will wait until the required number
!           of bytes is read (up to TIMER limit).  For non-blocking connections,
!           this size is only an upper limit; the routine will return as soon as the
!           interface indicates there is data available (even if not the requested
!           number of bytes.)
!       OP 6 (close):
!           Initiate a "graceful" background shutdown.  Call returns immediately;
!           OS tries to gracefully close the connection.
!       OP 7 (check for data)
!           If TIMER specified, FLAGS is ignored and TIMER is used.
!           If TIMER not specified, FLAGS specifies how long to wait before returning
!               STATUS 0 if no data avail.  If FLAGS is F,6 then it is interpreted as
!               fractional seconds; otherwise it is interpreted as milliseconds.
!       OP 8 (check how much data)
!           FLAGS not used.
!
!       As a convenience for backwards compatibility with TCPCLI on the connect OP, 
!       FLAGS can be the 6th param if the 5th param is a string (i.e. TCPX is called
!       with the TCPCLI syntax: XCALL TCPX,OP,STATUS,DATA,SOCKPORT,HOSTNAME,FLAGS)
!
!   TIMER (numeric, optional)
!       For OP 7, number of milliseconds to wait before returning if no data avail.
!       For reads and writes on blocking connections, number of milliseconds to wait
!       before returning with EWOULDBLOCK error if the amount of data specified
!       (by FLAGS and size of DATA arg) cannot be fully read or written.
!
!   HOSTNAME (string):
!      Used only on the connect OP; supplies the name of the host where the 
!      server is running.  As a convenience for backwards compatibility with
!      TCPCLI/TCPSRV, it can be the 5th param (if 6 params specified and
!      6th is numeric), or the last param (with 5, 6, or 7 params specified).
!
!----------------------------------------------------------------------------

	on error goto TRAP

	xcall GETVER,PRGVER$
	? TAB(-1,0);"TCPPAR ";PRGVER$" -- Test TCPX parent/child model"
	? "Server accepts connections, spawns children running TCPCH1 to service"
	? "Client(s) send requests rapidly to test server response"
MAIN:
	?
	? "----------------------------------------------------------------"
	?
	? "----------------------------------------------------------------"
	? tab(-1,3);tab(-1,3);	! (move up to space between dotted lines)
	input "MAIN MENU --  Enter 1)client, 2)server, 0)end: ",MODE
	?
	?
	on MODE call CLIENT,SERVER
	xcall ECHO
	if MODE=0 goto ENDIT
	goto MAIN

ENDIT:
	! Basic will not close sockets for us, so we should be careful
	! to close them ourselves...
	call C'CLOSE	    
	call S'CLOSE
	call L'CLOSE
	END

TRAP:
	?
	? "Trapped error #";err(0)
	goto ENDIT

!----------------------------------------------------------------------------
!Server routines
!----------------------------------------------------------------------------
SERVER:
	xcall MIAMEX,22,DIRSEP$		! find out if UNIX or Windows

	? "[SERVER]--------------------------------------------------------"
	input "Enter port # to listen on: ",S'SOCKPORT
        SERVERPORT = S'SOCKPORT                     ! [103]
	input "Use blocking connections? ",BLOCK$
	? "Opening listening socket..."

SERVER'2:                               ! [103]
        S'SOCKPORT = SERVERPORT         ! [103]
 	TCP'FLAGS = TCPXFLG_LISTEN	! return with listen socket
	TCP'OP = TCPOP_ACCEPT
	call TCPSRV
	if STATUS < 0 return	! error	

	! now we have listening socket, save it for later use
	LISTENSOCK = S'SOCKPORT

	! loop, accepting connections until key entered
	! for each connection, spawn a child to service
	xcall NOECHO
        ERRCNT = 0              ! [103]
SRVLOOP:	
	xcall TINKEY,A$		! check if a key entered
	if asc(A$)#0 then 
		? "Exit server? ";
		xcall ACCEPT,A$
		?
		if ucs(A$)="Y" then
			call L'CLOSE	! close listening socket
			return
		endif
	endif

	S'SOCKPORT = LISTENSOCK

	! we could just wait for an accept, but that leaves us hanging
	! if no client connection request ever made, so to allow the
	! program to be easily aborted, we'll instead loop using the
	! check operation to see when a connection becomes available...	

	TCP'OP = TCPOP_CHECK
	TCP'FLAGS = TCPXFLG_ASYNC       ! [102] needed for checking on pending conns
	TCP'TIMER = 5000		! 5 second timeout
	call TCPSRV
	if STATUS=0 then                ! no connection yet avail
            ERRCNT = 0                  ! [103]
            goto SRVLOOP	        ! so try checking again
        endif
        if STATUS<0 then                ! [103] on error,
            ERRCNT = ERRCNT + 1         ! [103] incr counter
            if ERRCNT > 3 then          ! [103] if 4 or more consecutive,
                TCP'OP = TCPOP_CLOSE    ! [103] close listening socket
                call L'CLOSE            ! [103] and
                goto SERVER'2           ! [103] re-open it
            else                        ! [103] else on first error,
                ? "(Error -1 may be spurious side effect of child termination signal)"
                goto SRVLOOP            ! [103] just try again
            endif
        endif

	TCP'FLAGS = TCPXFLG_ASYNC or TCPXFLG_KEEPLISTEN
	if ucs(BLOCK$)="Y" then &
	    TCP'FLAGS = TCP'FLAGS or TCPXFLG_BLOCK
	TCP'STRING = ""		! no auto acknowledgement to client
	TCP'OP = TCPOP_ACCEPT
	call TCPSRV
	if STATUS < 0 then
		? "**** ERROR TRYING TO ACCEPT CONNECTION ****"
		? "**** HIT TAB TO CONTINUE ****"
		A$ = ""
		do while asc(A$) # 9
		    xcall ACCEPT,A$
		loop
		?
		goto SRVLOOP
	endif

	! Now we have a client connection (in S'SOCKPORT); pass it
	! to a child to process....

	if DIRSEP$ = "/" then		! UNIX version
	    ? "Spawning child on socket # ";S'SOCKPORT;"..."
!Note: using XCALL AMOS to launch submit has the downside that AMOS may
!return before child process actually starts running, which means that we
!might close our connection before it gets its own copy opened.  Better to
!use xcall SUBMIT directly...
!	    xcall AMOS,"SUBMIT TCPCH1 "+str(S'SOCKPORT)
            ! we do need to create our own control file though...
            open #1,"tcpchx.ctl", output
            ? #1,"RUN TCPCH1 ";str(S'SOCKPORT)
            close #1
            ! we set stdout to /dev/null - child can create its own 
            ! log if it wants
            xcall SUBMIT,CHPID,"tcpchx.ctl","/dev/null","tcpchx.log","ashell"
            if CHPID > 0 then
                ? "Child process";CHPID;"forked to handle request"
            else
                ? "**** ERROR FORKING CHILD PROCESS: ";CHPID;" ****"
                ! should probably log this error
            endif           
	    call S'CLOSE		! close our copy of connection socket

	else			! Windows version (debug only)

![101]	    call WINDOWS'CHILD'PROCESS

!           xcall MIAMEX,162,S'SOCKPORT,S'DUPSOCK,STATUS
!           if STATUS # 0 then
!               xcall EVTMSG,"Unable to dup socket: STATUS=%d", STATUS
!           else        
S'DUPSOCK = S'SOCKPORT
                ? "Duplicate socket = ";S'DUPSOCK
	        ? "Launching child on socket # ";S'DUPSOCK;"..."

                xcall HOSTEX,"$ASHELL -e -zi RUN TCPCH1 "+ str(S'DUPSOCK) + " #",STATUS
                if STATUS # 0 xcall EVTMSG," STATUS = %d",STATUS

	        call S'CLOSE		! close our copy of connection socket
!               S'SOCKPORT = S'DUPSOCK
!               call S'CLOSE
                S'DUPSOCK = 0
![102]      endif

	endif
	goto SRVLOOP		! go back to listening...

!---------------------------------------------------------------------------
S'CLOSE:
	if S'SOCKPORT # 0 and S'SOCKPORT # LISTENSOCK then  ! [103]
 		TCP'OP = TCPOP_CLOSE
		? "Closing server socket...";S'SOCKPORT;"..."
		call TCPSRV
		S'SOCKPORT = 0
	endif
	return

L'CLOSE:
	if LISTENSOCK # 0 then
 		TCP'OP = TCPOP_CLOSE
		S'SOCKPORT = LISTENSOCK
		? "Closing listening socket...";S'SOCKPORT;"..."
		call TCPSRV
		S'SOCKPORT = 0
		LISTENSOCK = 0
	endif
	return

!---------------------------------------------------------------------------
TCPSRV:
	? "Calling TCPX (SOCKPORT:";str(S'SOCKPORT);
        ? ",OP:";str(TCP'OP);",FLAGS:";str(TCP'FLAGS);",TIMER:";str(TCP'TIMER);")---" ![102]
	xcall TCPX,TCP'OP,STATUS,TCP'PACKET,S'SOCKPORT,TCP'FLAGS,TCP'TIMER
	? "  STATUS   = ";STATUS;
	if STATUS>=0 then 
		? 
	else 
		xcall MIAMEX,86,ABS(STATUS),ERRORMSG 
		? " [";ERRORMSG;"]"
		! [103] TCPX,11 should return same thing as MIAMEX,86
		xcall TCPX,11,STATUS,ERRORMSG,S'SOCKPORT,TCP'FLAGS
		? " <";ERRORMSG;">"
	endif 
	if TCP'OP = TCPOP_ACCEPT then
	    if TCP'FLAGS and TCPXFLG_LISTEN then
		? " LISTENING";
	    else
		? " CONNECTION";
	    endif
	    ? " SOCKET = ";S'SOCKPORT
	    ?
	endif
	return

!----------------------------------------------------------------------------
!Client routines
!----------------------------------------------------------------------------

CLIENT:
	? "[CLIENT]--------------------------------------------------------"

	input "Enter desired port number to create socket for: ",SERVERPORT
	input "Enter host name: ",HOSTNAME
	input "Enter open FLAGS (1=blocking): ",TCP'FLAGS

	xcall NOECHO
	RQNO = 0

CLILOOP:
!       do while getkey(0) >= 0
!       loop
        if LOOPS > 0 then
            LOOPS = LOOPS - 1
        endif
        if LOOPS = 0 then
	    ? "[Hit any key to generate connection/request (ESC to quit, !=99)] ";
	    xcall ACCEPT,A$
	    if asc(A$)=27 then return
            if A$="!"  then LOOPS = 99
        endif
	?
	? "Connecting to server..."
	TCP'OP = TCPOP_CONNECT	! use only generic connect in this test program
	C'SOCKPORT = SERVERPORT		! C'SOCKPORT = server port

	call TCPCLI			! establish connection
	if STATUS < 0 then return	! abort on error

		! note: C'SOCKPORT now = connection socket

	RQNO = RQNO + 1
	TCP'STRING = "Request #"+str(RQNO)	! make up arbitrary "request"
	
	? "Sending ";TCP'STRING;"..."
	TCP'FLAGS = len(TCP'STRING)		! # bytes to send
	TCP'TIMER = 0				! no timeout
	TCP'OP = TCPOP_WRITE
	call TCPCLI
	
	! request sent; now wait for response...
	? "Waiting for response..."

	TCP'FLAGS = 0				! read as bytes are are there
	TCP'TIMER = 10000   			! 10 second timeout
        TCP'STRING = ""
	TCP'OP = TCPOP_READ
	call TCPCLI
	print "  Response = ",TCP'STRING
	goto CLILOOP

C'CLOSE:
	if C'SOCKPORT # 0 then
		? "Closing client socket..."
		TCP'OP = TCPOP_CLOSE
		call TCPCLI
		C'SOCKPORT = 0
	endif
	return

!------------------------------------------------------------------------
TCPCLI:
	? "Calling TCPCLI (SOCKPORT: ";str(C'SOCKPORT);")---"
	xcall TCPX,TCP'OP,STATUS,TCP'PACKET,C'SOCKPORT,TCP'FLAGS, &
		TCP'TIMER,HOSTNAME  	! [103] add TCP'TIMER
	? "  STATUS   = ";STATUS;
	if STATUS>=0 then
		? 
	else 
		xcall MIAMEX,86,ABS(STATUS),ERRORMSG 
		? " [";ERRORMSG;"]"
	endif
	if TCP'OP = TCPOP_CONNECT then
		? "  SOCKPORT = ";C'SOCKPORT
		?
	endif
	return


!-------------------------------------------------------------------------
! This code replaces the true child process for testing the app under
! Windows.  (Windows doesn't really support SUBMIT and we aren't ready
! at this point to implement the ability to pass the connection to a 
! child.  So we'll just treat the 'child' as a subroutine here....
!-------------------------------------------------------------------------

WINDOWS'CHILD'PROCESS:

	? "[Pseudo-child]"
	? "Read socket #";str(S'SOCKPORT);"..."
	TCP'FLAGS = 0				! read all
	TCP'TIMER = 5000			! 5 second timeout
	TCP'OP = TCPOP_READ
	call TCPSRV
	print "  TCP'STRING: ",TCP'STRING

	! (Here we generate a dummy file, just to simulate doing some
	! actual work before coming up with a response...)
	xcall GETJOB,FILJOB
	xcall STRIP,FILJOB
	FILJOB = FILJOB + ".tmp"
	open #1, FILJOB, output
	for I = 1 to 10000
		? #1, "This is just a bunch of dummy data - line ";I	
	next I
	close #1
	kill FILJOB

	! for our 'real' response, we'll just paraphrase the request
	xcall STRIP,TCP'STRING
	TCP'STRING = "This is the response to [" + TCP'STRING + "]"
	
	TCP'FLAGS = len(TCP'STRING)
	TCP'TIMER = 5000			! 5 second timeout
	TCP'OP = TCPOP_WRITE
	call TCPSRV

	! now close our socket and return
	call S'CLOSE
	return