*****************************************************************
* *
* MODULE NAME: EZASO6CC - THIS IS A VERY SIMPLE IPV6 CLIENT *
* *
* 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. EZASO6CC.
*=====================*
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 index-counter pic 9(8) binary value zero.
01 buffer-element.
05 buffer-element-nbr pic 9(5).
05 filler pic x(3) value space.
01 server-ipaddr-dotted pic x(15) value space.
01 client-ipaddr-dotted pic x(15) value space.
01 close-server pic 9(8) Binary value zero.
88 close-server-down value 1.
01 Connect-Flag pic x value space.
88 CONNECTED value 'Y'.
01 Client-Server-Flag pic x value space.
88 CLIENTS value 'C'.
88 SERVERS value 'S'.
01 Terminate-Options pic x value space.
88 Opened-API value 'A'.
88 Opened-Socket value 'S'.
01 timer-accum pic 9(8) Binary value zero.
01 timer-interval pic 9(8) Binary value 2000.
01 Cur-time.
02 Hour pic 9(2).
02 Minute pic 9(2).
02 Second pic 9(2).
02 Hund-Sec pic 9(2).
77 Failure Pic S9(8) 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 'EZSO6CC'.
01 maxsno pic 9(8) Binary Value 1.
*---------------------------------------------------------------*
* Variables used by the SHUTDOWN Call *
*---------------------------------------------------------------*
01 how pic 9(8) Binary.
*---------------------------------------------------------------*
* 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 returned by the GETNAMEINFO Call *
*---------------------------------------------------------------*
01 name-len pic 9(8) binary.
01 host-name pic x(255).
01 host-name-len pic 9(8) binary.
01 service-name pic x(32).
01 service-name-len pic 9(8) binary.
01 name-info-flags pic 9(8) binary value 0.
01 ni-nofqdn pic 9(8) binary value 1.
01 ni-numerichost pic 9(8) binary value 2.
01 ni-namereqd pic 9(8) binary value 4.
01 ni-numericserver pic 9(8) binary value 8.
01 ni-dgram pic 9(8) binary value 16.
*---------------------------------------------------------------*
* 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.
*---------------------------------------------------------------*
* Server socket address structure *
*---------------------------------------------------------------*
01 server-socket-address.
05 server-afinet pic 9(4) Binary Value 19.
05 server-port pic 9(4) Binary Value 1031.
05 server-flowinfo pic 9(8) Binary Value zero.
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 zero.
01 NBYTE PIC 9(8) COMP value 80.
01 BUF PIC X(80).
*---------------------------------------------------------------*
* Variables used by the BIND 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 0.
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 0.
*---------------------------------------------------------------*
* Buffer and length fields for send operation *
*---------------------------------------------------------------*
01 send-request-length pic 9(8) Binary value zero.
01 send-buffer.
05 send-buffer-total pic x(4000) value space.
05 closedown-message redefines send-buffer-total.
10 closedown-id pic x(8).
10 filler pic x(3992).
05 send-buffer-seq redefines send-buffer-total
pic x(8) occurs 500 times.
*---------------------------------------------------------------*
* Variables used for the NTOP/PTON call *
*---------------------------------------------------------------*
01 IN6ADDR-ANY pic x(45)
value '::'.
01 IN6ADDR-LOOPBACK pic x(45)
value '::1'.
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.
*---------------------------------------------------------------*
* Buffer and length fields for recv operation *
*---------------------------------------------------------------*
01 read-request-length pic 9(8) Binary value zero.
01 read-buffer pic x(4000) value space.
*---------------------------------------------------------------*
* Other fields for send and reccfrom operation *
*---------------------------------------------------------------*
01 send-flag pic 9(8) Binary value zero.
01 recv-flag pic 9(8) Binary value zero.
*---------------------------------------------------------------*
* Error message for socket interface errors *
*---------------------------------------------------------------*
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.
*================
*=============================================*
Procedure Division.
*=============================================*
*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*
* 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-Client-ID thru Get-Client-ID-Exit.
Perform Sockets-Descriptor thru Sockets-Descriptor-Exit.
Perform Presentation-To-Numeric thru
Presentation-To-Numeric-Exit.
Perform CONNECT-Socket thru CONNECT-Socket-Exit.
Perform Numeric-TO-Presentation thru
Numeric-To-Presentation-Exit.
Perform Get-Name-Information thru
Get-Name-Information-Exit.
Perform Write-Message thru Write-Message-Exit.
Perform Shutdown-Send thru Shutdown-Send-Exit.
Perform Read-Message thru Read-Message-Exit.
Perform Shutdown-Receive thru Shutdown-Receive-Exit.
Perform Close-Socket thru Exit-Now.
*---------------------------------------------------------------*
* Initialize socket API *
*---------------------------------------------------------------*
Initialize-API.
Move soket-initapi to ezaerror-function.
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-Client-ID.
Move soket-getclientid to ezaerror-function.
Call 'EZASOKET' using soket-getclientid clientid errno
retcode.
Display 'Our client ID = ' clientid-name ' ' clientid-task.
Move 'Getclientid failed' to ezaerror-text.
If retcode < 0 move 24 to failure.
Perform Return-Code-Check thru Return-Code-Exit.
Move 'C' to client-server-flag.
Get-Client-ID-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 60 to failure.
Perform Return-Code-Check thru Return-Code-Exit.
Move 'S' to Terminate-Options.
Move retcode to socket-descriptor.
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.
*---------------------------------------------------------------*
* CONNECT *
*---------------------------------------------------------------*
Connect-Socket.
Move space to Connect-Flag.
Move zeros to errno retcode.
move soket-connect to ezaerror-function.
CALL 'EZASOKET' USING SOKET-CONNECT socket-descriptor
server-socket-address errno retcode.
Move 'Connection call failed' to ezaerror-text.
If retcode < 0 move 24 to failure.
Perform Return-Code-Check thru Return-Code-Exit.
If retcode = 0 Move 'Y' to Connect-Flag.
Connect-Socket-Exit.
Exit.
*---------------------------------------------------------------*
* Use NTOP to display the IP address. *
*---------------------------------------------------------------*
Numeric-To-Presentation.
move soket-ntop to ezaerror-function.
move server-ipaddr to numeric-addr.
move soket-ntop to ezaerror-function.
Call 'EZASOKET' using soket-ntop AF-INET6
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.
*---------------------------------------------------------------*
* Use GETNAMEINFO to get the host and service names *
*---------------------------------------------------------------*
Get-Name-Information.
move 28 to name-len.
move 255 to host-name-len.
move 32 to service-name-len.
move ni-namereqd to name-info-flags.
move soket-getnameinfo to ezaerror-function.
Call 'EZASOKET' using soket-getnameinfo
server-socket-address name-len
host-name host-name-len
service-name service-name-len
name-info-flags
errno retcode.
Display 'Host name = ' host-name.
Display 'Service = ' service-name.
Move 'Getaddrinfo call failed' to ezaerror-text.
If retcode < 0 move 24 to failure.
Perform Return-Code-Check thru Return-Code-Exit.
Get-Name-Information-Exit.
Exit.
*---------------------------------------------------------------*
* Write a message to the server *
*---------------------------------------------------------------*
Write-Message.
Move soket-write to ezaerror-function.
Move 'Message from EZASO6CC' to buf.
Call 'EZASOKET' using soket-write socket-descriptor
nbyte buf
errno retcode.
Move 'Write call failed' to ezaerror-text.
If retcode < 0 move 84 to failure.
Perform Return-Code-Check thru Return-Code-Exit.
Write-Message-Exit.
Exit.
*---------------------------------------------------------------*
* Shutdown to pipe *
*---------------------------------------------------------------*
Shutdown-Send.
Move soket-shutdown to ezaerror-function.
move 1 to how.
Call 'EZASOKET' using soket-shutdown socket-descriptor
how
errno retcode.
Move 'Shutdown call failed' to ezaerror-text.
If retcode < 0 move 99 to failure.
Perform Return-Code-Check thru Return-Code-Exit.
Shutdown-Send-Exit.
Exit.
*---------------------------------------------------------------*
* Read a message from the server. *
*---------------------------------------------------------------*
Read-Message.
Move soket-read to ezaerror-function.
Move spaces to buf.
Call 'EZASOKET' using soket-read socket-descriptor
nbyte buf
errno retcode.
If retcode < 0
Move 'Read call failed' to ezaerror-text
move 120 to failure
Perform Return-Code-Check thru Return-Code-Exit.
Read-Message-Exit.
Exit.
*---------------------------------------------------------------*
* Shutdown receive pipe *
*---------------------------------------------------------------*
Shutdown-Receive.
Move soket-shutdown to ezaerror-function.
move 0 to how.
Call 'EZASOKET' using soket-shutdown socket-descriptor
how
errno retcode.
Move 'Shutdown call failed' to ezaerror-text.
If retcode < 0 move 99 to failure.
Perform Return-Code-Check thru Return-Code-Exit.
Shutdown-Receive-Exit.
Exit.
*---------------------------------------------------------------*
* Close socket *
*---------------------------------------------------------------*
Close-Socket.
Move soket-close to ezaerror-function.
Call 'EZASOKET' using soket-close socket-descriptor
errno retcode.
Move 'Close call failed' to ezaerror-text.
If retcode < 0 move 132 to failure
perform write-ezaerror-msg thru
write-ezaerror-msg-exit.
Accept Cur-Time from TIME.
Display Cur-Time ' EZASO6CC: ' ezaerror-function
' RETCODE=' RETCODE ' ERRNO= ' ERRNO.
Close-Socket-Exit.
Exit.
*---------------------------------------------------------------*
* Terminate socket API *
*---------------------------------------------------------------*
exit-term-api.
ACCEPT cur-time from TIME.
Display cur-time ' EZASO6CC: TERMAPI '
' RETCODE= ' RETCODE ' ERRNO= ' ERRNO.
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.
Display Cur-Time ' EZASO6CC: ' ezaerror-function
' RETCODE=' RETCODE ' ERRNO= ' 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. EZASO6CC COBOL
call interface sample IPv6 client program
z/OS Communications Server: IP Sockets Application Programming Interface Guide and Reference
Copyright IBM Corporation 1990, 2014