Advertisement
RaulFaccio

Arquivo original lido

Jan 24th, 2017
3,545
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
COBOL 76.95 KB | None | 0 0
  1.       *****************************************************************                                                                                               *                                                             *                                                                                             *  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