Figure 1. EZACICAS assembler
iterative server sample
*ASM XOPTS(NOPROLOG)
***********************************************************************
* *
* Module Name: EZACICAS - This is a sample iterative server *
* *
* Copyright: Licensed Materials - Property of IBM *
* *
* "Restricted Materials of IBM" *
* *
* 5694-A01 *
* *
* Copyright IBM Corp. 2003, 2007 *
* *
* US Government Users Restricted Rights - *
* Use, duplication or disclosure restricted by *
* GSA ADP Schedule Contract with IBM Corp. *
* *
* Status: CSV1R9 *
* *
* *
* LANGUAGE: ASSEMBLER *
* *
* ATTRIBUTES: NON-REUSEABLE *
* *
* REGISTER USAGE: *
* R1 = *
* R2 = *
* R3 = BASE REGISTER *
* R4 = BASE REGISTER *
* R5 = *
* R6 = WORK *
* R7 = SUBROUTINE *
* R8 = WORK *
* R9 = GWA REGISTER *
* R10 = *
* R11 = EIB REGISTER *
* R12 = *
* R13 = DATA REGISTER *
* R14 = *
* R15 = *
* *
* INPUT: *
* *
* OUTPUT: *
* *
* $MOD(EZACICAS),COMP(CICS),PROD(TCPIP): *
* *
* *
***********************************************************************
EZACICAS CSECT
DFHEIENT CODEREG=(3,4), Base registers for the program X
DATAREG=(13), Base register for data X
EIBREG=(11) Base register for CICS EIB
EZACICAS AMODE ANY ADDRESSING MODE ...
EZACICAS RMODE ANY RESIDENCY MODE ...
B SRV60000 Branch to startup address
DC CL17'EZACICAS-EYECATCH'
SRV60000 DS 0H Beginning of program
USING GWA0000,R9 Address GWA storage
MVC MODULE,=C'EZACICAS: '
*
* Establish conditions to be ignored
*
EXEC CICS IGNORE CONDITION TERMERR EOC SIGNAL NOTALLOC
*
* Establish conditions to be handled
*
EXEC CICS HANDLE CONDITION ENDDATA(ENDDATA_ERR), X
IOERR(IOERR_ERR), X
LENGERR(LENGERR_ERR), X
NOSPACE(NOSPACE_ERR), X
QIDERR(QIDERR_ERR)
*
* Send message that server has started.
*
* XC MSGAREA,MSGAREA Clear the message buffer
MVC MSGAREA(L'STARTOK),STARTOK Move STARTED message
BAL R7,HANDLE_TCPCICS Write to TD Queue
*
* Determine the CICS Applid
*
EXEC CICS ASSIGN APPLID(APPLID)
*
* Before the server can start, determine whether the IP CICS Sockets
* interface is active.
*
EXEC CICS PUSH HANDLE
EXEC CICS HANDLE CONDITION INVEXITREQ(TCP_TRUE_REQ), X
NOTAUTH(NOTAUTH_ERR)
EXEC CICS EXTRACT EXIT PROGRAM('EZACIC01'), X
GASET(R9) GALENGTH(GWALEN)
*
EXEC CICS POP HANDLE
*
* At startup , the server requires the port number which it will use
* for its passive socket.
*
* Invocation: <server>,<port number>
* where server is the CICS Transaction name assigned to EZACICAS
* and port number is a port to which EZACICA will bind as its
* passive socket.
* TERMINAL => SRV6 04000
* LISTENER => SRV6,04000
* CECI => CECI START TR(SRV6) FROM(04000)
*
* THE LEADING SPACES ARE SIGNIFICANT.
*
XC TCP_INPUT_DATA,TCP_INPUT_DATA Clear input data area
L R8,ZERO
STH R8,TRMNL_LEN
L R8,TEN Look for up to ten bytes data
STH R8,TRMNL_MAXLEN from the terminal
*
EXEC CICS RECEIVE INTO(TCP_INPUT_DATA) LENGTH(TRMNL_LEN) X
MAXLENGTH(TRMNL_MAXLEN)
*
LH R8,TRMNL_LEN Check the amount of data received
C R8,TEN from the terminal. Was it 10?
BE USE_RECEIVED_PORT Yes, go determine the port number
*
XC TCP_INPUT_DATA,TCP_INPUT_DATA Clear input data area
L R8,=F'1153'
STH R8,RETRIEVE_LEN from The Listener
MVC TRANS,EIBTRNID Copy the passed trans
*
EXEC CICS RETRIEVE INTO(TCP_INPUT_DATA) LENGTH(RETRIEVE_LEN)
*
* Determine if the server was started by CECI or a listener.
*
LH R8,RETRIEVE_LEN Load the RETRIEVED length
C R8,CECI_LEN Is it less than 5?
BNH USE_RETRIEVED_PORT Yes. Go use the RETRIEVE'd port
OI TAKESOCKET_SWITCH,X'01' Otherwise indicate the server X
was started by the Listener
MVC BIND_PORT(5),CLIENT_IN_DATA For the LISTEN message
PACK DWORK(8),CLIENT_IN_DATA(5) Use port from TIM
B CONVERT_PORT Go convert it to binary format
USE_RECEIVED_PORT DS 0H
MVC BIND_PORT(5),TCP_INPUT_DATA+5 For the LISTEN message
PACK DWORK(8),TCP_INPUT_DATA+5(5) Use the port RECEIVE'd
B CONVERT_PORT
USE_RETRIEVED_PORT DS 0H
MVC BIND_PORT(5),TCP_INPUT_DATA For the LISTEN message
PACK DWORK(8),TCP_INPUT_DATA(5) Use the port RETRIEVE'd
CONVERT_PORT DS 0H
CVB R8,DWORK Convert user supplied port to binary
STH R8,PORT and save it for the passive socket
*
* If the server was started by a listener, then we must take the socket
* given. Otherwise, we should proceed with an INITAPI.
*
TM TAKESOCKET_SWITCH,X'01' Do we need to use TAKESOCKET ?
BO LISTENER_STARTED_TASK Yes. Go issue TAKESOCKET
*
* Since the server was not started by a listener, we should initialize
* the IP CICS Sockets interface.
*
INIT_SOCKETS DS 0H
MVC SUBTASKNO,EIBTASKN Use the CICS task number
*
CALL EZASOKET,(SOCINIT,MAXSOC,IDENT,INIT_SUBTASKID,MAXSNO, X
ERRNO,RETCODE),VL,MF=(E,PARMLIST)
*
L R5,ERRNO Check for successful call
L R6,RETCODE Check for successful call
MVC MSGCMD,SOCINIT Show the API command
C R6,ZERO Is it less than zero
BL SOCERR Yes, go display error and terminate
MVC MSGRESULT(L'SUCC),SUCC Move SUCCESSFUL msg to TD area
BAL R7,HANDLE_TCPCICS Write to TD Queue
MVI TERMAPI_REQUIRED_SW,C'Y' Since we did an INITAPI.
*
* Get an AF_INET6 socket. If unsuccessful, then get an AF_INET socket.
*
SOCKET_BIND_LISTEN DS 0H
*
CALL EZASOKET,(SOCSOKET,AFINET6,SSTREAM,ZERO, X
ERRNO,RETCODE),VL,MF=(E,PARMLIST)
*
L R5,ERRNO Check for successful call
L R6,RETCODE Check for successful call
MVC MSGCMD,SOCSOKET Show the API command
C R6,ZERO Is it less than zero
BL GET_IPV4_SOCKET Yes, go get an IPv4 socket
STH R6,SRV_SOCKID Save the new socket descriptor
MVC MSGRESULT(L'SUCC),SUCC Move SUCCESSFUL msg to TD area
BAL R7,HANDLE_TCPCICS Write to TD Queue
*
* Setup an IPv6 sockaddr.
*
MVC SAIN_SOCK_FAMILY,=AL2(AF_INET6) Set family to AF_INET6
XC SAIN_SOCK_SIN6_FLOWINFO,SAIN_SOCK_SIN6_FLOWINFO X
Flow info is zeros
MVC SAIN_SOCK_SIN6_ADDR,IN6ADDR_ANY Use IN6ADDR_ANY
XC SAIN_SOCK_SIN6_SCOPE_ID,SAIN_SOCK_SIN6_SCOPE_ID X
Scope ID is zeros
MVC SAIN_SOCK_SIN6_PORT,PORT Use the user specified port
B BIND_SERVER_SOCKET Now go issue a BIND
*
GET_IPV4_SOCKET DS 0H
CALL EZASOKET,(SOCSOKET,AFINET,SSTREAM,ZERO, X
ERRNO,RETCODE),VL,MF=(E,PARMLIST)
*
L R5,ERRNO Check for successful call
L R6,RETCODE Check for successful call
MVC MSGCMD,SOCSOKET
C R6,ZERO Is it less than zero
BL SOCERR Yes, go display error and terminate
STH R6,SRV_SOCKID Save the new socket descriptor
MVC MSGRESULT(L'SUCC),SUCC Move SUCCESSFUL msg to TD area
BAL R7,HANDLE_TCPCICS Write to TD Queue
*
* Setup an IPv4 sockaddr
*
XC SOCKADDR_IN(28),SOCKADDR_IN Clear the sockaddr storage
MVC SAIN_SOCK_FAMILY,=AL2(AF_INET) Set family to AF_INET
MVC SAIN_SOCK_SIN_ADDR,INADDR_ANY Use INADDR_ANY
MVC SAIN_SOCK_SIN_PORT,PORT Use the user specified port
*
* Bind the socket to the service port to establish a local address for
* processing incoming connections.
*
BIND_SERVER_SOCKET DS 0H
*
CALL EZASOKET,(SOCBIND,SRV_SOCKID,SOCKADDR_IN, X
ERRNO,RETCODE),VL,MF=(E,PARMLIST)
*
L R5,ERRNO Check for successful call
L R6,RETCODE Check for successful call
MVC MSGCMD,SOCBIND
C R6,ZERO Is it less than zero
BL SOCERR Yes, go dispay error and terminate
MVC MSGRESULT(L'SUCC),SUCC Move SUCCESSFUL msg to TD area
BAL R7,HANDLE_TCPCICS Write to TD Queue
*
* Call the LISTEN command to allow server to prepare a socket for
* incomming connections and set the maximum number of connections.
*
MVC BACKLOG,TEN Set backlog to 10
*
CALL EZASOKET,(SOCLISTN,SRV_SOCKID,BACKLOG, X
ERRNO,RETCODE),VL,MF=(E,PARMLIST)
*
L R5,ERRNO Check for successful call
L R6,RETCODE Check for successful call
MVC MSGCMD,SOCLISTN
C R6,ZERO Is it less than zero
BL SOCERR Yes, go dispay error and terminate
MVC MSGRESULT(L'SUCC),SUCC Move SUCCESSFUL msg to TD area
BAL R7,HANDLE_TCPCICS Write to TD Queue
*
* Show server is ready to process client connections.
*
L R6,TWO Force client socket desctiptor
STH R6,CLI_SOCKID to be 2.
MVC MSGAREA(L'LISTEN_SUCC),LISTEN_SUCC
BAL R7,HANDLE_TCPCICS Write to TD Queue
*
* Create a read mask for the SELECT command
*
L R8,NUM_FDS Get the number of allowed FD's
A R8,ONE and add one
ST R8,NFDS for the SELECT call.
*
* Determine status IP CICS Sockets Interface
*
CLI GWATSTAT,GWATIMED Are we in immediate termination
BE SOCRET Return if so
CLI GWATSTAT,GWATQUIE Are we in quiesceent termination
BNE SET_SELECT_BIT_MASK No, continue with SELECT
B CLOSEDOWN
*
* Create the read bitmask
*
SET_SELECT_BIT_MASK DS 0H
LH R6,SRV_SOCKID Get the servers socket desciptor
SRDL R6,5 Compute the word number
SRL R7,27 Compute the socket number within the X
mask word.
SLR R8,R8 Clear work register
LA R8,1 Set high-order bit
SLL R8,0(R7) Create mask word
ST R8,SAVER8 Save mask word
SLL R6,2 Compute the offset
LA R7,READMASK Address the read mask storage
LA R7,0(R6,R7) Point to the word
OC 0(4,R7),SAVER8 Turn on bits
*
* SELECT client connections
*
ACCEPT_CLIENT_REQ DS 0H
*
CALL EZASOKET,(SOCSELCT,NFDS,TIMEVAL, X
READMASK,DUMYMASK,DUMYMASK, X
REPLY_RDMASK,DUMYMASK,DUMYMASK, X
ERRNO,RETCODE),VL,MF=(E,PARMLIST)
*
L R5,ERRNO Check for successful call
L R6,RETCODE Check for successful call
ST R6,SELECT_RETCODE Save the SELECT return code
MVC MSGCMD,SOCSELCT
C R6,ZERO Is it less than zero
BL SOCERR Yes, go display error and terminate
MVC MSGRESULT(L'SUCC),SUCC Move SUCCESSFUL msg to TD area
BAL R7,HANDLE_TCPCICS Write to TD Queue
*
* Check the return code to determine if any sockets are ready to be
* accepted. If RETCODE is zero then there are no sockets ready.
*
L R6,SELECT_RETCODE Retrieve the SELECT return code
C R6,ZERO Any sockets ready ?
BE ACCEPT_CLIENT_REQ No. Go back and SELECT again
*
* Accept the client request.
*
CALL EZASOKET,(SOCACCT,SRV_SOCKID,SOCKADDR_IN, X
ERRNO,RETCODE),VL,MF=(E,PARMLIST)
*
L R5,ERRNO Check for successful call
L R6,RETCODE Check for successful call
MVC MSGCMD,SOCACCT
C R6,ZERO Is it less than zero
BL SOCERR Yes, go display error and terminate
STH R6,CLI_SOCKID Save the new socket descriptor
MVC MSGRESULT(L'SUCC),SUCC Move SUCCESSFUL msg to TD area
BAL R7,HANDLE_TCPCICS Write to TD Queue
*
* Get our peers' socket address
*
CALL EZASOKET,(SOCGPEER,CLI_SOCKID,SOCKADDR_PEER, X
ERRNO,RETCODE),VL,MF=(E,PARMLIST)
*
L R5,ERRNO Capture the ERRNO and
L R6,RETCODE the return code.
MVC MSGCMD,SOCGPEER the API function performed.
C R6,ZERO Is the call successful?
BL SOCERR No! Go display error and terminate
MVC MSGRESULT(L'SUCC),SUCC Move SUCCESSFUL msg to TD area
BAL R7,HANDLE_TCPCICS Write to TD Queue
*
* Get our client's host name and service name
*
L R8,=F'16' Set the sockaddr length to IPv4
CLC PEER_SOCK_FAMILY,=AL2(AF_INET) Is the client AF_INET ?
BE SET_SOCKADDR_LEN Yes. Go store the length.
L R8,=F'28' Set the sockaddr length to IPv6
SET_SOCKADDR_LEN DS 0H
ST R8,PEERADDR_LEN Save the value of the sockaddr length
L R8,ZERO Clear the
ST R8,GNI_FLAGS GETNAMEINFO flags
XC PEER_HOSTNAME,PEER_HOSTNAME Clear the host name storage
L R8,=F'255' Set the length of
ST R8,PEER_HOSTNAMELEN the host name storage
XC PEER_SERVICENAME,PEER_SERVICENAME Clear the service X
name storage
L R8,=F'32' Set the length of
ST R8,PEER_SERVICENAMELEN the service name storage
*
CALL EZASOKET,(SOCGNI,SOCKADDR_PEER,PEERADDR_LEN, X
PEER_HOSTNAME,PEER_HOSTNAMELEN, X
PEER_SERVICENAME,PEER_SERVICENAMELEN, X
GNI_FLAGS, X
ERRNO,RETCODE),VL,MF=(E,PARMLIST)
*
L R5,ERRNO Capture the ERRNO and
L R6,RETCODE the return code.
MVC MSGCMD,SOCGNI the API function performed.
C R6,ZERO Is the call successful?
BL SOCERR No! Go display error and terminate
MVC MSGRESULT(L'SUCC),SUCC Move SUCCESSFUL msg to TD area
BAL R7,HANDLE_TCPCICS Write to TD Queue
*
* Display the host name
*
MVC TDHOST(L'TDHOST),PEER_HOSTNAME
MVC MSGAREA(L'TDHOSTMSG),TDHOSTMSG Move message to TD area
BAL R7,HANDLE_TCPCICS Write to TD Queue
*
* Display the service name
*
MVC TDSERV(L'TDSERV),PEER_SERVICENAME
MVC MSGAREA(L'TDSERVMSG),TDSERVMSG Move message to TD area
BAL R7,HANDLE_TCPCICS Write to TD Queue
*
* Receiving data through a socket by issuing the RECVFROM command.
*
ACCEPT_RECEIVE DS 0H
MVI TCP_INDICATOR,C'T'
MVC TCPLENG,BUFFER_LENG
XC TCP_BUF,TCP_BUF Clear the buffer storage
*
CALL EZASOKET,(SOCRECVF,CLI_SOCKID,RCVFM_FLAG,TCPLENG, X
TCP_BUF,SOCKADDR_IN, X
ERRNO,RETCODE),VL,MF=(E,PARMLIST)
*
L R5,ERRNO Capture the ERRNO and
L R6,RETCODE the return code.
ST R6,RECVFROM_RETCODE Save the RECVFROM return code
C R6,ZERO Is the call successful?
BL RECVFROM_ERROR No!
*
* If the RECVFROM return code is zero and the number of bytes received
* is also zero, then there is nothing further to process.
*
BE CHECK_NBYTES Yes. Go check number bytes received
B RECVFROM_OK NO. Go interpret clients data
CHECK_NBYTES DS 0H
L R6,TCPLENG Check number of bytes received
C R6,ZERO Is it zero ?
BE ACCEPT_RECEIVE Yes. Go issue RECVFROM again.
B RECVFROM_OK No. Must have received something.
RECVFROM_ERROR DS 0H
MVC MSGAREA(L'RECVFROM_ERR),RECVFROM_ERR
BAL R7,HANDLE_TCPCICS Write to TD Queue
MVI TASK_FLAG,C'1' Force the Client connection to end
B CLOSE_CLIENT Go close clients socket
RECVFROM_OK DS 0H
*
* Interpret the clients request.
*
* Remove the following call to EZACIC05 if using an EBCDIC client.
*
* CALL EZACIC05,(TCP_BUF,TCPLENG),VL,MF=(E,PARMLIST)
*
CLC TCP_BUF_H,TCP_BUF_H_LOW_VALUES Display data received
BE COMMAND_IS_LOW_VALUES from the client as blanks.
CLC TCP_BUF_H,TCP_BUF_H_SPACES Display data received from
BE COMMAND_IS_SPACES the client as blanks
CLC TCP_BUF_H,TCP_BUF_H_END End client connection?
BE SET_END Yes.
CLC TCP_BUF_H,TCP_BUF_H_TRM Terminate server?
BE SET_TERM Yes.
*
* Inform the cleint that the server has process the message
*
XC MSGAREA,MSGAREA
MVC MSGAREA(L'SERVER_PROC_MSG),SERVER_PROC_MSG
*
EXEC CICS SYNCPOINT
*
EXEC CICS ASKTIME ABSTIME(UTIME) NOHANDLE
EXEC CICS FORMATTIME ABSTIME(UTIME) X
DATESEP('/') MMDDYY(MSGDATE) X
TIME(MSGTIME) TIMESEP(':') NOHANDLE
LA R6,TCPCICS_MSG_AREA_LEN
STH R6,TDLEN
EXEC CICS WRITEQ TD QUEUE('CSMT') X
FROM(TCPCICS_MSG_AREA) X
LENGTH(TDLEN)
*
MVC TCP_BUF,TCPCICS_MSG_AREA_2
*
* Remove the following call to EZACIC04 if using an EBCDIC client.
*
* CALL EZACIC04,(TCP_BUF,TCPLENG),VL,MF=(E,PARMLIST)
*
* Write the server process message back to the client
*
CALL EZASOKET,(SOCWRITE,CLI_SOCKID,TCPLENG,TCP_BUF, X
ERRNO,RETCODE),VL,MF=(E,PARMLIST)
*
L R5,ERRNO Capture the ERRNO and
L R6,RETCODE the return code.
MVC MSGCMD,SOCWRITE the API function performed.
C R6,ZERO Is the call successful?
BL TALK_CLIENT_BAD No! Go display error
MVC MSGRESULT(L'SUCC),SUCC Move SUCCESSFUL msg to TD area
*
XC TCP_BUF,TCP_BUF
MVI TCP_INDICATOR,X'00'
B ACCEPT_RECEIVE Go receive more client data
TALK_CLIENT_BAD DS 0H
MVI TASK_FLAG,C'1' Force client connection to end.
B CLOSE_CLIENT
*
* Process command from client
*
COMMAND_IS_LOW_VALUES DS 0H
COMMAND_IS_SPACES DS 0H
XC MSGRESULT,MSGRESULT
MVC MSGCMD,SOCRECVF
MVC MSGRESULT(37),=C'CLIENT COMMAND IS BLANKS OR LOWVALUES'
BAL R7,HANDLE_TCPCICS Write to TD Queue
B ACCEPT_RECEIVE Go receive more data from client
SET_END DS 0H
MVI TASK_FLAG,C'1'
B CLOSE_CLIENT
SET_TERM DS 0H
MVI TASK_FLAG,C'2'
B CLOSE_CLIENT
*
* CLOSE CLIENT SOCKET DESCRIPTOR
*
CLOSE_CLIENT DS 0H
CALL EZASOKET,(SOCCLOSE,CLI_SOCKID, X
ERRNO,RETCODE),VL,MF=(E,PARMLIST)
L R5,ERRNO Check for successful call
L R6,RETCODE Check for successful call
MVC MSGCMD,SOCCLOSE
C R6,ZERO Is it less than zero
BL SOCERR Yes, go display error and terminat
MVC MSGRESULT(L'SUCC),SUCC Move SUCCESSFUL msg to TD area
BAL R7,HANDLE_TCPCICS Write to TD Queue
*
* Determine whether we should select another socket
*
CLI TASK_FLAG,C'2' Terminate server?
BE CLOSEDOWN Yes. Go close passive socket
MVI TASK_FLAG,C'0' Reset the task flag for next client
B ACCEPT_CLIENT_REQ Go select new connection.
*
CLOSEDOWN DS 0H
*
* CLOSE SOCKET DESCRIPTOR
*
* SET THE SERVER SOCKET TO NOT LINGER ON THE CLOSE
*
CALL EZASOKET,(SOCSETSO,SRV_SOCKID,SOCK#SO_LINGER,ON_ZERO, X
EIGHT,ERRNO,RETCODE),VL,MF=(E,PARMLIST)
*
* CLOSE THE SERVER PASSIVE SOCKET
*
CALL EZASOKET,(SOCCLOSE,SRV_SOCKID, X
ERRNO,RETCODE),VL,MF=(E,PARMLIST)
L R5,ERRNO Check for successful call
L R6,RETCODE Check for successful call
MVC MSGCMD,SOCCLOSE
C R6,ZERO Is it less than zero
BL SOCERR Yes, go display error and terminat
MVC MSGRESULT(L'SUCC),SUCC Move SUCCESSFUL msg to TD area
BAL R7,HANDLE_TCPCICS Write to TD Queue
CLI TERMAPI_REQUIRED_SW,C'Y' A TERMAPI needed ?
BE TERM_API Yes, go issue TERMAPI
B SOCRET No, return to CICS
*
* Terminate IP CICS Sockets API
*
TERM_API DS 0H
CALL EZASOKET,(SOCTERM),VL,MF=(E,PARMLIST)
MVC MSGCMD,SOCTERM
MVC MSGRESULT(L'SUCC),SUCC Move SUCCESSFUL msg to TD area
BAL R7,HANDLE_TCPCICS Write to TD Queue
*
B SOCRET
*
* Listener Started Task routine.
*
LISTENER_STARTED_TASK DS 0H
*
* Take the socket which was given by the listener.
*
L R8,GIVE_TAKE_SOCKET Use the socket descriptor from the
STH R8,SOCKET_TO_TAKE TIM for the TAKESOCKET
XC CLIENTID_LSTN,CLIENTID_LSTN Clear the clientid
LH R8,STIM_FAMILY Get the domain from the TIM
ST R8,CID_DOMAIN_LSTN Set the domain
MVC CID_LSTN_INFO,CLIENTID_PARM Set the Address space and X
subtask name.
*
CALL EZASOKET,(SOCTSOCK,SOCKET_TO_TAKE,CLIENTID_LSTN, X
ERRNO,RETCODE),VL,MF=(E,PARMLIST)
*
L R5,ERRNO Check for successful call
L R6,RETCODE Check for successful call
MVC MSGCMD,SOCTSOCK Set the API name
C R6,ZERO Is it less than zero
BL SOCERR Yes, go display error and terminate
STH R6,SRV_SOCKID Save the taken socket descriptor
MVC MSGRESULT(L'SUCC),SUCC Move SUCCESSFUL msg to TD area
BAL R7,HANDLE_TCPCICS Write to TD Queue
*
* Inform the client that the server has started.
*
MVC TCPLENG,BUFFER_LENG Set the message length
XC TCP_BUF,TCP_BUF Clear the buffer
MVC TCP_BUF(L'STARTOK),STARTOK Move STARTED message
*
* Remove the following call to EZACIC04 if using an EBCDIC client.
*
* CALL EZACIC04,(TCP_BUF,TCPLENG),VL,MF=(E,PARMLIST)
*
* Notify client the the child subtask has started.
*
CALL EZASOKET,(SOCWRITE,SRV_SOCKID,TCPLENG,TCP_BUF, X
ERRNO,RETCODE),VL,MF=(E,PARMLIST)
*
L R5,ERRNO Capture the ERRNO and
L R6,RETCODE the return code.
MVC MSGCMD,SOCWRITE the API function performed.
C R6,ZERO Is the call successful?
BL SOCERR No! Go display error and terminate
MVC MSGRESULT(L'SUCC),SUCC Move SUCCESSFUL msg to TD area
BAL R7,HANDLE_TCPCICS Write to TD Queue
*
* Close the taken socket descriptor
*
CALL EZASOKET,(SOCCLOSE,SRV_SOCKID, X
ERRNO,RETCODE),VL,MF=(E,PARMLIST)
L R5,ERRNO Check for successful call
L R6,RETCODE Check for successful call
MVC MSGCMD,SOCCLOSE
C R6,ZERO Is it less than zero
BL SOCERR Yes, go display error and terminat
MVC MSGRESULT(L'SUCC),SUCC Move SUCCESSFUL msg to TD area
BAL R7,HANDLE_TCPCICS Write to TD Queue
*
* Continue with server startup
*
B SOCKET_BIND_LISTEN Go continue the server startup
*
* Various routines to process error conditions
*
TCP_TRUE_REQ DS 0H
MVC MSGAREA(L'TCP_EXIT_MSG),TCP_EXIT_MSG
B SEND_ERR_MSG
NOTAUTH_ERR DS 0H
MVC MSGAREA(L'NOTAUTH_MSG),NOTAUTH_MSG
B SEND_ERR_MSG
INVREQ_ERR DS 0H
MVC MSGAREA(L'TCP_EXIT_MSG),TCP_EXIT_MSG
B SEND_ERR_MSG
IOERR_ERR DS 0H
MVC MSGAREA(L'IOERR_MSG),IOERR_MSG
B SEND_ERR_MSG
LENGERR_ERR DS 0H
MVC MSGAREA(L'LENGERR_MSG),LENGERR_MSG
B SEND_ERR_MSG
NOSPACE_ERR DS 0H
MVC MSGAREA(L'NOSPACE_MSG),NOSPACE_MSG
B SEND_ERR_MSG
QIDERR_ERR DS 0H
MVC MSGAREA(L'QIDERR_MSG),QIDERR_MSG
B SEND_ERR_MSG
ITEMERR_ERR DS 0H
MVC MSGAREA(L'ITEMERR_MSG),ITEMERR_MSG
B SEND_ERR_MSG
ENDDATA_ERR DS 0H
MVC MSGAREA(L'ENDDATA_MSG),ENDDATA_MSG
B SEND_ERR_MSG
SEND_ERR_MSG DS 0H
BAL R7,HANDLE_TCPCICS Write to TD Queue
B SOCRET Return to CICS!
*
* Error on EZASOKET call
*
SOCERR DS 0H
MVC MSGAREA(L'MSGCMD),MSGCMD
MVC MSGAREA+16(L'SOCKET_ERR),SOCKET_ERR
BAL R7,HANDLE_TCPCICS Write to TD Queue
*
L R6,RETCODE Pick up the RETCODE value
L R5,ERRNO Pick up the ERRNO value
CVD R6,DWORK Format the RETCODE
UNPK TDRETC,DWORK+4(4) for printing to the
OI TDRETC+6,X'F0' TD queue
*
CVD R5,DWORK Format the ERRNO
UNPK TDERRNO,DWORK+4(4) for printing to the
OI TDERRNO+6,X'F0' TD queue
*
MVC MSGAREA(L'TDTEXT5),TDTEXT5 Move the RETCODE and ERRNO X
to the TD queue area
BAL R7,HANDLE_TCPCICS Write the message to the TD queue
*
B SOCRET Return to CICS
*
* Write a message to the "CSMT" destination queue for logging
*
HANDLE_TCPCICS DS 0H
EXEC CICS ASKTIME ABSTIME(UTIME) NOHANDLE
EXEC CICS FORMATTIME ABSTIME(UTIME) X
DATESEP('/') MMDDYY(MSGDATE) X
TIME(MSGTIME) TIMESEP(':') NOHANDLE
LA R6,TCPCICS_MSG_AREA_LEN
STH R6,TDLEN
EXEC CICS WRITEQ TD QUEUE('CSMT') X
FROM(TCPCICS_MSG_AREA) X
LENGTH(TDLEN)
*
* Tell the client?
*
CLI TCP_INDICATOR,C'T'
BNE HANDLE_TCPCICS_RETURN
MVC TCPLENG,BUFFER_LENG
XC TCP_BUF,TCP_BUF
MVC TCP_BUF,TCPCICS_MSG_AREA_2
*
* Remove the following call to EZACIC04 if using an EBCDIC client.
*
* CALL EZACIC04,(TCP_BUF,TCPLENG),VL,MF=(E,PARMLIST)
MVI TCP_INDICATOR,C' '
*
* Notify client the the child subtask has started.
*
CALL EZASOKET,(SOCWRITE,CLI_SOCKID,TCPLENG,TCP_BUF, X
ERRNO,RETCODE),VL,MF=(E,PARMLIST)
*
L R5,ERRNO Capture the ERRNO and
L R6,RETCODE the return code.
MVC MSGCMD,SOCWRITE the API function performed.
C R6,ZERO Is the call successful?
BL HANDLE_TCPCICS_RETURN
MVC MSGRESULT(L'SUCC),SUCC Move SUCCESSFUL msg to TD area
*
EXEC CICS ASKTIME ABSTIME(UTIME) NOHANDLE
EXEC CICS FORMATTIME ABSTIME(UTIME) X
DATESEP('/') MMDDYY(MSGDATE) X
TIME(MSGTIME) TIMESEP(':') NOHANDLE
LA R6,TCPCICS_MSG_AREA_LEN
STH R6,TDLEN
EXEC CICS WRITEQ TD QUEUE('CSMT') X
FROM(TCPCICS_MSG_AREA) X
LENGTH(TDLEN)
*
HANDLE_TCPCICS_RETURN DS 0H
XC MSGAREA,MSGAREA
BR R7 Return to caller
*
* ALL DONE.
*
SOCRET DS 0H
MVC MSGAREA(L'STOPOK),STOPOK Move STOPPED msg to TD area
BAL R7,HANDLE_TCPCICS Write to TD Queue
EXEC CICS RETURN
*
* INITAPI parameters
*
MAXSOC DC H'0' MAXSOC value, use the default
IDENT DC 0CL16' '
TCPNAME DC CL8'TCPCS ' Name of the TCP
APPLID DC CL8'CICS ' Address space name
INIT_SUBTASKID DS 0CL8 Subtask for INITAPI
SUBTASKNO DC CL7' ' from EIBTASKN
SUBT_CHAR DC CL1'L' Make server use a non-reusable subtask
MAXSNO DC F'0' Highest socket descriptor available
*
* Sockets address family
*
AFINET DC F'2' AF_INET
AFINET6 DC F'19' AF_INET6
*
* SOCKET FUNCTIONS
*
SOCACCT DC CL16'ACCEPT '
SOCBIND DC CL16'BIND '
SOCCLOSE DC CL16'CLOSE '
SOCCONNT DC CL16'CONNECT '
SOCFCNTL DC CL16'FCNTL '
SOCFAI DC CL16'FREEADDRINFO '
SOCGCLID DC CL16'GETCLIENTID '
SOCGAI DC CL16'GETADDRINFO '
SOCGNI DC CL16'GETNAMEINFO '
SOCGTHID DC CL16'GETHOSTID '
SOCGTHN DC CL16'GETHOSTNAME '
SOCGPEER DC CL16'GETPEERNAME '
SOCGTSN DC CL16'GETSOCKNAME '
SOCGETSO DC CL16'GETSOCKOPT '
SOCGSOCK DC CL16'GIVESOCKET '
SOCINIT DC CL16'INITAPI '
SOCIOCTL DC CL16'IOCTL '
SOCLISTN DC CL16'LISTEN '
SOCNTOP DC CL16'NTOP '
SOCPTON DC CL16'PTON '
SOCREAD DC CL16'READ '
SOCREADV DC CL16'READV '
SOCRECV DC CL16'RECV '
SOCRECVF DC CL16'RECVFROM '
SOCRECVM DC CL16'RECVMSG '
SOCSELCT DC CL16'SELECT '
SOCSELX DC CL16'SELECTEX '
SOCSEND DC CL16'SEND '
SOCSENDM DC CL16'SENDMSG '
SOCSENDT DC CL16'SENDTO '
SOCSETSO DC CL16'SETSOCKOPT '
SOCSOKET DC CL16'SOCKET '
SOCTSOCK DC CL16'TAKESOCKET '
SOCTERM DC CL16'TERMAPI '
SOCWRITE DC CL16'WRITE '
SOCWRITV DC CL16'WRITEV '
*
* SELECT parms
*
NUM_FDS DC F'5' Number of file descriptors
NFDS DS F
TIMEVAL DC AL4(180),AL4(0)
SELECT_CSOCKET DS 0CL12
READMASK DC XL4'00' SELECT read mask
DUMYMASK DC XL4'00' mask set to binary zeros
REPLY_RDMASK DC XL4'00' SELECT reply read mask
REPLY_RDMASK_FF DS XL4
SELECT_RETCODE DS F Sum of all ready sockets in masks
*
TCPLENG DC F'0'
*
SSTREAM DC F'1' socket type stream
ZERO DC F'0'
ONE DC F'1'
TWO DC F'2'
SIX DC F'6'
EIGHT DC F'8'
TEN DC F'10'
*
* Data for RETRIEVE
*
TRANS DS CL4 Transaction retrieved
LENG DS H Length of data retreived
CECI_LEN DC F'5' Length of Port from CICS Start
TAKESOCKET_SWITCH DC X'00' Used to drive a TAKESOCKET
TCP_INDICATOR DC CL1' '
TASK_FLAG DC CL1'0' Server task flag
*
TCP_BUF DS 0CL55 Buffer
TCP_BUF_H DC CL3' ' Used to pass the server commands
TCP_BUF_DATA DC CL52' '
TCP_BUF_H_END DC CL3'END' Command to end the client connection
TCP_BUF_H_LOW_VALUES DC XL3'000000' Client sent command=low values
TCP_BUF_H_SPACES DC CL3' ' Client sent command=spaces
TCP_BUF_H_TRM DC CL3'TRM' Command to terminate the server
BUFFER_LENG DC F'55' Length of buffer
*
* LISTEN parms
*
BACKLOG DC F'0' Backlog for LISTEN
*
* RECVFROM parms
*
RCVFM_FLAG DC F'0' RECVFROM flag
*
* MESSAGE(S) WRITTEN TO TRANSIENT DATA QUEUE
*
BITMASK_ERR DC CL36'BITMASK CONVERSION - FAILED'
LISTEN_SUCC DS 0CL46
DC CL34'READY TO ACCEPT REQUESTS ON PORT: '
BIND_PORT DC CL5' '
DC CL7' '
ENDDATA_MSG DC CL30'RETRIEVE DATA CAN NOT BE FOUND'
IOERR_MSG DC CL12'IOERR OCCURS'
ITEMERR_MSG DC CL13'ITEMERR ERROR'
LENGERR_MSG DC CL13'LENGERR ERROR'
NOSPACE_MSG DC CL17'NOSPACE CONDITION'
RECVFROM_ERR DC CL36'RECVFROM SOCKET CALL FAILED'
QIDERR_MSG DC CL30'TRANSIENT DATA QUEUE NOT FOUND'
SERVER_PROC_MSG DC CL55'SERVER PROCESSED MESSAGE'
SOCKET_ERR DC CL15'EZASOKET ERROR!'
STARTOK DC CL27'SERVER STARTED SUCCESSFULLY'
STOPOK DC CL27'SERVER STOPPED SUCCESSFULLY'
TCP_EXIT_MSG DC CL31'SERVER STOPPED:TRUE NOT ACTIVE'
NOTAUTH_MSG DC CL31'SERVER STOPPED: NOT AUTHORIZED'
*
* Message to display the clients host name
*
TDHOSTMSG DS 0CL55
TDHOSTLIT DC CL9'HOSTNAME='
TDHOST DC CL46' '
*
* Message to display the clients service name
*
TDSERVMSG DS 0CL55
TDSERVLIT DC CL8'SERVICE='
TDSERV DC CL32' '
DC CL15' '
*
* Message to display EZASOKET RETCODE and ERRNO
*
TDTEXT5 DS 0CL40
DC CL10'RETCODE = '
TDRETC DC CL7' ' Printable RETCODE
DC CL3' '
DC CL9'ERRNO = '
TDERRNO DC CL7' ' Printable ERRNO
DC CL4' '
*
* Misc
*
SUCC DC CL10'SUCCESSFUL'
NOTSUCC DC CL14'NOT SUCCESSFUL'
TERMAPI_REQUIRED_SW DC CL1'N'
ON_ZERO DS 0C
LINGERON DC F'1' On/Off
LINGERTIME DC F'0' Linger time
LTORG
*
* DSECTs
*
EZACICA TYPE=DSECT,AREA=GWA
EZACICA TYPE=DSECT,AREA=TIE
DFHEISTG
SRV6SAVE DS 18F Register Save Area
SRV6STRSV DS F Save area for start subroutine
*
* Socket address structure
*
CNOP 0,8 DOUBLEWORD BOUNDARY
SOCKADDR_IN DS 0F Socket address structure
SAIN_SOCK_FAMILY DS H Address Family
SAIN_SOCK_DATA DS 0C Protocol specific area
ORG SAIN_SOCK_DATA Start of AF_INET unique area
SAIN_SOCK_SIN DS 0C
SAIN_SOCK_SIN_PORT DS H Port number
SAIN_SOCK_SIN_ADDR DS CL4 IPv4 address
DS CL8 Reserved area not used
ORG SAIN_SOCK_DATA Start of AF_INET6 area
SAIN_SOCK_SIN6 DS 0C
SAIN_SOCK_SIN6_PORT DS H Port number
SAIN_SOCK_SIN6_FLOWINFO DS CL4 Flow Information
SAIN_SOCK_SIN6_ADDR DS CL16 IPv6 address
SAIN_SOCK_SIN6_SCOPE_ID DS CL4 Scope id
*
* Peers address structure
*
CNOP 0,8 DOUBLEWORD BOUNDARY
SOCKADDR_PEER DS 0F Socket address structure
PEER_SOCK_FAMILY DS H Address Family
PEER_SOCK_DATA DS 0C Protocol specific area
ORG PEER_SOCK_DATA Start of AF_INET unique area
PEER_SOCK_SIN DS 0C
PEER_SOCK_SIN_PORT DS H Port number
PEER_SOCK_SIN_ADDR DS CL4 IPv4 address
DS CL8 Reserved area not used
ORG PEER_SOCK_DATA Start of AF_INET6 area
PEER_SOCK_SIN6 DS 0C
PEER_SOCK_SIN6_PORT DS H Port number
PEER_SOCK_SIN6_FLOWINFO DS CL4 Flow Information
PEER_SOCK_SIN6_ADDR DS CL16 IPv6 address
PEER_SOCK_SIN6_SCOPE_ID DS CL4 Scope id
*
PEERADDR_LEN DS F Length of Peers sockaddr
*
* Peers HOST/SERVICE NAME/LEN
*
PEER_HOSTNAME DS CL255 Peers Host name
PEER_HOSTNAMELEN DS F Peers Host name length
PEER_SERVICENAME DS CL32 Peers Service name
PEER_SERVICENAMELEN DS F Peers Service name length
*
* Receive Flag
*
GNI_FLAGS DS F GETNAMEINFO flags
*
* User supplied port to listen on
*
PORT DS H User supplied port
*
* Storage used to create a message to be written to the CSMT TD Queue
*
TCPCICS_MSG_AREA DS 0F TD Message area
TCPCICS_MSG_AREA_1 DS 0C
MSGDATE DS CL8 MM/DD/YY
MSGFILR1 DS CL2
MSGTIME DS CL8 HH:MM:SS
MSGFILR2 DS CL2
MODULE DS CL10 "EZACICAS: "
TCPCICS_MSG_AREA_2 DS 0C
MSGAREA DS CL55
ORG MSGAREA
MSGCMD DS CL16 EZASOKET command issued
MSGRESULT DS CL39 Outcome of the command issued
TCPCICS_MSG_AREA_END EQU * End of message
TCPCICS_MSG_AREA_LEN EQU TCPCICS_MSG_AREA_END-TCPCICS_MSG_AREA X
Length of TD message text
*
TDLEN DS H Length of TD message text
*
* Various other working storage areas
*
UTIME DS PL8 ABSTIME data area
DWORK DS D Double word work area
UNPKWRK DS CL15 Unpack work area
PARMLIST DS 20F
*
* Error numbers and return codes
*
ERRNO DS F ERRNO
RETCODE DS F Return Code
RECVFROM_RETCODE DS F
*
* Client ID from Listener to be used by the TAKESOKET command
*
CLIENTID_LSTN DS 0CL40
CID_DOMAIN_LSTN DS F Domain
CID_LSTN_INFO DS 0CL16
CID_NAME_LSTN DS CL8 Address space name
CID_SUBTNAM_LSTN DS CL8 Subtask name
CID_RES_LSTN DS CL20
*
SOCKET_TO_TAKE DS H Socket descriptor to take
*
* Data from the CICS RECIEVE command
*
TRMNL_LEN DS H Length of data RECEIVE'd
TRMNL_MAXLEN DS H
*
* Data from the CICS RETRIEVE command
*
RETRIEVE_LEN DS H Length of data RETRIEVE'd
*
* Socket descriptors
*
SRV_SOCKID DS H Server socket descriptor
CLI_SOCKID DS H Client socket descriptor
*
* For saving R8
*
SAVER8 DS F
*
* Server data
*
CNOP 0,8 DOUBLEWORD BOUNDARY
TCP_INPUT_DATA DS CL85 Data retrieved
ORG TCP_INPUT_DATA
*
* The Listeners Task Input Message (TIM)
*
TCPSOCKET_PARM DS 0C
GIVE_TAKE_SOCKET DS F
CLIENTID_PARM DS 0CL16
LSTN_NAME DS CL8
LSTN_SUBNAME DS CL8
CLIENT_IN_DATA DS CL35
DS CL1
SOCKADDR_TIM DS 0F
STIM_FAMILY DS H
STIM_DATA DS 0C
STIM#LEN EQU *-SOCKADDR_TIM
ORG STIM_DATA
STIM_SIN DS 0C
STIM_SIN_PORT DS H
STIM_SIN_ADDR DS CL4
DS CL8
DS 20F
STIM_SIN#LEN EQU *-STIM_SIN
ORG STIM_DATA
STIM_SIN6 DS 0C
STIM_SIN6_PORT DS H
STIM_SIN6_FLOWINFO DS CL4
STIM_SIN6_ADDR DS CL16
STIM_SIN6_SCOPE_ID DS CL4
STIM_SIN6#LEN EQU *-STIM_SIN6
ORG
DS CL68
CLIENT_IN_DATA_LENGTH DS H
CLIENT_IN_DATA_2 DS 0C
*
* Fields for EXTRACT EXIT to determine if IP CICS Sockets interface
* is active.
*
GWALEN DS H
*
EZBREHST DSECT=NO,LIST=YES,HOSTENT=NO,ADRINFO=NO
BPXYSOCK DSECT=NO,LIST=YES
DFHEIEND TERMINATE EXECUTE INTERFACE DYNAMIC STORAGE
YREGS
END EZACICAS
z/OS Communications Server: IP CICS Sockets Guide
Copyright IBM Corporation 1990, 2014