Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- ***************************************************************** * * * 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.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement
