EZASOKAS CSECT
EZASOKAS AMODE ANY
EZASOKAS RMODE ANY
* PRINT NOGEN
***********************************************************************
* *
* MODULE NAME: EZASOKAS Sample server program *
* *
* Copyright: Licensed Materials - Property of IBM *
* *
* "Restricted Materials of IBM" *
* *
* 5694-A01 *
* *
* (C) Copyright IBM Corp. 1977, 2003 *
* *
* US Government Users Restricted Rights - *
* Use, duplication or disclosure restricted by *
* GSA ADP Schedule Contract with IBM Corp. *
* *
* Status: CSV1R5 *
* *
* *
* LANGUAGE: Assembler *
* *
* ATTRIBUTES: NON-REUSABLE *
* *
* REGISTER USAGE: *
* R1 = *
* R2 = *
* R3 = BASE REG 1 *
* R4 = BASE REG 2 (UNUSED) *
* R5 = FUTURE BASE REG? *
* R6 = TEMP *
* R7 = RETURN REG *
* R8 = *
* R9 = A(WORK AREA) *
* R10 = *
* R11 = *
* R12 = *
* R13 = SAVE AREA *
* R14 = *
* R15 = *
* *
* INPUT: NONE *
* OUTPUT: WTO results of each test case *
* *
***********************************************************************
GBLB &TRACE ASSEMBLER VARIABLE TO CONTROL TRACE GENERATION
&TRACE SETB 1 1=TRACE ON 0=TRACE OFF
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
*---------------------------------------------------------------------*
* START OF EXECUTABLE CODE *
*---------------------------------------------------------------------*
USING *,R3,R4 TELL ASSEMBLER OF OTHERS
SAVE (14,12),T,*
LR R3,R15 COPY EP REG TO FIRST BASE
LA R5,2048 GET R5 HALFWAY THERE
LA R5,2048(R5) GET R5 THERE
LA R4,0(R5,R3) GET R4 THERE
LA R12,12 JUST FOR FUN!
ST R1,PARMADDR SAVE ADDRESS OF PARAMETER LIST
L R1,0(R1) GET POINTER
LH R1,0(R1) GET LENGTH
* STC R1,TRACE USE IT AS FLAG
L R7,=A(SOCSAVE) GET NEW SAVE AREA
ST R7,8(R13) SAVE ADDRESS OF NEW SAVE AREA
ST R13,4(R7) COMPLETE SAVE AREA CHAIN
LR R13,R7 NOW SWAP THEM
L R9,=A(MYCB) POINT TO THE CONTROL BLOCK
USING MYCB,R9 TELL ASSEMBLER
*---------------------------------------------------------------------*
* BUILD MESSAGE FOR CONSOLE
*---------------------------------------------------------------------*
* INITIALIZE MESSAGE TEXT FIELDS
LOOP EQU *
MVC MSGNUM(8),SUBTASK WHO I AM
MVC TYPE,MSGSTART MOVE 'STARTED' TO MESSAGE
*
MVC MSGRSLT1,MSGSUCC ...SUCCESSFUL TEXT
MVC MSGRSLT2,BLANK35
*
STM R14,R12,12(R13) JUST FOR DEBUGGING
BAL R14,WTOSUB --> DO STARTING WTO
***********************************************************************
* *
* Issue INITAPI to connect to interface *
* *
***********************************************************************
POST ECB,1 NEXT IS ALWAYS SYNCH
MVI SYNFLAG,1 MOVE A 1 FOR ASYNC
MVC TYPE,MINITAPI MOVE 'INITAPI' TO MESSAGE
*
EZASMI TYPE=INITAPI, Issue INITAPI Macro X
SUBTASK=SUBTASK, SPECIFY SUBTASK IDENTIFIER X
MAXSOC=MAXSOC, SPECIFY MAXIMUM NUMBER OF SOCKETS X
MAXSNO=MAXSNO, (HIGHEST SOCKET NUMBER ASSIGNED) X
ERRNO=ERRNO, (Specify ERRNO field) X
RETCODE=RETCODE, (Specify RETCODE field) X
APITYPE=APITYPE, (SPECIFY APITYPE FIELD) X
ERROR=ERROR, ABEND IF ERROR ON MACRO X
ASYNC=('EXIT',MYEXIT) (SPECIFY AN EXIT)
* IDENT=IDENT, TCP ADDR SPACE AND MY ADDR SPACE
* ASYNC=('ECB') (SPECIFY ECBS)
*
BAL R14,RCCHECK --> DID IT WORK?
***********************************************************************
* *
* Issue SOCKET Macro to obtain a socket descriptor *
* *** INET and STREAM *** *
* *
***********************************************************************
MVC TYPE,MSOCKET MOVE 'SOCKET' TO MESSAGE
*
EZASMI TYPE=SOCKET, Issue SOCKET Macro X
AF='INET', INET or IUCV X
SOCTYPE='STREAM', STREAM(TCP) DATAGRAM(UDP) or RAW X
ERRNO=ERRNO, (Specify ERRNO field) X
RETCODE=RETCODE, (Specify RETCODE field) X
REQAREA=REQAREA, IN CASE WE ARE DOING EXITS OR ECBS X
ERROR=ERROR Abend if Macro error
*
BAL R14,RCCHECK CHECK FOR SUCCESSFUL CALL
*
*---------------------------------------------------------------------*
* Get socket descriptor number
*---------------------------------------------------------------------*
STH R8,S SAVE RETCODE (=SOCKET DESCRIPTOR)
***********************************************************************
* *
* ISSUE GETHOSTID CALL *
* *
***********************************************************************
MVC TYPE,=CL8'GETHOSTI' 'GETHOSTI' TO MESSAGE
EZASMI TYPE=GETHOSTID,RETCODE=RETCODE,ERRNO=ERRNO, X
REQAREA=REQAREA IN CASE WE ARE DOING EXITS OR ECBS
BAL R14,RCCHECK CHECK FOR SUCCESSFUL CALL
ST R8,ADDR SAVE OUR ID
***********************************************************************
* *
* Issue BIND socket *
* *
***********************************************************************
MVC TYPE,MBIND MOVE 'BIND' TO MESSAGE
MVC PORT(2),PORTS Load STREAM port #
MVC ADDRESS(4),ADDR Load MVS1 internet address
*
EZASMI TYPE=BIND, Issue Macro X
S=S, STREAM X
NAME=NAME, (SOCKET NAME STRUCTURE) X
ERRNO=ERRNO, (Specify ERRNO field) X
RETCODE=RETCODE, (Specify RETCODE field) X
REQAREA=REQAREA, IN CASE WE ARE DOING EXITS OR ECBS X
ERROR=ERROR Abend if Macro error
*
BAL R14,RCCHECK CHECK FOR SUCCESSFUL CALL
***********************************************************************
* *
* Issue LISTEN - Backlog = 5 *
* *
***********************************************************************
MVC TYPE,MLISTEN MOVE 'LISTEN' TO MESSAGE
*
EZASMI TYPE=LISTEN, Issue Macro X
S=S, STREAM X
BACKLOG=BACKLOG, BACKLOG X
ERRNO=ERRNO, (Specify ERRNO field) X
RETCODE=RETCODE, (Specify RETCODE field) X
REQAREA=REQAREA, IN CASE WE ARE DOING EXITS OR ECBS X
ERROR=ERROR Abend if Macro error
*
BAL R14,RCCHECK CHECK FOR SUCCESSFUL CALL
***********************************************************************
* *
* Issue ACCEPT - Block until connection from peer *
* *
***********************************************************************
MVC TYPE,MACCEPT MOVE 'ACCEPT' TO MESSAGE
MVC PORT(2),PORTS Load STREAM port #
MVC ADDRESS(4),ADDR Load MVS1 internet address
*
EZASMI TYPE=ACCEPT, Issue Macro X
S=S, STREAM X
NAME=NAME, (SOCKET NAME STRUCTURE) X
ERRNO=ERRNO, (Specify ERRNO field) X
RETCODE=RETCODE, (Specify RETCODE field) X
REQAREA=REQAREA, IN CASE WE ARE DOING EXITS OR ECBS X
ERROR=ERROR Abend if Macro error
*
BAL R14,RCCHECK CHECK FOR SUCCESSFUL CALL
* Message RESULTS text
STH R8,SOCDESCA SAVE RETCODE (SOCKET DESCRIPTOR)
***********************************************************************
* *
* Issue READ - Read data and store in buffer *
* *
***********************************************************************
MVC TYPE,MREAD MOVE 'READ ' TO MESSAGE
*
EZASMI TYPE=READ, Issue Macro X
S=SOCDESCA, ACCEPT SOCKET X
NBYTE=NBYTE, SIZE OF BUFFER X
BUF=BUF, (BUFFER) X
ERRNO=ERRNO, (Specify ERRNO field) X
RETCODE=RETCODE, (Specify RETCODE field) X
REQAREA=REQAREA, IN CASE WE ARE DOING EXITS OR ECBS X
ERROR=ERROR Abend if Macro error
*
BAL R14,RCCHECK CHECK FOR SUCCESSFUL CALL
MVC MSGRSLT1,MSGBUFF
MVC MSGRSLT2,BUF
BAL R14,WTOSUB --> PRINT IT
*
*
***********************************************************************
* *
* Issue WRITE - Write data from buffer *
* *
***********************************************************************
MVC TYPE,MWRITE MOVE 'WRITE ' TO MESSAGE
*
EZASMI TYPE=WRITE, Issue Macro X
S=SOCDESCA, ACCEPT Socket X
NBYTE=NBYTE, SIZE OF BUFFER X
BUF=BUF, (BUFFER) X
ERRNO=ERRNO, (Specify ERRNO field) X
RETCODE=RETCODE, (Specify RETCODE field) X
REQAREA=REQAREA, IN CASE WE ARE DOING EXITS OR ECBS X
ERROR=ERROR Abend if Macro error
*
BAL R14,RCCHECK CHECK FOR SUCCESSFUL CALL
***********************************************************************
* *
* Issue CLOSE for ACCEPT socket *
* *
***********************************************************************
MVC TYPE,MCLOSE MOVE 'CLOSE' TO MESSAGE
*
EZASMI TYPE=CLOSE, Issue Macro X
S=SOCDESCA, ACCEPT X
ERRNO=ERRNO, (Specify ERRNO field) X
RETCODE=RETCODE, (Specify RETCODE field) X
REQAREA=REQAREA, IN CASE WE ARE DOING EXITS OR ECBS X
ERROR=ERROR Abend if Macro error
*
MVC MSGRSLT2,BLANK35
BAL R14,RCCHECK CHECK FOR SUCCESSFUL CALL
*
***********************************************************************
* *
* Terminate Connection to API *
* *
***********************************************************************
MVC TYPE,MTERMAPI MOVE 'TERMAPI' TO MESSAGE
*
POST ECB,1 FOLLOWING IS ALWAYS SYNCH
EZASMI TYPE=TERMAPI Issue EZASMI Macro for Termapi
*---------------------------------------------------------------------*
* Message RESULTS text
MVC MSGRSLT2,BLANK35
*
BAL R14,RCCHECK --> CHECK RC
*---------------------------------------------------------------------*
* Issue console message for task termination
*---------------------------------------------------------------------*
MVC TYPE,MSGEND Move 'ENDED' to message
*
MVC MSGRSLT1,MSGSUCC ...SUCCESSFUL text
MVC MSGRSLT2,BLANK35
*
BAL R14,WTOSUB
LA R14,1 CONSTANT
AH R14,APITYPE ADD
STH R14,APITYPE STORE
CH R14,=H'3' COMPARE
* BE LOOP --> LETS DO IT AGAIN!
*---------------------------------------------------------------------*
* Return to Caller
*---------------------------------------------------------------------*
L R13,4(R13)
RETURN (14,12),T,RC=0
WTOSUB EQU *
LR R7,R14 COPY RETURN REG
MVC MSGCMD(8),TYPE
WTO TEXT=MSG WRITE MESSAGE TO OPERATOR
BR R7 --> RETURN TO CALLER
CNOP 2,4
* USES R6,R7,R8 RETCODE RETURNED IN R8
RCCHECK EQU *
LR R7,R14 COPY TO REAL RETURN REG
MVC MSGRSLT1,MSGSUCC ...SUCCESS TEXT
L R6,RETCODE
LTR R6,R6
BM NOWAIT
CLI SYNFLAG,0 PLAIN CASE?
BE NOWAIT --> SKIP IT
MVC KEY+14(8),SUBTASK
MVC KEY+23(8),TYPE
KEY WTO 'WAIT: XXXXXXXX XXXXXXXX'
WAIT ECB=ECB
NOWAIT EQU *
* LA R15,ECB
* ST R15,ECB
ST R9,ECB MAKE THIS THE TOKEN AGAIN
L R6,RETCODE CHECK FOR SUCCESSFUL CALL
CLC TYPE,=CL8'GETHOSTI'
BE HOSTIDRC HANDLE PRINTING HOST ID
LTR R8,R6 SAVE A COPY
*
BNL CONT00
FAILMSG EQU *
MVC MSGRSLT1,MSGFAIL ...FAIL TEXT
CONT00 EQU *
*
*---------------------------------------------------------------------*
* FORMAT THE RETCODE= -XXXXXXX ERRNO= XXXXXXX MSG RESULTS
* ***> R6 = RETCODE VALUE ON ENTRY
*---------------------------------------------------------------------*
MVC MSGRTCT,MSGRETC ' RETCODE= '
MVI MSGRTCS,C'+'
LTR R6,R6
BNM NOTM -->
MVI MSGRTCS,C'-' MOVE SIGN WHICH IS ALWAYS MINUS
NOTM EQU *
MVC MSGERRT,MSGERRN ' ERRNO= '
*
CVD R6,DWORK CONVERT IT TO DECIMAL
UNPK MSGRTCV,DWORK+4(4) UNPACK IT
OI MSGRTCV+6,X'F0' CORRECT THE SIGN
ERRNOFMT EQU *
L R6,ERRNO GET ERRNO VALUE
CVD R6,DWORK CONVERT IT TO DECIMAL
UNPK MSGERRV,DWORK+4(4) UNPACK IT
OI MSGERRV+6,X'F0' CORRECT THE SIGN
*
MVC MSGRSLT2(35),MSGRTCD
*
MVI MSGRTHX,X'40' CLEAR HEX INDICATOR
SR R6,R6 CLEAR OUT...
ST R6,RETCODE RETCODE AND...
ST R6,ERRNO ERRNO
*
*
CLI TRACE,0
BNE NOTRACE
LR R14,R7 GIVE HIM RETURN REG
B WTOSUB --> DO WTO
NOTRACE EQU *
BR R7 --> RETURN TO CALLER
*
HOSTIDRC EQU * VALID HOSTID MAY LOOK LIKE NEG. RC
C R6,=F'-1' ONLY -1 RC INDICATES FAILURE
BE FAILMSG ...BAD RC, USE STANDARD MSG
LR R8,R6 ...NEXT CALL EXPECTS ADDR IN R8
MVC MSGRSLT1,MSGSUCC ...SUCCESS TEXT
UNPK HEXRC(9),RETCODE(5) PLUS ONE FOR FAKE SIGN
TR HEXRC(8),HEXTAB ...CONVERT UNPK TO PRINTABLE HEX
MVI HEXRC+8,X'40' ...SPACE OUT FAKED SIGN BYTE
MVI MSGRTHX,C'X' ...INDICATE INFO IS HEX
B ERRNOFMT
*
SYNFLAG DC H'0' DEFAULT TO SYN
TRACE DC H'0' DEFAULT TO TRACE
MYEXIT DC A(MYEXIT1,SUBTASK)
MYEXIT1 SAVE (14,12),T,*
LR R2,R15
USING MYEXIT1,R2
LM R8,R9,0(R1) GET TWO TOKENS
MVC EXKEY+14(8),0(R8) TELL WHO
MVC EXKEY+23(8),TYPE TELL WHAT
EXKEY WTO 'EXIT: XXXXXXXX XXXXXXXX'
POST ECB,1
RETURN (14,12),T,RC=0
DROP R2
*---------------------------------------------------------------------*
* ABEND PROGRAM AND GET DUMP
*---------------------------------------------------------------------*
ERROR ABEND 1,DUMP
*---------------------------------------------------------------------*
* CONSTANTS USED TO RUN PROGRAM *
*---------------------------------------------------------------------*
EZASMGW EZASMI TYPE=GLOBAL, Storage definition for GWA X
STORAGE=CSECT
*---------------------*
* INITAPI macro parms *
*---------------------*
SUBTASK DC CL8'EZASOKAS' SUBTASK PARM VALUE
MAXSOC DC AL2(50) MAXSOC PARM VALUE
APITYPE DC H'2' OR A 3
MAXSNO DC F'0' (HIGHEST SOCKET DESCRIPTOR AVAILABLE)
IDENT DC 0CL16' '
DC CL8' ' NAME OF TCP TO WHICH CONNECTING
DC CL8'SOC401CB' MY ADDR SPACE NAME
*---------------------------------------------------------------------*
* SOCKET macro parms *
*--------------------*
S DC H'0' SOCKET DESCRIPTOR FOR STREAM
*---------------------------------------------------------------------*
* BIND MACRO PARMS *
*--------------------*
CNOP 0,4
NAME DC 0CL16' ' SOCKET NAME STRUCTURE
DC AL2(2) FAMILY
PORT DC H'0'
ADDRESS DC F'0'
DC XL8'00' RESERVED
ADDR DC AL1(14),AL1(0),AL1(0),AL1(0) Internet Address
PORTS DC H'11007'
*---------------------------------------------------------------------*
* LISTEN PARMS *
*--------------------*
BACKLOG DC F'5' BACKLOG
*---------------------------------------------------------------------*
* READ MACRO PARMS *
*--------------------*
NBYTE DC F'50' SIZE OF BUFFER
SOCDESCA DC H'0' SOCKET DESCRIPTOR FROM ACCEPT
BUF DC CL50' THIS SHOULD NEVER APPEAR!!! :-('
*---------------------------------------------------------------------*
* WTO FRAGMENTS *
*---------------*
MINITAPI DC CL8'INITAPI'
MSOCKET DC CL8'SOCKET'
MBIND DC CL8'BIND'
MACCEPT DC CL8'ACCEPT'
MLISTEN DC CL8'LISTEN'
MREAD DC CL8'READ'
MWRITE DC CL8'WRITE'
MCLOSE DC CL8'CLOSE'
MTERMAPI DC CL8'TERMAPI'
MSGSTART DC CL8' STARTED'
MSGEND DC CL8' ENDED '
MSGBUFF DC CL10' BUFFER: ' ...
MSGSUCC DC CL10' SUCCESS ' Command results...
MSGFAIL DC CL10' FAIL: ( ' ...
MSGRETC DC CL10' RETCODE= ' ...
MSGERRN DC CL10' ERRNO= ' ...
BLANK35 DC CL35' '
*---------------------------------------------------------------------*
* ERROR NUMBER / RETURN CODE FIELDS *
*-----------------------------------*
*---------------------------------------------------------------------*
* MESSAGE AREA *
*--------------*
MSG DC 0F'0' MESSAGE AREA
DC AL2(MSGE-MSGNUM) LENGTH OF MESSAGE
MSGNUM DC CL10'EZASOKAS:' 'EZASOKASXX:'
MSGCMD DC CL8' ' COMMAND ISSUED
MSGRSLT1 DC CL10' ' COMMAND RESULTS (SUCC, PASS, FAIL)
MSGRSLT2 DC CL35' ' RETURNED VALUES
MSGE EQU * End of message
*---------------------------------------------------------------------*
* MESSAGE RESULTS AREAS (fill in and move to MSGRSLT2) *
*------------------------------------------------------*
MSGRTCD DC 0CL35' ' GENERAL RETURNED VALUE
MSGRTCT DC CL9' RETCODE=' ' RETCODE= '
MSGRTHX DC CL1' ' 'X' X FOR GETHOSTID
MSGRTCS DC CL1' ' '-' (NEGATIVE SIGN)
HEXRC EQU MSGRTCS HEX RC WILL START AT SIGN LOCATION
MSGRTCV DC CL7' ' RETURNED VALUE (RETCODE)
MSGERRT DC CL10' ERRNO=' ' ERRNO= '
MSGERRV DC CL7' ' RETURNED VALUE (ERRNO)
*---------------------------------------------------------------------*
PARMADDR DC A(0) PARM ADDRESS SAVE AREA
DWORK DC D'0' WORK AREA
HEXTAB EQU *-240 TAB TO CONVERT TO PRINTABLE HEX
* FIRST 240 BYTES NOT REFERENCED
DC CL16'0123456789ABCDEF'
LTORG ,
*---------------------------------------------------------------------*
*---------------------------------------------------------------------*
* REG/SAVEAREA *
*--------------*
SOCSAVE DC 9D'0' SAVE AREA
CNOP 0,8
MYCB EQU * MY CONTROL BLOCK
REQAREA EQU *
ECB DC A(ECB) SELF POINTER
DC CL100'WORK AREA'
MYTIE EZASMI TYPE=TASK,STORAGE=CSECT TIE
TYPE DC CL8'TYPE'
ERRNO DC F'0'
RETCODE DC F'0'
MYNEXT DC A(MYCB) NEXT IN CHAIN FOR MULTIPLES
CNOP 0,8
MYLEN EQU *-MYCB
MYCB2 EQU *
ORG *+MYLEN
CNOP 0,8
DC CL8'&SYSDATE'
DC CL8'&SYSTIME'
END
Figure 1. EZASOKAS sample server program for IPv4
z/OS Communications Server: IP Sockets Application Programming Interface Guide and Reference
Copyright IBM Corporation 1990, 2014