EZASO6AS CSECT
EZASO6AS AMODE ANY
EZASO6AS RMODE ANY
* PRINT NOGEN
***********************************************************************
* *
* MODULE NAME: EZASO6AS Sample IPV6 server program *
* *
* Copyright: Licensed Materials - Property of IBM *
* *
* "Restricted Materials of IBM" *
* *
* 5694-A01 *
* *
* (C) Copyright IBM Corp. 2002, 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,0 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
* ASYNC=('EXIT',MYEXIT), (SPECIFY AN EXIT) X
* 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='INET6', INET, IUCV, INET6 X
SOCTYPE='STREAM', STREAM(TCP) DATAGRAM(UDP) or RAW X
ERRNO=ERRNO, (Specify ERRNO field) X
RETCODE=RETCODE, (Specify RETCODE field) X
ERROR=ERROR Abend if Macro error
* REQAREA=REQAREA, IN CASE WE ARE DOING EXITS OR ECBS X
*
BAL R14,RCCHECK CHECK FOR SUCCESSFUL CALL
*
*---------------------------------------------------------------------*
* Get socket descriptor number
*---------------------------------------------------------------------*
STH R8,S SAVE RETCODE (=SOCKET DESCRIPTOR)
***********************************************************************
* *
* ISSUE PTON MACRO *
* *
***********************************************************************
MVC PRESENTABLE_ADDR,LOOPIPV6 IP ADDRESS TO CONVERT
*
* DISPLAY THE RETURNED ADDRESS IN PRESENTABLE FORMAT
*
MVC TYPE,MPTON MOVE 'PTON ' TO MESSAGE
*
EZASMI TYPE=PTON, ISSUE PTON MACRO X
AF='INET6', X
SRCADDR=PRESENTABLE_ADDR, X
SRCLEN=PRESENTABLE_ADDR_LEN, X
DSTADDR=NUMERIC_ADDR, X
ERRNO=ERRNO, (SPECIFY ERRNO FIELD) X
RETCODE=RETCODE, (SPECIFY RETCODE FIELD) X
ERROR=ERROR ABEND IF MACRO ERROR
*
BAL R14,RCCHECK CHECK FOR SUCCESSFUL CALL
MVC ADDRESS,NUMERIC_ADDR
***********************************************************************
* *
* ISSUE GETHOSTNAME CALL *
* *
***********************************************************************
MVC TYPE,MGHOSTN 'GETHOSTN' TO MESSAGE
EZASMI TYPE=GETHOSTNAME, X
NAMELEN=HOSTNAMEL, LENGTH OF HOST NAME FIELD X
NAME=HOSTNAME, HOST NAME X
ERRNO=ERRNO, (Specify ERRNO field) X
RETCODE=RETCODE, (Specify RETCODE field) X
ERROR=ERROR Abend if Macro error
* REQAREA=REQAREA, IN CASE WE ARE DOING EXITS OR ECBS X
*
BAL R14,RCCHECK CHECK FOR SUCCESSFUL CALL
*
MVC MSGRSLT1,=C'HOST NAME ' INDICATE WHAT WE'RE PROCESSING
XC MSGRSLT2,MSGRSLT2
MVC MSGRSLT2,HOSTNAME
STM R14,R12,12(R13) JUST FOR DEBUGGING
BAL R14,WTOSUB SEND TO THE CONSOLE
MVC NODENAME(24),HOSTNAME
***********************************************************************
* *
* ISSUE GETADDRINFO MACRO *
* *
***********************************************************************
MVC TYPE,MGADDRI MOVE 'GETADDRINFO' TO MESSAGE
XC ADDR_INFO(addrinfo_len),ADDR_INFO CLEAR OUT ALL HINTS
LA R6,ai_CANONNAMEOK REQUEST THE CANONICAL NAME
ST R6,ai_flags SAVE THE HINT FLAGS
LA R6,ADDR_INFO POINT TO THE HINTS ADDRINFO
ST R6,HINTS SAVE THE ADDRESS OF THE HINTS
LA R6,0 LENGTH OF SERVICE NAME
ST R6,SERVNAMEL SAVE THE SERVICE NAME LENGTH
*
EZASMI TYPE=GETADDRINFO, ISSUE GETADDRINFO MACRO X
NODE=NODENAME, NODE GETTING INFORMATION FOR X
NODELEN=NODENAMEL, LENGTH OF NODE NAME X
SERVICE=SERVNAME, SERVICE GETTING INFORMATION FOR X
SERVLEN=SERVNAMEL, LENGTH OF SERVICE NAME X
HINTS=HINTS, HINTS FOR FILTERING X
RES=RESULT_ADDRINFO, RETURNED ADDRESS INFORMATION X
CANNLEN=CANNAMEL, LENGTH OF CANONICAL NAME X
ERRNO=ERRNO, (SPECIFY ERRNO FIELD) X
RETCODE=RETCODE, (SPECIFY RETCODE FIELD) X
ERROR=ERROR ABEND IF MACRO ERROR
*
BAL R14,RCCHECK CHECK FOR SUCCESSFUL CALL
*
* IF RETURNED SUCCESSFULLY, THEN PROCESS THE ADDRINFO STRUCTORE AND
* THEN CHECK TO SEE IF THERE IS ANOTHER TO PROCESS. CONTINUE UNTIL
* AI_NEXT IS NULL.
*
ICM R10,B'1111',RESULT_ADDRINFO EXAMINE RETURNED ADDRINFO
BZ NOAIS IF NOT RETURNED THEN HOST NOT FOUND?
SEEAIS DS 0H
MVC ADDR_INFO(addrinfo_len),0(R10) LOAD ADDRINFO STRUCTURE
XC OPNAMELEN,OPNAMELEN CLEAR NAME LENGTH OUTPUT FIELD
XC OPCANON,OPCANON CLEAR CANONICAL NAME OUTPUT FIELD
XC OPNAME,OPNAME CLEAR NAME OUTPUT FIELD
XC OPNEXT,OPNEXT CLEAR NEXT ADDRINFO OUTPUT FIELD
*
CALL EZACIC09,(RESULT_ADDRINFO, X
OPNAMELEN, OUTPUT NAME LENGTH X
OPCANON, OUTPUT CANONICAL NAME X
OPNAME, OUTPUT NAME X
OPNEXT, OUTPUT NEXT RESULT ADDRESS INFO X
RETCODE),VL
*
* FORMAT CANONNAME.
*
MVC MSGRSLT1,=C'CANON NAME' INDICATE WHAT WE'RE PROCESSING
XC MSGRSLT2,MSGRSLT2
MVC MSGRSLT2(21),=C' - NO CANON NAME '
XC MSGRSLT2,MSGRSLT2
MVC MSGRSLT2,OPCANON
FMTAISNC DS 0H
STM R14,R12,12(R13) JUST FOR DEBUGGING
BAL R14,WTOSUB SEND TO THE CONSOLE
FMTAISNCE DS 0H
*
* IF AI_NEXT IS NULL THEN THIS IS THE LAST STRUCTURE ON THE LIST.
* TO PROCESS ALL STRUCTURES:
* 1. GET THE FIRST ONE AND PROCESS THE FIELDS RETURNED.
* 2. USE THE ADDRESS IN AI_NEXT TO GET THE NEXT ADDRESS IF NOT NULL.
* 3. PROCESS THE NEW FIELDS IN THE SUBSEQUENT STRUCTURE.
* 4. GOTO 2.
*
ICM R10,B'1111',ai_next SEE IF NEXT ADDRESS IS NULL...
BP SEEAIS NOPE...PARSE IT.
*
***********************************************************************
* *
* ISSUE FREEADDRINFO MACRO. MUST BE DRIVEN AFTER A *
* SUCCESSFUL GETADDRINFO; OTHERWISE, RESOLVER STORAGE WILL *
* BE CONSUMED. *
* *
***********************************************************************
MVC TYPE,MFADDRI MOVE 'FREEADDRINFO' TO MESSAGE
*
EZASMI TYPE=FREEADDRINFO, ISSUE FREEADDRINFO MACRO X
ADDRINFO=RESULT_ADDRINFO, X
ERRNO=ERRNO, (SPECIFY ERRNO FIELD) X
RETCODE=RETCODE, (SPECIFY RETCODE FIELD) X
ERROR=ERROR ABEND IF MACRO ERROR
*
BAL R14,RCCHECK CHECK FOR SUCCESSFUL CALL
*
B ENDAIS
NOAIS DS 0H
XC MSGRSLT2,MSGRSLT2
MVC MSGRSLT2(21),=C'Result not returned. '
BAL R14,WTOSUB SEND TO THE CONSOLE
ENDAIS DS 0H
*
***********************************************************************
* *
* Issue BIND socket *
* *
***********************************************************************
MVC TYPE,MBIND MOVE 'BIND' TO MESSAGE
MVC PORT(2),PORTS Load STREAM port #
*
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
ERROR=ERROR Abend if Macro error
* REQAREA=REQAREA, IN CASE WE ARE DOING EXITS OR ECBS X
*
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
ERROR=ERROR Abend if Macro error
* REQAREA=REQAREA, IN CASE WE ARE DOING EXITS OR ECBS X
*
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 #
*
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
ERROR=ERROR Abend if Macro error
* REQAREA=REQAREA, IN CASE WE ARE DOING EXITS OR ECBS X
*
BAL R14,RCCHECK CHECK FOR SUCCESSFUL CALL
* Message RESULTS text
STH R8,SOCDESCA SAVE RETCODE (SOCKET DESCRIPTOR)
***********************************************************************
* *
* ISSUE NTOP MACRO *
* *
***********************************************************************
MVC NUMERIC_ADDR,ADDRESS IP ADDRESS FROM ACCEPT
*
* DISPLAY THE NUMERIC ADDRESS FIRST
*
MVC TYPE,MNTOP MOVE 'NTOP ' TO MESSAGE
*
* TRANSLATE IT TO PRESENTABLE FORM
*
EZASMI TYPE=NTOP, ISSUE PTON MACRO X
AF='INET6', X
SRCADDR=NUMERIC_ADDR, X
DSTADDR=PRESENTABLE_ADDR, X
DSTLEN=PRESENTABLE_ADDR_LEN, X
ERRNO=ERRNO, (SPECIFY ERRNO FIELD) X
RETCODE=RETCODE, (SPECIFY RETCODE FIELD) X
ERROR=ERROR ABEND IF MACRO ERROR
*
BAL R14,RCCHECK CHECK FOR SUCCESSFUL CALL
*
* DISPLAY THE RETURNED ADDRESS IN PRESENTABLE FORMAT
*
MVC MSGRSLT1,=C'DSTADDR ' INDICATE WHAT WE'RE PROCESSING
XC MSGRSLT2,MSGRSLT2
MVC MSGRSLT2(L'PRESENTABLE_ADDR),PRESENTABLE_ADDR
STM R14,R12,12(R13) JUST FOR DEBUGGING
BAL R14,WTOSUB SEND TO THE CONSOLE
***********************************************************************
* *
* 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
ERROR=ERROR Abend if Macro error
* REQAREA=REQAREA, IN CASE WE ARE DOING EXITS OR ECBS X
*
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
ERROR=ERROR Abend if Macro error
* REQAREA=REQAREA, IN CASE WE ARE DOING EXITS OR ECBS X
*
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
ERROR=ERROR Abend if Macro error
* REQAREA=REQAREA, IN CASE WE ARE DOING EXITS OR ECBS X
*
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'EZASO6AS' 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 0CL28' ' SOCKET IPV6 NAME STRUCTURE
DC AL1(16) Address Length
DC AL1(19) Family
PORT DC H'0'
FLOWINFO DC XL4'00'
ADDRESS DC XL16'FF'
DC XL4'00' SCOPEID
ADDR DC XL16'00000000000000000000000000000001' 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 *
*---------------*
MNTOP DC CL8'NTOP '
MPTON DC CL8'PTON '
MFADDRI DC CL8'FADDRI '
MGADDRI DC CL8'GADDRI '
MGHOSTN DC CL8'GETHOSTN'
MGNAMEI DC CL8'GNAMEI '
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'EZASO6AS:' 'EZASO6ASXX:'
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'
EZBREHST DSECT=NO,LIST=YES,HOSTENT=NO,ADRINFO=YES
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'
*
REQARG DC F'1'
RETARG DS 0H
*
* FOR NTOP AND PTON
*
NUMERIC_ADDR DS CL16 IP ADDRESS IN NUMERIC FORM
PRESENTABLE_ADDR DS CL45 IP ADDRESS IN PRESENTABLE FORM
PRESENTABLE_ADDR_LEN DC AL2(L'PRESENTABLE_ADDR) LENGTH OF PRESENTABLE X
IP ADDRESS
LOOPIPV6 DC CL45'::1' IPV6 LOOPBACK ADDRESS
*
* FOR GETHOSTNAME, GETADDRINFO, and FREEADDRINFO
*
HOSTNAME DC CL24' '
NODENAME DC CL255' ' FOR THE RETURNED HOST NAME
SERVNAME DC C' ' SERVICE BEING RESOLVED
CNOP 0,4
HOSTNAMEL DC AL4(L'HOSTNAME) LENGTH OF THE HOST NAME
NODENAMEL DC AL4(L'NODENAME) LENGTH OF THE NODE NAME
SERVNAMEL DC F'0' LENGTH OF THE SERVICE NAME
RESULT_ADDRINFO DC F'0' RETURNED ADDRINFO
CANNAMEL DC F'0' CANNONICAL NAME LENGTH IN ADDRINFO
HINTS DC F'0' ADDRESS OF HINTS ADDRINFO
*
* For EZACIC09 processing
*
OPNAMELEN DS F SOCKET ADDRESS STRUCTURE LENGTH
OPCANON DS CL256 CANONICAL NAME
OPNAME DS CL28 SOCKET ADDRESS STRUCTURE
OPNEXT DS F NEXT RESULT ADDRESS INFO IN CHAIN
*
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'
BPXYSOCK DSECT=NO,LIST=YES
END
Figure 1. EZASO6AS sample server program for IPv6
z/OS Communications Server: IP Sockets Application Programming Interface Guide and Reference
Copyright IBM Corporation 1990, 2014