/* RXSOCKET -- MVS REXX/TCP-IP SOCKET SERVER */
/*** DESCRIPTION *****************************/
/* This is a test rexx socket server to help */
/* evaluate alternatives to our rochade RPC  */
/* communications.                           */
/*** AUTHOR **********************************/
/* Burt L. Crockett                          */
/*********************************************/
 
"CLEAR"
PARSE UPPER VAR argstring
SAY argstring
 
port = '14378' /* I hope this port isn't in use */
ecpref = 'RXS'
ecname = 'SER'
initialized = 0
 
PARSE SOURCE . . exec_name . dsn .
SIGNAL ON SYNTAX NAME ERROR_ROUTINE
SIGNAL ON HALT
CALL ON ERROR NAME ERROR_ROUTINE
 
/*** Initialize Socket communications *******************/
say exec_name': initializing'
call Socket 'Initialize', exec_name
if src=0 then initialized=1
else call error 'E', 200, 'Unable to initialize socket'
ipaddress = Socket('GetHostID')
if src<>0 then call error 'E', 200, 'Unable to get the local ipaddress'
say exec_name': Initialized: ipaddress='ipaddress 'port='port
 
/*** Initialize for accepting connection requests *******/
socketID = Socket('Socket')
if src<>0 then call error 'E', 32, 'Socket(Socket) rc='src
say "Socket initialized for accepting connection requests."
 
call Socket 'Bind', socketID, 'AF_INET' port ipaddress
if src<>0 then call error 'E', 32, 'Socket(Bind) rc='src
say "Socket Bind successful."
 
queuelength = 10
call Socket 'Listen', socketID, queuelength
if src<>0 then call error 'E', 32, 'Socket(Listen) rc='src
say "Listening on port "port "with a queue of length "queuelength
 
call Socket 'Ioctl', socketID, 'FIONBIO', 'ON'
if src<>0 then call error 'E', 32, 'Cannot set mode of socket',
   socketID "rc="src
say "NONBLOCKING for socket IO is set to ON"
 
/*** Wait for new connections ****************************/
timeout = 15             /* howmany seconds */
writeSocketIDList = ''
 
say "Waiting for a connection..."
do forever
   /*** wait for an event ****/
   if writeSocketIDList<>'' then
      sEventList = 'Write'writeSocketIDList 'Read * Exception'
   else sEventList = 'Write Read * Exception'
 
   /*** 'Select' waits timeout seconds for a client to connect ***/
   socketID = Socket('Select', sEventList, timeout)
   if src<>0 then call error 'E', 36, "Socket(Select rc="src
   parse upper var socketIDList,
      . 'READ' activeReadList 'WRITE' activeWriteList 'EXCEPTION' .
   if activeReadList<>'' | activeWriteList<>'' then do
      event = "SOCKET"
      if activeReadList<>'' then do
         parse var activeReadList activeReadSocket .
         connectstr = 'READ' activeReadSocket
      end
      else do
         parse var activeWriteList activeWriteSocket .
         connectstr = 'WRITE' activeWriteSocket
      end
   end
   else event = 'TIME'
 
   select
 
      /*** accept connections from clients, receive and send msgs ***/
      when event='SOCKET' then do
         parse var connectstr mode activeSocketID .
         say "Mode of connect is "mode
 
         /*** accept new connections from clients ***/
         if mode='READ' & activeSocketID=socketID then do
           newSocketName = Socket('Accept', socketID)
           if src=0 then do
            parse var newSocketName newSocketID . newPort newIPAddress .
            say exec_name': connected by' newIPAddress 'on port' newPort,
               'and socketID' newSocketID
           end
         end
         if mode='READ' & activeSocketID<>socketID then do
            call Socket 'SetSockOpt', activeSocketID, 'IPPROTO_TCP',,
                        'So_ASCII','On'
            parse value Socket('Recv',activeSocketID) with len query
            if src=0 & len>0 then do
               say "received from client: "query
               call addsock(activeSocketID)
            end
            else do
               call Socket 'Close', activeSocketID
               call delsock(activeSocketID)
               say exec_name': disconnected socket' activeSocketID,
                   " failure on RECV"
            end
            /* insert calls to host services here */
            /* call Socket 'Send', activeSocketID, "hello" */
            call Socket 'Close', activeSocketID
            call delsock(activeSocketID)
            say exec_name': disconnected socket' activeSocketID
         end /* if mode='READ' & activeSocketID<>socketID */
      end /* when event='SOCKET' */
      otherwise nop /*** timeout ***/
   end /* select */
end /* do forever */
 
/*** Terminate and exit **************************/
call Socket 'Terminate'
say exec_name': Terminated'
exit 0
 
/*** Procedure to add a socket to the write socket list *****/
addsock: procedure expose writeSocketIDList
   socketID = arg(1)
   p = wordpos(socketID, writeSocketIDList)
   if p=0 then writeSocketIDList = writeSocketIDList socketID
return
 
/*** Procedure to delete a socket from the write socket list *****/
delsock: procedure expose writeSocketIDList
   socketID = arg(1)
   p = wordpos(socketID, writeSocketIDList)
   if p>0 then do
      templist = ''
      do i=1 to words(writeSocketIDList)
         if i<>p then templist = templist word(writeSocketIDList, i)
      end
      writeSocketIDList = templist
   end
return
 
/*** Procedure to call the real socket function ********/
Socket: procedure expose ecpref ecname initialized src
   a0 = arg(1)
   a1 = arg(2)
   a2 = arg(3)
   a3 = arg(4)
   a4 = arg(5)
   a5 = arg(6)
   a6 = arg(7)
   a7 = arg(8)
   a8 = arg(9)
   a9 = arg(10)
   parse value 'SOCKET'(a0,a1,a2,a3,a4,a5,a6,a7,a8,a9) with src res
return res
 
/*** Halt exit routine **************************/
halt:
   call error 'E', 4, '==> REXX Interrupted'
return
 
/*** Error message and exit routine *************/
error: procedure expose ecpref ecname initialized
   type = arg(1)
   retc = arg(2)
   text = arg(3)
 
   ecretc = right(retc,3,'0')
   ectype = translate(type)
   ecfull = ecpref || ecname || ecretc || ectype
   say '===> Error:' ecfull text
   if type<>'E' then return
   if initialized then do
      parse value Socket('SocketSetStatus') with . status severreason
      if status <> 'Connected' then do
         say 'The status of the socket set is' status severreason
      end
      say 'Terminating the socket'
      call Socket 'Terminate'
   end
exit retc
 
/*--------------------------------------*/
/* ERROR SUBROUTINE                     */
/*--------------------------------------*/
ERROR_ROUTINE:
   SAY "REXX EXEC" exec_name "FAILED - DIAGNOSTIC DATA FOLLOWS"
   SAY "FAILING LINE: " sourceline(sigl)
   SAY "FAILING LINE NUMBER: " sigl
   SAY "RETURN CODE: " rc
EXIT rc