EZASVAS3 CSECT
EZASVAS3 AMODE ANY
EZASVAS3 RMODE ANY
GBLB &TRACE ASSEMBLER VARIABLE TO CONTROL TRACE GENERATION
&TRACE SETB 1 1=TRACE ON 0=TRACE OFF
GBLB &SUBTR ASSEMBLER VARIABLE TO CONTROL SUBTRACE
&SUBTR SETB 0 1=SUBTRACE ON 0=SUBTRACE OFF
*---------------------------------------------------------------------*
* *
* MODULE NAME: EZASVAS3 *
* *
* Copyright: Licensed Materials - Property of IBM *
* *
* "Restricted Materials of IBM" *
* *
* 5694-A01 *
* *
* Copyright IBM Corp. 2009 *
* *
* US Government Users Restricted Rights - *
* Use, duplication or disclosure restricted by *
* GSA ADP Schedule Contract with IBM Corp. *
* *
* Status: CSV1R11 *
* *
* MODULE FUNCTION: Test module for Extended Sockets. This module *
* accepts connection request from IMS client *
* program named EZAIMSC3. *
* *
* LANGUAGE: Assembler *
* *
* ATTRIBUTES: Non-reusable *
* *
* Change History: *
* *
* Flag Reason Release Date Origin Description *
* ---- -------- -------- ------ -------- --------------------------- *
* $Q1= D316.15 CSV1R5 020604 BKELSEY : Support 64K sockets *
* $F1= RBBASE CSV1R11 080612 Herr : Cleaned up >72 lines *
* *
*---------------------------------------------------------------------*
SOC0000 DS 0H
USING *,R15 Tell assembler to use reg 15
B SOC00100 Branch to startup address
DC CL14'SERVEREYECATCH'
ASIDENT DS 0F Address Space Identifier for initapi
ASTCPNAM DC CL8'TCPV3 ' Name of TCP/IP Address Space
ASCLNAME DC CL8'CALLSRVER' Our name as known to TCP/IP
TIMEOUT DS 0F Timeout value for select
TIMESEC DC F'180' Timeout value in seconds
TIMEMSEC DC F'0' Timeout value in milliseconds
BUFLEN EQU 1000 Set length of I/O buffers
R4BASE DC A(SOC0000+4096)
SOC00100 DS 0H Beginning of program
STM R14,R12,12(R13) Save callers registers
LR R3,R15 Move base reg to R3
L R4,R4BASE Add R4 as second base reg
DROP R15 Tell assembler to drop R15 as base
USING SOC0000,R3,R4 Tell assembler to use R3 and R4 as X
base registers
LA R6,SOCSTG Clear program storage
LA R7,SOCSTGL
SR R14,R14
SR R15,R15
MVCL R6,R14
ST R13,SOCSAVEH Save address of higher save area
LA R7,SOCSAVE Complete save area chain
ST R7,8(R13) Tell caller where our save area is
LA R13,SOCSAVE Point R13 at our save area
MVI ENDSW,X'00' Clear end-of-transmission switch
*
* Build message for console
*
MVC MSG1D,MSG1C Initialize first part of message
MVC MSGTD,=CL5'00000' Move subtask number from clientid
MVC MSG2D,MSG2CS Move 'Started' to message
LA R6,MSG Put text address in R6
MVC MSGLEN,=AL2(MSGTL) Put length of text in msg hdr.
MVC WTOLIST,WTOPROT Move prototype WTO to list form
WTO TEXT=(R6), Write message to operator X
MF=(E,WTOLIST)
*
* Issue INITAPI Call to connect to interface
*
MVC SOCTASKC,=CL8'TAS00000' Give subtask a name
MVC MSG2D,MSG2C00 Move 'INITAPI'to message
MVC MAXSOC,=AL2(50) Initialize MAXSOC parameter
*
CALL EZASOKET, X
(INITAPI,MAXSOC,ASIDENT,SOCTASKC,HISOC,ERRNO, X
RETCODE), X
VL
*
L R6,RETCODE Check for sucessful call
C R6,=F'0' Is it less than zero
BL SOCERR Yes, go display error and terminat
AIF (NOT &TRACE).TRACE00
* TRACE ENTRY FOR INITAPI TRACE TYPE = 0
LA R6,MSG Put text address in R6
MVC MSGLEN,=AL2(MSGTL) Put length of text in msg hdr.
WTO TEXT=(R6), Write message to operator X
MF=(E,WTOLIST)
.TRACE00 ANOP
*
* Issue SOCKET Call to obtain socket to listen on
*
MVC MSG2D,MSG2C25 Move 'SOCKET'to message
MVC AF,=F'2' Initialize AF to '2' (INET)
MVC SOCTYPE,=F'1' Specify stream sockets
MVC PROTO,=F'0' Protocol is ignored for stream
*
CALL EZASOKET, Issue SOCKET CALL X
(SOCKET,AF,SOCTYPE,PROTO,ERRNO,RETCODE), X
VL
*
L R6,RETCODE Check for sucessful call
C R6,=F'0' Is it less than zero
BL SOCERR Yes, go display error and terminate
AIF (NOT &TRACE).TRACE25
* TRACE ENTRY FOR SOCKET TRACE TYPE = 25
LA R6,MSG Put text address in R6
MVC MSGLEN,=AL2(MSGTL) Put length of text in msg hdr.
WTO TEXT=(R6), Write message to operator X
MF=(E,WTOLIST)
.TRACE25 ANOP
L R0,RETCODE Get descriptor number of socket
STH R0,LISTSOC Save it
*
* Issue GETHOSTID call to determine our internet address
*
MVC MSG2D,MSG2C07 Move 'GETHSTID'to message
*
CALL EZASOKET, Issue GETHOSTID Call X
(GETHSTID,RETCODE),VL
*
AIF (NOT &TRACE).TRACE07
* TRACE ENTRY FOR SOCKET TRACE TYPE = 07
LA R6,MSG Put text address in R6
MVC MSGLEN,=AL2(MSGTL) Put length of text in msg hdr.
WTO TEXT=(R6), Write message to operator X
MF=(E,WTOLIST)
.TRACE07 ANOP
L R0,RETCODE Get internet address of host
ST R0,SINETADR Save it
*
* Issue BIND call to establish port
*
MVC MSG2D,MSG2C02 Move 'BIND' to message
MVC SPORT,=H'5000' Move port number to structure
MVC SAF,=H'2' Move AF (INET) to structure
*
CALL EZASOKET, Issue BIND Call X
(BIND,LISTSOC,SOCKNAME,ERRNO,RETCODE), X
VL
L R6,RETCODE Check for sucessful call
C R6,=F'0' Is it less than zero
BL SOCERR Yes, go display error and terminat
*
AIF (NOT &TRACE).TRACE02
* TRACE ENTRY FOR BIND TRACE TYPE = 02
LA R6,MSG Put text address in R6
MVC MSGLEN,=AL2(MSGTL) Put length of text in msg hdr.
WTO TEXT=(R6), Write message to operator X
MF=(E,WTOLIST)
.TRACE02 ANOP
*
*
* Issue LISTEN call to establish backlog of connection requests
*
MVC MSG2D,MSG2C13 Move 'LISTEN' to message
MVC BACKLOG,=F'5' Set backlog to 5
*
CALL EZASOKET, Issue LISTEN Call X
(LISTEN,LISTSOC,BACKLOG,ERRNO,RETCODE),VL
L R6,RETCODE Check for sucessful call
C R6,=F'0' Is it less than zero
BL SOCERR Yes, go display error and terminate
*
AIF (NOT &TRACE).TRACE13
* TRACE ENTRY FOR LISTEN TRACE TYPE = 13
LA R6,MSG Put text address in R6
MVC MSGLEN,=AL2(MSGTL) Put length of text in msg hdr.
WTO TEXT=(R6), Write message to operator X
MF=(E,WTOLIST)
.TRACE13 ANOP
*
* Issue SELECT call to wait on connection request
*
MVC MSG2D,MSG2C19 Move 'SELECT' to message
MVC SELSOC,=F'31' Maximum number of sockets
MVC WSNDMASK,=F'0' Not checking for writes
MVC ESNDMASK,=F'0' Not checking for exceptions
LA R0,1 Put 1 in rightmost position of R0
LH R1,LISTSOC Put listener socket number in R1
SLL R0,0(R1) Create mask for read
ST R0,RSNDMASK Put value in mask field
*
CALL EZASOKET, Issue SELECT Call X
(SELECT,SELSOC,TIMEOUT,RSNDMASK,WSNDMASK,ESNDMASK, X
RRETMASK,WRETMASK,ERETMASK,ERRNO,RETCODE), X
VL
L R6,RETCODE Check for sucessful call
C R6,=F'0' Is it less than zero
BL SOCERR Yes, go display error and terminat
*
AIF (NOT &TRACE).TRACE19
* TRACE ENTRY FOR SELECT TRACE TYPE = 19
LA R6,MSG Put text address in R6
MVC MSGLEN,=AL2(MSGTL) Put length of text in msg hdr.
WTO TEXT=(R6), Write message to operator X
MF=(E,WTOLIST)
.TRACE19 ANOP
*
* Issue ACCEPT call to accept a new connection
*
MVC MSG2D,MSG2C01 Move 'ACCEPT' to message
MVC NS,=F'4' Use socket 4 for connection socket
*
CALL EZASOKET, Issue ACCEPT Call X
(ACCEPT,LISTSOC,SOCKNAME,ERRNO,RETCODE), X
VL
L R6,RETCODE Check for sucessful call
C R6,=F'0' Is it less than zero
BL SOCERR Yes, go display error and terminat
*
AIF (NOT &TRACE).TRACE01
* TRACE ENTRY FOR ACCEPT TRACE TYPE = 01
LA R6,MSG Put text address in R6
MVC MSGLEN,=AL2(MSGTL) Put length of text in msg hdr.
WTO TEXT=(R6), Write message to operator X
MF=(E,WTOLIST)
.TRACE01 ANOP
L R0,RETCODE Get descriptor number of new socket
STH R0,CONNSOC Save it for future use
*
* Issue READ call to get first message from client
*
LA R6,L'BUFFER Get length of buffer
ST R6,DATALEN Put length in data field
MVC MSG2D,MSG2C14 Move 'READ' to message
XC FLAGS,FLAGS Clear the FLAGS field
*
CALL EZASOKET, Issue READ Call X
(READ,CONNSOC,DATALEN,BUFFER,ERRNO,RETCODE),VL
L R6,RETCODE Check for sucessful call
C R6,=F'0' Is it less than zero
BL SOCERR Yes, go display error and terminat
*
AIF (NOT &TRACE).TRAC14A
* TRACE ENTRY FOR READ TRACE TYPE = 14
LA R6,MSG Put text address in R6
MVC MSGLEN,=AL2(MSGTL) Put length of text in msg hdr.
WTO TEXT=(R6), Write message to operator X
MF=(E,WTOLIST)
.TRAC14A ANOP
*
* Send Initial Message to client to continue transaction
*
MVC BUFFER(L'RESPMSG),RESPMSG Move Message to Buffer
LA R6,L'RESPMSG Get length of message
ST R6,DATALEN Put length in data field
XC FLAGS,FLAGS Clear FLAGS field
MVC MSG2D,MSG2C26 Move 'WRITE' to message
*
CALL EZASOKET, Issue WRITE call X
(WRITE,CONNSOC,DATALEN,BUFFER,ERRNO,RETCODE),VL
*
L R6,RETCODE Check for sucessful call
C R6,=F'0' Is it less than zero
BL SOCERR Yes, go display error and terminat
AIF (NOT &TRACE).TRAC26A
* TRACE ENTRY FOR WRITE TRACE TYPE = 22
LA R6,MSG Put text address in R6
MVC MSGLEN,=AL2(MSGTL) Put length of text in msg hdr.
WTO TEXT=(R6), Write message to operator X
MF=(E,WTOLIST)
.TRAC26A ANOP
SOC0300 DS 0H
*
* Read Message from Client
*
MVC MSG2D,MSG2C14 Move 'READ' to message
LA R0,L'BUFFER Get length of buffer
ST R0,DATALEN Use it for data length
XC FLAGS,FLAGS Clear FLAGS field
*
CALL EZASOKET, X
(READ,CONNSOC,DATALEN,BUFFER,ERRNO,RETCODE),VL
*
L R6,RETCODE Check for sucessful call
C R6,=F'0' Is it less than zero
BNH SOCERR Yes, go display error and terminat
AIF (NOT &TRACE).TRAC14B
* TRACE ENTRY FOR RECV TRACE TYPE = 14
LA R6,MSG Put text address in R6
MVC MSGLEN,=AL2(MSGTL) Put length of text in msg hdr.
WTO TEXT=(R6), Write message to operator X
MF=(E,WTOLIST)
.TRAC14B ANOP
CLC BUFFER(3),=CL3'END' Was this last record
BNE SOC0350 No
MVI ENDSW,C'E' Yes, set end-of-transmission switch
SOC0350 DS 0H
*
* Send Response to Client
*
MVC MSG2D,MSG2C26 Move 'WRITE' to message
MVC DATALEN,RETCODE Get message length from previous call
XC FLAGS,FLAGS Clear FLAGS field
*
CALL EZASOKET, X
(WRITE,CONNSOC,DATALEN,BUFFER,ERRNO,RETCODE),VL
*
L R6,RETCODE Check for sucessful call
C R6,=F'0' Is it less than zero
BNH SOCERR Yes, go display error and terminat
AIF (NOT &TRACE).TRAC26B
* TRACE ENTRY FOR SEND TRACE TYPE = 26
LA R6,MSG Put text address in R6
MVC MSGLEN,=AL2(MSGTL) Put length of text in msg hdr.
WTO TEXT=(R6), Write message to operator X
MF=(E,WTOLIST)
.TRAC26B ANOP
*
CLI ENDSW,C'E' Have we received last record
BNE SOC0300 No, so go back and do another
*
* Close sockets
*
MVC MSG2D,MSG2C03 Move 'CLOSE1' to message
*
CALL EZASOKET, Issue CLOSE call for connection skt X
(CLOSE,CONNSOC,ERRNO,RETCODE),VL
*
L R6,RETCODE Check for sucessful call
C R6,=F'0' Is it less than zero
BL SOCERR Yes, go display error and terminat
AIF (NOT &TRACE).TRACE03
* TRACE ENTRY FOR CLOSE TRACE TYPE = 3
LA R6,MSG Put text address in R6
MVC MSGLEN,=AL2(MSGTL) Put length of text in msg hdr.
WTO TEXT=(R6), Write message to operator X
MF=(E,WTOLIST)
.TRACE03 ANOP
*
MVC MSG2D,MSG2C03A Move 'CLOSE2' to message
*
CALL EZASOKET, Issue CLOSE call for listen socket X
(CLOSE,LISTSOC,ERRNO,RETCODE),VL
*
L R6,RETCODE Check for sucessful call
C R6,=F'0' Is it less than zero
BL SOCERR Yes, go display error and terminat
AIF (NOT &TRACE).TRAC103
* TRACE ENTRY FOR CLOSE TRACE TYPE = 3
LA R6,MSG Put text address in R6
MVC MSGLEN,=AL2(MSGTL) Put length of text in msg hdr.
WTO TEXT=(R6), Write message to operator X
MF=(E,WTOLIST)
.TRAC103 ANOP
*
* Terminate Connection to API
*
CALL EZASOKET, X
(TERMAPI),VL
*
* Issue console message for task termination
*
MVC MSG2D,MSG2CE Move 'Ended' to message
LA R6,MSG Put text address in R6
MVC MSGLEN,=AL2(MSGTL) Put length of text in msg hdr.
WTO TEXT=(R6), Write message to operator X
MF=(E,WTOLIST)
*
* Return to Caller
*
L R13,SOCSAVEH
LM R14,R12,12(R13)
BR R14
*
* Write error message to operator
*
SOCERR DS 0H Write error message to operator
MVC ERR1D,MSG1D 'SERVER, TASK #'
MVC ERRTD,MSGTD Move task number to message
MVC ERR2D,MSG2D Call Type
MVC ERR3D,ERR3C ' RETCODE= '
MVI ERR3S,C'-' Move sign which is always minus
MVC ERR5D,ERR5C ' ERRNO= '
L R6,RETCODE Get return code value
CVD R6,DWORK Convert it to decimal
UNPK ERR4D,DWORK+4(4) Unpack it
OI ERR4D+6,X'F0' Correct the sign
L R6,ERRNO Get errno value
CVD R6,DWORK Convert it to decimal
UNPK ERR6D,DWORK+4(4) Unpack it
OI ERR6D+6,X'F0' Correct the sign
LA R6,ERR Put text address in R6
MVC ERRLEN,=AL2(ERRTL) Put length of text in msg hdr.
WTO TEXT=(R6), Write message to operator X
MF=(E,WTOLIST)
*
* Return to Caller
*
* L R13,SOCSAVEH
* LM R14,R12,12(R13)
* BR R14
ABEND DS 0H
DC H'0' Force ABEND
*---------------------------------------------------------------------*
* Constants *
*---------------------------------------------------------------------*
WTOPROT WTO TEXT=, List form of WTO Macro X
MF=L
WTOPROTL EQU *-WTOPROT Length of WTO Prototype
MSG1C DC CL17'SERVER, TASK # '
MSG2CS DC CL8' STARTED'
MSG2CE DC CL8' ENDED '
ERR3C DC CL10' RETCODE= '
ERR5C DC CL8' ERRNO= '
MSG2C00 DC CL8' INITAPI'
MSG2C01 DC CL8' ACCEPT '
MSG2C02 DC CL8' BIND '
MSG2C03 DC CL8' CLOSE '
MSG2C03A DC CL8' CLOSE2 '
MSG2C07 DC CL8' GTHSTID'
MSG2C13 DC CL8' LISTEN '
MSG2C14 DC CL8' READ '
MSG2C19 DC CL8' SELECT '
MSG2C25 DC CL8' SOCKET '
MSG2C26 DC CL8' WRITE '
MSG2C32 DC CL8' TAKESKT'
RESPMSG DC CL50'FIRST RESPONSE FROM SERVER '
*---------------------------------------------------------------------*
* Constants used for call types *
*---------------------------------------------------------------------*
INITAPI DC CL16'INITAPI'
BIND DC CL16'BIND'
LISTEN DC CL16'LISTEN'
ACCEPT DC CL16'ACCEPT'
READ DC CL16'READ'
SELECT DC CL16'SELECT'
WRITE DC CL16'WRITE'
SOCKET DC CL16'SOCKET'
CLOSE DC CL16'CLOSE'
GETHSTID DC CL16'GETHOSTID'
TERMAPI DC CL16'TERMAPI'
*---------------------------------------------------------------------*
* Program Storage Area *
*---------------------------------------------------------------------*
SOCSTG DS 0F PROGRAM STORAGE
SOCSAVE DS 0F Save Area
SOCSAVE1 DS F Word for high-level languages
SOCSAVEH DS F Address of previous save area
SOCSAVEL DS F Address of next save area
SOCSAV14 DS F Reg 14
SOCSAV15 DS F Reg 15
SOCSAV0 DS F Reg 0
SOCSAV1 DS F Reg 1
SOCSAV2 DS F Reg 2
SOCSAV3 DS F Reg 3
SOCSAV4 DS F Reg 4
SOCSAV5 DS F Reg 5
SOCSAV6 DS F Reg 6
SOCSAV7 DS F Reg 7
SOCSAV8 DS F Reg 8
SOCSAV9 DS F Reg 9
SOCSAV10 DS F Reg 10
SOCSAV11 DS F Reg 11
SOCSAV12 DS F Reg 12
SOCSAV13 DS F Reg 13
PARMADDR DS F Address of parameter list
GWAADDR DS F Address of Global Work Area
TIEADDR DS F Address of Task Information Element
LISTSOC DS H Socket number used for listen
CONNSOC DS H Socket number created by accept
SOCMSGN DS F Number of messages to be exchanged
SOCMSGL DS F Length of messages to be exchanged
SOCTASKC DS CL8 Character task identifier
HISOC DS F Highest socket descriptor available
SERVLEN DS H
SERVSOC DS 0F Socket Address of Server
SERVAF DS H Address Family of Server = 2
SERVPORT DS H Port Address of Server
SERVIADD DS F Internet Address of Server
ENDSW DS C End of transmission switch
MSG DS 0F Message area
MSGLEN DS H Length of message
MSG1D DS CL17 'SERVER, TASK #'
MSGTD DS CL5 Task Number
MSG2D DS CL8 Last part of message
MSGE EQU * End of message
MSGTL EQU MSGE-MSG1D Length of message text
ERR DS 0F Error message area
ERRLEN DS H Length of message
ERR1D DS CL17 'SERVER, TASK #'
ERRTD DS CL5 Task Number
ERR2D DS CL8 Last part of message
ERR3D DS CL10 ' RETCODE = '
ERR3S DS C Sign which is always -
ERR4D DS CL7 Return code
ERR5D DS CL8 ' ERRNO ='
ERR6D DS CL7 Error number
ERRE EQU * End of message
ERRTL EQU ERRE-ERR1D Length of message text
*---------------------------------------------------------------------*
* Name structure used by bind *
*---------------------------------------------------------------------*
SOCKNAME DS 0F Socket Name structure
SAF DS H The address family of the socket
SPORT DS H The port number of this socket
SINETADR DS F The internet address of this socket
DS D Reserved
SOCKNAML EQU *-SOCKNAME Length of SOCKNAME Structure
CLIENTID DS 0F Client Id structure
CDOMAIN DS F The domain of this client (2)
CNAME DS CL8 The major name of this client
CSUBTASK DS CL8 The minor (subtask) name of this X
client
DS D Reserved
CLIENTL EQU *-CLIENTID
BUFFER DS CL(BUFLEN) Socket I/O Buffer
DATALEN DS F Length of buffer data
DWORK DS D Double word work area
SENDINT DS D Time interval for send
RECNO DS PL4 Record Number
AF DS F Address family for socket call
NS DS F New socket number for socket call
SOCTYPE DS F Socket type for socket call
PROTO DS F Protocol for socket call
ERRNO DS F Error number returned from call
RETCODE DS F Return code from call
CINADDR DS F Internet address of client
CPORT DS F Port number of client
MAXSOC DS H Maximum # sockets for INITAPI
SELSOC DS F Maximum # sockets for SELECT
BACKLOG DS F Backlog value for LISTEN
FLAGS DS F FLAGS field for RECV and RECVFROM
RSNDMASK DS F Read send mask for select
WSNDMASK DS F Write send mask for select
ESNDMASK DS F Exception send mask for select
RRETMASK DS F Read return mask for select
WRETMASK DS F Write return mask for select
ERETMASK DS F Exception return mask for select
WTOLIST DS CL(WTOPROTL) List form of WTO Macro
EZASMTI EZASMI TYPE=TASK, X
STORAGE=CSECT Generate task storage for interface
EZASMGW EZASMI TYPE=GLOBAL, Storage definition for GWA X
STORAGE=CSECT
SOCSTGE EQU * End of Program Storage
SOCSTGL EQU SOCSTGE-SOCSTG Length of Program Storage
LTORG
R0 EQU 0
R1 EQU 1
R2 EQU 2
R3 EQU 3
R4 EQU 4
R5 EQU 5
R6 EQU 6
R7 EQU 7
R8 EQU 8
R9 EQU 9
R10 EQU 10
R11 EQU 11
R12 EQU 12
R13 EQU 13
R14 EQU 14
R15 EQU 15
GWABAR EQU 13
END
Figure 1. Sample of IMS program
as a server
z/OS Communications Server: IP IMS Sockets Guide
Copyright IBM Corporation 1990, 2014