*****************************************************************
* *
* MODULE NAME: EZASO6CS - THIS IS A VERY SIMPLE IPV6 SERVER *
* *
* Copyright: Licensed Materials - Property of IBM *
* *
* "Restricted Materials of IBM" *
* *
* 5694-A01 *
* *
* Copyright IBM Corp. 2002, 2008 *
* *
* US Government Users Restricted Rights - *
* Use, duplication or disclosure restricted by *
* GSA ADP Schedule Contract with IBM Corp. *
* *
* Status: CSV1R10 *
* *
* LANGUAGE: COBOL *
* *
*****************************************************************
Identification Division.
*========================*
Program-id. EZASO6CS.
*=====================*
Environment Division.
*=====================*
*==============*
Data Division.
*==============*
Working-storage Section.
*---------------------------------------------------------------*
* Socket interface function codes *
*---------------------------------------------------------------*
01 soket-functions.
02 soket-accept pic x(16) value 'ACCEPT '.
02 soket-bind pic x(16) value 'BIND '.
02 soket-close pic x(16) value 'CLOSE '.
02 soket-connect pic x(16) value 'CONNECT '.
02 soket-fcntl pic x(16) value 'FCNTL '.
02 soket-freeaddrinfo pic x(16) value 'FREEADDRINFO '.
02 soket-getaddrinfo pic x(16) value 'GETADDRINFO '.
02 soket-getclientid pic x(16) value 'GETCLIENTID '.
02 soket-gethostbyaddr pic x(16) value 'GETHOSTBYADDR '.
02 soket-gethostbyname pic x(16) value 'GETHOSTBYNAME '.
02 soket-gethostid pic x(16) value 'GETHOSTID '.
02 soket-gethostname pic x(16) value 'GETHOSTNAME '.
02 soket-getnameinfo pic x(16) value 'GETNAMEINFO '.
02 soket-getpeername pic x(16) value 'GETPEERNAME '.
02 soket-getsockname pic x(16) value 'GETSOCKNAME '.
02 soket-getsockopt pic x(16) value 'GETSOCKOPT '.
02 soket-givesocket pic x(16) value 'GIVESOCKET '.
02 soket-initapi pic x(16) value 'INITAPI '.
02 soket-ioctl pic x(16) value 'IOCTL '.
02 soket-listen pic x(16) value 'LISTEN '.
02 soket-ntop pic x(16) value 'NTOP '.
02 soket-pton pic x(16) value 'PTON '.
02 soket-read pic x(16) value 'READ '.
02 soket-recv pic x(16) value 'RECV '.
02 soket-recvfrom pic x(16) value 'RECVFROM '.
02 soket-select pic x(16) value 'SELECT '.
02 soket-send pic x(16) value 'SEND '.
02 soket-sendto pic x(16) value 'SENDTO '.
02 soket-setsockopt pic x(16) value 'SETSOCKOPT '.
02 soket-shutdown pic x(16) value 'SHUTDOWN '.
02 soket-socket pic x(16) value 'SOCKET '.
02 soket-takesocket pic x(16) value 'TAKESOCKET '.
02 soket-termapi pic x(16) value 'TERMAPI '.
02 soket-write pic x(16) value 'WRITE '.
*---------------------------------------------------------------*
* Work variables *
*---------------------------------------------------------------*
01 errno pic 9(8) binary value zero.
01 retcode pic s9(8) binary value zero.
01 client-ipaddr-dotted pic x(15) value space.
01 server-ipaddr-dotted pic x(15) value space.
01 ezaconn-function pic x value space.
88 CONNECTED value 'Y'.
01 saved-message-id pic x(8) value space.
88 close-down-message-received value '*CLSDWN*'.
01 Terminate-Options pic x value space.
88 Opened-API value 'A'.
88 Opened-Socket value 'S'.
01 saved-message-id-len pic 9(8) Binary value 8.
01 Cur-time .
02 Hour pic 9(2).
02 Minute pic 9(2).
02 Second pic 9(2).
02 Hund-Sec pic 9(2).
01 S pic 9(4) comp.
*---------------------------------------------------------------*
* Variables used for the INITAPI call *
*---------------------------------------------------------------*
01 maxsoc-fwd pic 9(8) Binary.
01 maxsoc-rdf redefines maxsoc-fwd.
02 filler pic x(2).
02 maxsoc pic 9(4) Binary.
01 initapi-ident.
05 tcpname pic x(8) Value 'TCPCS '.
05 asname pic x(8) Value space.
01 subtask pic x(8) value 'EZASO6CS'.
01 maxsno pic 9(8) Binary Value 1.
*---------------------------------------------------------------*
* Variables returned by the GETCLIENTID Call *
*---------------------------------------------------------------*
01 clientid.
05 clientid-domain pic 9(8) Binary value 19.
05 clientid-name pic x(8) value space.
05 clientid-task pic x(8) value space.
05 filler pic x(20) value low-value.
*---------------------------------------------------------------*
* Variables used for the SOCKET call *
*---------------------------------------------------------------*
01 AF-INET pic 9(8) Binary Value 2.
01 AF-INET6 pic 9(8) Binary Value 19.
01 SOCK-STREAM pic 9(8) Binary Value 1.
01 SOCK-DATAGRAM pic 9(8) Binary Value 2.
01 SOCK-RAW pic 9(8) Binary Value 3.
01 IPPROTO-IP pic 9(8) Binary Value zero.
01 IPPROTO-TCP pic 9(8) Binary Value 6.
01 IPPROTO-UDP pic 9(8) Binary Value 17.
01 IPPROTO-IPV6 pic 9(8) Binary Value 41.
01 socket-descriptor pic 9(4) Binary Value zero.
*---------------------------------------------------------------*
* Variables returned by the GETHOSTNAME Call *
*---------------------------------------------------------------*
01 host-name-len pic 9(8) binary.
01 host-name pic x(24).
01 host-name-char-count pic 9(4) binary.
01 host-name-unstrung pic x(24) value spaces.
*---------------------------------------------------------------*
* Variables used/returned by the GETADDRINFO Call *
*---------------------------------------------------------------*
01 node-name pic x(255).
01 node-name-len pic 9(8) binary.
01 service-name pic x(32).
01 service-name-len pic 9(8) binary.
01 canonical-name-len pic 9(8) binary.
01 ai-passive pic 9(8) binary value 1.
01 ai-canonnameok pic 9(8) binary value 2.
01 ai-numerichost pic 9(8) binary value 4.
01 ai-numericserv pic 9(8) binary value 8.
01 ai-v4mapped pic 9(8) binary value 16.
01 ai-all pic 9(8) binary value 32.
01 ai-addrconfig pic 9(8) binary value 64.
*---------------------------------------------------------------*
* Variables used for the BIND call *
*---------------------------------------------------------------*
01 server-socket-address.
05 server-family pic 9(4) Binary value 19.
05 server-port pic 9(4) Binary value 1031.
05 server-flowinfo pic 9(8) Binary value 0.
05 server-ipaddr.
10 filler pic 9(16) Binary value 0.
10 filler pic 9(16) Binary value 0.
05 server-scopeid pic 9(8) Binary value 0.
01 NBYTE PIC 9(8) COMP value 80.
01 BUF PIC X(80).
01 BACKLOG PIC S9(8) COMP VALUE 10.
*---------------------------------------------------------------*
* Variables used/returned by the EZACIC09 call *
*---------------------------------------------------------------*
01 input-addrinfo-ptr usage is pointer.
01 output-name-len pic 9(8) binary.
01 output-canonical-name pic x(256).
01 output-name usage is pointer.
01 output-next-addrinfo usage is pointer.
*---------------------------------------------------------------*
* Variables used for the LISTEN call *
*---------------------------------------------------------------*
01 backlog-level pic 9(4) Binary Value zero.
*---------------------------------------------------------------*
* Variables used for the ACCEPT call *
*---------------------------------------------------------------*
01 socket-descriptor-new pic 9(4) Binary Value zero.
*---------------------------------------------------------------*
* Variables used for the NTOP/PTON call *
*---------------------------------------------------------------*
01 IN6ADDR-ANY pic x(45)
value '::'.
01 IN6ADDR-LOOPBACK pic x(45)
value '::1'.
01 ntop-family pic 9(8) Binary.
01 pton-family pic 9(8) Binary.
01 presentable-addr pic x(45) value spaces.
01 presentable-addr-len pic 9(4) Binary value 45.
01 numeric-addr.
05 filler pic 9(16) Binary Value 0.
05 filler pic 9(16) Binary Value 0.
*---------------------------------------------------------------*
* Variables used by the RECV Call *
*---------------------------------------------------------------*
01 client-socket-address.
05 client-family pic 9(4) Binary Value 19.
05 client-port pic 9(4) Binary Value 1032.
05 client-flowinfo pic 9(8) Binary Value zero.
05 client-ipaddr.
10 filler pic 9(16) Binary Value 0.
10 filler pic 9(16) Binary Value 0.
05 client-scopeid pic 9(8) Binary Value zero.
*---------------------------------------------------------------*
* Buffer and length field for recv and send operation *
*---------------------------------------------------------------*
01 send-request-len pic 9(8) Binary Value zero.
01 read-request-len pic 9(8) Binary Value zero.
01 read-buffer pic x(4000) value space.
01 filler redefines read-buffer.
05 message-id pic x(8).
05 filler pic x(3992).
*---------------------------------------------------------------*
* recv and send flags *
*---------------------------------------------------------------*
01 send-flag pic 9(8) Binary value zero.
01 recv-flag pic 9(8) Binary value zero.
*---------------------------------------------------------------*
* Error message for socket interface errors *
*---------------------------------------------------------------*
77 failure pic S9(8) comp.
01 ezaerror-msg.
05 filler pic x(9) Value 'Function='.
05 ezaerror-function pic x(16) Value space.
05 filler pic x value ' '.
05 filler pic x(8) Value 'Retcode='.
05 ezaerror-retcode pic ---99.
05 filler pic x value ' '.
05 filler pic x(9) Value 'Errorno='.
05 ezaerror-errno pic zzz99.
05 filler pic x value ' '.
05 ezaerror-text pic x(50) value ' '.
*================
Linkage Section.
*================
01 L1.
03 hints-addrinfo.
05 hints-ai-flags pic 9(8) binary.
05 hints-ai-family pic 9(8) binary.
05 hints-ai-socktype pic 9(8) binary.
05 hints-ai-protocol pic 9(8) binary.
05 filler pic 9(8) binary.
05 filler pic 9(8) binary.
05 filler pic 9(8) binary.
05 filler pic 9(8) binary.
03 hints-addrinfo-ptr usage is pointer.
03 results-addrinfo-ptr usage is pointer.
*
* Results address info
*
01 results-addrinfo.
05 results-ai-flags pic 9(8) binary.
05 results-ai-family pic 9(8) binary.
05 results-ai-socktype pic 9(8) binary.
05 results-ai-protocol pic 9(8) binary.
05 results-ai-addr-len pic 9(8) binary.
05 results-ai-canonical-name usage is pointer.
05 results-ai-addr-ptr usage is pointer.
05 results-ai-next-ptr usage is pointer.
*
* Socket address structure from EZACIC09.
*
01 output-name-ptr usage is pointer.
01 output-ip-name.
03 output-ip-family pic 9(4) Binary.
03 output-ip-port pic 9(4) Binary.
03 output-ip-sock-data pic x(24).
03 output-ipv4-sock-data redefines
output-ip-sock-data.
05 output-ipv4-ipaddr pic 9(8) Binary.
05 filler pic x(20).
03 output-ipv6-sock-data redefines
output-ip-sock-data.
05 output-ipv6-flowinfo pic 9(8) Binary.
05 output-ipv6-ipaddr.
10 filler pic 9(16) Binary.
10 filler pic 9(16) Binary.
05 output-ipv6-scopeid pic 9(8) Binary.
*=============================================*
Procedure Division using L1.
*=============================================*
*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*
* P R O C E D U R E C O N T R O L S *
*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*
Perform Initialize-API thru Initialize-API-Exit.
Perform Get-ClientID thru Get-ClientID-Exit.
Perform Sockets-Descriptor thru Sockets-Descriptor-Exit.
Perform Presentation-To-Numeric thru
Presentation-To-Numeric-Exit.
Perform Get-Host-Name thru Get-Host-Name-Exit.
Perform Get-Address-Info thru Get-Address-Info-Exit.
Perform Bind-Socket thru Bind-Socket-Exit.
Perform Listen-To-Socket thru Listen-To-Socket-Exit.
Perform Accept-Connection thru Accept-Connection-Exit.
Move 45 to presentable-addr-len.
Move spaces to presentable-addr.
Move server-ipaddr to numeric-addr.
Move 19 to ntop-family.
Perform Numeric-TO-Presentation thru
Numeric-To-Presentation-Exit.
Perform Read-Message thru Read-Message-Exit.
Perform Write-Message thru Write-Message-Exit.
Perform Close-Socket thru Exit-Now.
*---------------------------------------------------------------*
* Initialize socket API *
*---------------------------------------------------------------*
Initialize-API.
Move soket-initapi to ezaerror-function.
*---------------------------------------------------------------*
* If you want to set maxsoc to the max, uncomment the next line.*
*---------------------------------------------------------------*
* Move 65535 to maxsoc-fwd.
Call 'EZASOKET' using soket-initapi maxsoc initapi-ident
subtask maxsno errno retcode.
Move 'Initapi failed' to ezaerror-text.
If retcode < 0 move 12 to failure.
Perform Return-Code-Check thru Return-Code-Exit.
Move 'A' to Terminate-Options.
Initialize-API-Exit.
Exit.
*---------------------------------------------------------------*
* Let us see the client-id *
*---------------------------------------------------------------*
Get-ClientID.
move soket-getclientid to ezaerror-function.
Call 'EZASOKET' using soket-getclientid clientid errno
retcode.
Display 'Client ID = ' clientid-name
'task=' clientid-task.
Move 'Getclientid failed' to ezaerror-text.
If retcode < 0 move 24 to failure.
Perform Return-Code-Check thru Return-Code-Exit.
Get-ClientID-Exit.
Exit.
*---------------------------------------------------------------*
* Get us a stream socket descriptor. *
*---------------------------------------------------------------*
Sockets-Descriptor.
move soket-socket to ezaerror-function.
Call 'EZASOKET' using soket-socket AF-INET6 SOCK-STREAM
IPPROTO-IP errno retcode.
Move 'Socket call failed' to ezaerror-text.
If retcode < 0 move 24 to failure.
Perform Return-Code-Check thru Return-Code-Exit.
Move retcode to socket-descriptor.
Move 'S' to Terminate-Options.
Sockets-Descriptor-Exit.
Exit.
*---------------------------------------------------------------*
* Use PTON to create an IP address to bind to. *
*---------------------------------------------------------------*
Presentation-To-Numeric.
move soket-pton to ezaerror-function.
move IN6ADDR-LOOPBACK to presentable-addr.
Call 'EZASOKET' using soket-pton AF-INET6
presentable-addr presentable-addr-len
numeric-addr
errno retcode.
Move 'PTON call failed' to ezaerror-text.
If retcode < 0 move 24 to failure.
Perform Return-Code-Check thru Return-Code-Exit.
move numeric-addr to server-ipaddr.
Presentation-To-Numeric-Exit.
Exit.
*---------------------------------------------------------------*
* Get the host name. *
*---------------------------------------------------------------*
Get-Host-Name.
move soket-gethostname to ezaerror-function.
move 24 to host-name-len.
Call 'EZASOKET' using soket-gethostname
host-name-len host-name
errno retcode.
display 'Host name = ' host-name.
Move 'GETHOSTNAME call failed' to ezaerror-text.
If retcode < 0 move 24 to failure.
Perform Return-Code-Check thru Return-Code-Exit.
Get-Host-Name-Exit.
Exit.
*---------------------------------------------------------------*
* Get address information *
*---------------------------------------------------------------*
Get-Address-Info.
move soket-getaddrinfo to ezaerror-function.
move 0 to host-name-char-count.
inspect host-name tallying host-name-char-count
for characters before x'00'.
unstring host-name delimited by x'00'
into host-name-unstrung
count in host-name-char-count.
string host-name-unstrung delimited by ' '
into node-name.
move host-name-char-count to node-name-len
display 'node-name-len: ' node-name-len.
move spaces to service-name.
move 0 to service-name-len.
move 0 to hints-ai-family.
move ai-canonnameok to hints-ai-flags
move 0 to hints-ai-socktype.
move 0 to hints-ai-protocol.
display 'GETADDRINFO Input fields: '
display 'Node name = ' node-name.
display 'Node name length = ' node-name-len.
display 'Service name = ' service-name.
display 'Service name length = ' service-name-len.
display 'Hints family = ' hints-ai-family.
display 'Hints flags = ' hints-ai-flags.
display 'Hints socktype = ' hints-ai-socktype.
display 'Hints protocol = ' hints-ai-protocol.
set address of results-addrinfo to results-addrinfo-ptr.
move soket-getaddrinfo to ezaerror-function.
set hints-addrinfo-ptr to address of hints-addrinfo.
Call 'EZASOKET' using soket-getaddrinfo
node-name node-name-len
service-name service-name-len
hints-addrinfo-ptr
results-addrinfo-ptr
canonical-name-len
errno retcode.
Move 'GETADDRINFO call failed' to ezaerror-text.
If retcode < 0 move 24 to failure
Perform Return-Code-Check thru Return-Code-Exit
else
Perform Return-Code-Check thru Return-Code-Exit
display 'Address of results addrinfo is '
results-addrinfo-ptr.
set address of results-addrinfo to results-addrinfo-ptr
set input-addrinfo-ptr to address of results-addrinfo
display 'Address of input-addrinfo-ptr is '
input-addrinfo-ptr.
Perform Format-Result-AI thru Format-Result-AI-Exit
Perform Set-Next-Addrinfo thru
Set-Next-Addrinfo-Exit until
output-next-addrinfo is equal to NULLS
Perform Free-Address-Info thru Free-Address-Info-Exit.
Get-Address-Info-Exit.
Exit.
*---------------------------------------------------------------*
* Set next addrinfo address *
*---------------------------------------------------------------*
Set-Next-Addrinfo.
display 'Setting next addrinfo address as '
results-ai-next-ptr.
display 'Address of output-next-addrinfo as '
output-next-addrinfo.
set address of results-addrinfo to output-next-addrinfo.
set input-addrinfo-ptr to address of results-addrinfo.
display 'Address of input-addrinfo-ptr is '
input-addrinfo-ptr.
Perform Format-Result-AI thru Format-Result-AI-Exit.
Set-Next-Addrinfo-Exit.
Exit.
*---------------------------------------------------------------*
* Format result address information *
*---------------------------------------------------------------*
Format-Result-AI.
move 'EZACIC09' to ezaerror-function.
move zeros to output-name-len.
move spaces to output-canonical-name.
set output-name to nulls.
set output-next-addrinfo to nulls.
Call 'EZACIC09' using input-addrinfo-ptr
output-name-len
output-canonical-name
output-name
output-next-addrinfo
retcode.
Move 'EZACIC09 call failed' to ezaerror-text.
display 'EZACIC09 output:'
display 'Canonical name = ' output-canonical-name.
display 'name length = ' output-name-len.
display 'name = ' output-name.
display 'next addrinfo = ' output-next-addrinfo.
If retcode < 0 move 24 to failure.
Perform Return-Code-Check thru Return-Code-Exit.
display 'Formatting result address ip address'.
set address of output-ip-name to output-name.
move results-ai-family to ntop-family.
display 'ntop-family = ' ntop-family.
if ntop-family = AF-INET then
display 'Formatting ipv4 addres'
move output-ipv4-ipaddr to numeric-addr
move 16 to presentable-addr-len
else
display 'Formatting ipv6 addres'
move output-ipv6-ipaddr to numeric-addr
move 45 to presentable-addr-len.
move spaces to presentable-addr.
Perform Numeric-To-Presentation thru
Numeric-To-Presentation-Exit.
Format-Result-AI-Exit.
Exit.
*---------------------------------------------------------------*
* Release resolver storage *
*---------------------------------------------------------------*
Free-Address-Info.
move soket-freeaddrinfo to ezaerror-function.
Call 'EZASOKET' using soket-freeaddrinfo
results-addrinfo-ptr
errno retcode.
Move 'FREEADDRINFO call failed' to ezaerror-text.
If retcode < 0 move 24 to failure.
Perform Return-Code-Check thru Return-Code-Exit.
Free-Address-Info-Exit.
Exit.
*---------------------------------------------------------------*
* Bind socket to our server port number *
*---------------------------------------------------------------*
Bind-Socket.
Move soket-bind to ezaerror-function.
Call 'EZASOKET' using soket-bind socket-descriptor
server-socket-address errno retcode.
Display 'Port = ' server-port
' Address = ' presentable-addr.
Move 'Bind call failed' to ezaerror-text
If retcode < 0 move 24 to failure.
Perform Return-Code-Check thru Return-Code-Exit.
Bind-Socket-Exit.
Exit.
*---------------------------------------------------------------*
* Listen to the socket *
*---------------------------------------------------------------*
Listen-To-Socket.
Move soket-listen to ezaerror-function.
Call 'EZASOKET' using soket-listen socket-descriptor
backlog errno retcode.
Display 'Backlog=' backlog.
Move 'Listen call failed' to ezaerror-text.
If retcode < 0 move 24 to failure.
Perform Return-Code-Check thru Return-Code-Exit.
Listen-To-Socket-Exit.
Exit.
*---------------------------------------------------------------*
* Accept a connection request *
*---------------------------------------------------------------*
Accept-Connection.
Move soket-accept to ezaerror-function.
Call 'EZASOKET' using soket-accept socket-descriptor
server-socket-address errno retcode.
Move retcode to socket-descriptor-new.
Display 'New socket=' retcode.
Move 'Accept call failed' to ezaerror-text .
If retcode < 0 move 24 to failure.
Perform Return-Code-Check thru Return-Code-Exit.
Accept-Connection-Exit.
Exit.
*---------------------------------------------------------------*
* Use NTOP to display the IP address. *
*---------------------------------------------------------------*
Numeric-To-Presentation.
move soket-ntop to ezaerror-function.
Call 'EZASOKET' using soket-ntop ntop-family
numeric-addr
presentable-addr presentable-addr-len
errno retcode.
Display 'Presentable address = ' presentable-addr.
Move 'NTOP call failed' to ezaerror-text.
If retcode < 0 move 24 to failure.
Perform Return-Code-Check thru Return-Code-Exit.
Numeric-TO-Presentation-Exit.
Exit.
*---------------------------------------------------------------*
* Read a message from the client. *
*---------------------------------------------------------------*
Read-Message.
move soket-read to ezaerror-function.
move spaces to buf.
display 'New socket desciptor = ' socket-descriptor-new.
Call 'EZASOKET' using soket-read socket-descriptor-new
nbyte buf
errno retcode.
display 'Message received = ' buf.
Move 'Read call failed' to ezaerror-text.
If retcode < 0 move 24 to failure.
Perform Return-Code-Check thru Return-Code-Exit.
Read-Message-Exit.
Exit.
*---------------------------------------------------------------*
* Write a message to the client. *
*---------------------------------------------------------------*
Write-Message.
move soket-write to ezaerror-function.
move 'Message from EZASO6SC' to buf.
Call 'EZASOKET' using soket-write socket-descriptor-new
nbyte buf
errno retcode.
Move 'Write call failed' to ezaerror-text
If retcode < 0 move 24 to failure.
Perform Return-Code-Check thru Return-Code-Exit.
Write-Message-Exit.
Exit.
*---------------------------------------------------------------*
* Close connected socket *
*---------------------------------------------------------------*
Close-Socket.
move soket-close to ezaerror-function
Call 'EZASOKET' using soket-close socket-descriptor-new
errno retcode.
Accept cur-time from time.
Display cur-time ' EZASO6CS : CLOSE RETCODE=' RETCODE
' ERRNO= ' ERRNO.
If retcode < 0 move 24 to failure
move 'Close call Failed' to ezaerror-text
perform write-ezaerror-msg thru write-ezaerror-msg-exit.
Close-Socket-Exit.
Exit.
*---------------------------------------------------------------*
* Terminate socket API *
*---------------------------------------------------------------*
exit-term-api.
Call 'EZASOKET' using soket-termapi.
*---------------------------------------------------------------*
* Terminate program *
*---------------------------------------------------------------*
exit-now.
move failure to return-code.
Goback.
*---------------------------------------------------------------*
* Subroutine *
* ---------- *
* *
* Write out an error message *
*---------------------------------------------------------------*
write-ezaerror-msg.
move errno to ezaerror-errno.
move retcode to ezaerror-retcode.
display ezaerror-msg.
write-ezaerror-msg-exit.
exit.
*---------------------------------------------------------------*
* Check Return Code after each Socket Call *
*---------------------------------------------------------------*
Return-Code-Check.
Accept Cur-Time from TIME.
move errno to ezaerror-errno.
move retcode to ezaerror-retcode.
Display Cur-Time ' EZASO6CS: ' ezaerror-function
' RETCODE= ' ezaerror-retcode
' ERRNO= ' ezaerror-errno.
IF RETCODE < 0
Perform Write-ezaerror-msg thru write-ezaerror-msg-exit
Move zeros to errno retcode
IF Opened-Socket Go to Close-Socket
ELSE IF Opened-API Go to exit-term-api
ELSE Go to exit-now.
Move zeros to errno retcode.
Return-Code-Exit.
Exit.
Figure 1. EZASO6CS COBOL
call interface sample IPv6 server program
z/OS Communications Server: IP Sockets Application Programming Interface Guide and Reference
Copyright IBM Corporation 1990, 2014