
      ***************
      * Subroutines *
      ***************
     C     SOCKCONN      begsr
     c*                  eval      msg = 'Opening socket!'
     c*    msg           dsply
     C*************************************************
     C* Get the 32-bit network IP address for the host
     C*  that was supplied by the user:
     C*************************************************
     c                   eval      IP = inet_addr(%trim(host))
     c                   if        IP = INADDR_NONE
     c                   eval      p_hostent = gethostbyname(%trim(host))
     c                   if        p_hostent = *NULL
     c                   eval      msg = 'Unable to find that host!'
     c     msg           dsply
     c                   return
     c                   endif
     c                   eval      IP = h_addr
     c                   endif
     C*************************************************
     C* Create a socket
     C*************************************************
     c                   eval      sock = socket(AF_INET: SOCK_STREAM:
     c                                           IPPROTO_IP)
     c                   if        sock < 0
     c                   eval      msg = 'Error calling socket()!'
     c     msg           dsply
     c                   return
     c                   endif
     C*************************************************
     C* Create a socket address structure that
     C*   describes the host & port we wanted to
     C*   connect to
     C*************************************************
     c                   eval      addrlen = %size(sockaddr)
     c                   alloc     addrlen       p_connto
     c                   eval      p_sockaddr = p_connto
     c                   eval      sin_family = AF_INET
     c                   eval      sin_addr = IP
     c                   eval      sin_port = port
     c                   eval      sin_zero = *ALLx'00'

     C*************************************************
     C* Connect to the requested host
     C*************************************************
     C                   if        connect(sock: p_connto: addrlen) < 0
     c                   eval      msg = 'unable to connect to server!'
     c     msg           dsply
     c                   callp     close(sock)
     c                   return
     c                   endif
     c                   endsr

      ************
      * Procedures
      ************

      ***********
      * New Split
      ***********
     P NSplit          B
     D NSplit          PI            10I 0
     D   peLine                        *   value
     D   c                            1A   value
     D s               S          32766A   based(peLine)
     D i               S             10I 0
     D nDelimiters     S             10I 0
     D iBegin          S             10I 0
     c*        Count the number of delimiters
     c                   eval      nDelimiters = 0
     c                   eval      i = 1
     c                   eval      iBegin = 1
     C                   DOW       i <> 0
     c                   eval      i = %scan (c : s : i)
     c                   if        i > 0
     c                   eval      nDelimiters = nDelimiters + 1
     c                   Eval      sFields(nDelimiters + 1) =
     c                             %subst(s:iBegin:i - iBegin)
     c                   eval      i = i + 1
     c                   Eval      iBegin = i
     c                   EndIf
     c                   EndDo
     c                   Eval      sFields(1) = %char(nDelimiters)
     c                   If        s <> ''
     c                   eval      nDelimiters = nDelimiters + 1
     c                   Eval      sFields(nDelimiters + 1) =
     c                             %subst(s:iBegin)
     c                   EndIf
     c                   Return    0
     P                 E


      ********************
      * Readline Procedure
      ********************
     P RdLine          B
     D RdLine          PI            10I 0
     D   peSock                      10I 0 value
     D   peLine                        *   value
     D   peLength                    10I 0 value
     D   peXLate                      1A   const options(*nopass)
     D   peLF                         1A   const options(*nopass)
     D   peCR                         1A   const options(*nopass)
     D wwBuf           S          32766A   based(peLine)
     D wwLen           S             10I 0
     D CH              S              1A
     D wwXLate         S              1A
     D wwLF            S              1A
     D wwCR            S              1A
      ** Set default values to unpassed parms:
     c                   if        %parms > 3
     c                   eval      wwXLate = peXLate
     c                   else
     c                   eval      wwXLate = *OFF
     c                   endif

     c                   if        %parms > 4
     c                   eval      wwLF = peLF
     c                   else
     c                   eval      wwLF = x'0A'
     c                   endif

     c                   if        %parms > 5
     c                   eval      wwCR = peCR
     c                   else
     c                   eval      wwCR = x'0D'
     c                   endif

      ** Clear "line" of data:
     c                   eval      %subst(wwBuf:1:peLength) = *blanks

     c                   dow       1 = 1

      ** read 1 byte:
     c                   eval      rc = recv(peSock: %addr(ch): 1: 0)
     c                   if        rc < 1
     c                   if        wwLen > 0
     c                   leave
     c                   else
     c                   return    -1
     c                   endif
     c                   endif

      ** if LF is found, we're done reading:
     c                   if        ch = wwLF
     c                   leave
     c                   endif

      ** any other char besides CR gets added to the string:
     c                   if        ch <> wwCR
     c                   eval      wwLen = wwLen + 1
     c                   eval      %subst(wwBuf:wwLen:1) = ch
     c                   endif

      ** if variable is full, exit now -- there's no space left to read data

     c                   if        wwLen = peLength
     c                   leave
     c                   endif

     c                   enddo

      ** if ASCII->EBCDIC translation is required, do it here
     c                   if        wwXLate=*ON  and wwLen > 0
     c                   callp     Translate(wwLen: wwBuf: 'QTCPEBC')
     c                   endif
      * Split out the data and the error code for valid reads
     c                   If        wwLen > 0
     C                   Eval      RC =
     C                             %dec(%subst(wwBuf:1:%scan (x'05' : wwBuf)-1)
     C                             :10:0)
     c*                  Bypass the return code and 1st delimiter
     C                   Eval      sResult =
     C                             %subst(wwBuf:%scan (IQDelim : wwBuf)+1)
     c                   Callp     NSplit(%addr(sResult):IQDelim)
     c                   EndIf
     C
      ** return the length

     c                   return    wwLen
     P                 E


      ********************
      * Writeline Procedure
      ********************

     P WrLine          B
     D WrLine          PI            10I 0
     D  peSock                       10I 0 value
     D  peLine                    32766A   const
     D  peLength                     10I 0 value options(*nopass)
     D  peXLate                       1A   const options(*nopass)
     D  peEOL1                        1A   const options(*nopass)
     D  peEOL2                        1A   const options(*nopass)

     D wwLine          S          32766A
     D wwLen           S             10I 0
     D wwXlate         S              1A
     D wwEOL           S              2A
     D wwEOLlen        S             10I 0
     D rc              S             10I 0

     C*******************************************
     C* Allow this procedure to figure out the
     C*  length automatically if not passed,
     C*  or if -1 is passed.
     C*******************************************
     c                   if        %parms > 2 and peLength <> -1
     c                   eval      wwLen = peLength
     c                   else
     c                   eval      wwLen = %len(%trim(peLine))
     c                   endif

     C*******************************************
     C* Default 'translate' to *ON.  Usually
     C*  you want to type the data to send
     C*  in EBCDIC, so this makes more sense:
     C*******************************************
     c                   if        %parms > 3
     c                   eval      wwXLate = peXLate
     c                   else
     c                   eval      wwXLate = *On
     c                   endif

     C*******************************************
     C* End-Of-Line chars:
     C*   1) If caller passed only one, set
     C*         that one with length = 1
     C*   2) If caller passed two, then use
     C*         them both with length = 2
     C*   3) If caller didn't pass either,
     C*         use both CR & LF with length = 2
     C*******************************************
     c                   eval      wwEOL = *blanks
     c                   eval      wwEOLlen = 0

     c                   if        %parms > 4
     c                   eval      %subst(wwEOL:1:1) = peEOL1
     c                   eval      wwEOLLen = 1
     c                   endif

     c                   if        %parms > 5
     c                   eval      %subst(wwEOL:2:1) = peEOL2
     c                   eval      wwEOLLen = 2
     c                   endif

     c                   if        wwEOLLen = 0
     c                   eval      wwEOL = x'0D0A'
     c                   eval      wwEOLLen = 2
     c                   endif

     C*******************************************
     C* Do translation if required:
     C*******************************************
     c                   eval      wwLine = peLine
     c                   if        wwXLate = *On and wwLen > 0
     c                   callp     Translate(wwLen: wwLine: 'QTCPASC')
     c                   endif

     C*******************************************
     C* Send the data, followed by the end-of-line:
     C* and return the length of data sent:
     C*******************************************
     c                   if        wwLen > 0
     c                   eval      rc = send(peSock: %addr(wwLine): wwLen:0)
     c                   if        rc < wwLen
     c                   return    rc
     c                   endif
     c                   endif

     c                   eval      rc = send(peSock:%addr(wwEOL):wwEOLLen:0)
     c                   if        rc < 0
     c                   return    rc
     c                   endif

     c                   return    (rc + wwLen)
     P                 E

      *************************
      * DpidToAddress Procedure
      *************************
     P DpidToAddress   B
     D DpidToAddress   PI            10I 0
     D   pDpid                       10I 0 value


     c                   eval      request = 'pafDpidToAddressId' +
     c                             iqdelim + pafid + iqdelim + %Char(pDpid)
     c                   callp     WrLine(sock: %trim(request))

     C                   Callp     rdline(sock: %addr(recbuf):
     c                                         %size(recbuf): *On)
     c                   return    Rc
     P                 E

      ************************
      * OpenPafMemId Procedure
      ************************
     P OpenPafMemId    B
     D OpenPafMemId    PI            10I 0
     D   pPafID                      10A   value

     c                   eval      request = 'pafOpenPafMemId' +
     c                             iqdelim + %trim(pPafID)
     c                   callP     WrLine(sock: %trim(request))
     c                   CallP     rdline(sock: %addr(recbuf):
     c                                         %size(recbuf): *On)
     c                   if        Rc = 0
     c                   eval      pafid = %trim(sResult)
     c                   endif
     c                   return    Rc
     P                 E

      ****************************
      * GetHintAddr Procedure
      ****************************
     P GetHintAddr     B
     D GetHintAddr     PI            10I 0
     D   pLocality                   30A   value
     D   pAddress                    30A   value
      *
     c                   if        pLocality = '' and pAddress = ''
     c                   eval      request = 'pafGetNextAddressHintId' +
     c                             iqdelim + pafid
     c                   else
     c                   eval      request = 'pafGetAddressHintId' +
     c                             iqdelim + pafid + iqdelim + %trim(pLocality)
     c                             + iqdelim + %trim(pAddress)
     c                   endif
     c                   callp     WrLine(sock: %trim(request))
     c                   CallP     rdline(sock: %addr(recbuf):
     c                                         %size(recbuf): *On)
     c                   return    Rc
     P                 E

      ****************************
      * FormatAddress Procedure
      ****************************
     P FormatAddress   B
     D FormatAddress   PI           200A
     D   pAddress                   200A   value
     D   pOptions                    10I 0 value
      *
     c                   eval      request = 'pafFormatAddressId' +
     c                             iqdelim + pafid + iqdelim + %char(pOptions)
     c                             + iqdelim + %trim(pAddress)
     c                   callp     WrLine(sock: %trim(request))
     c                   callp     rdline(sock: %addr(recbuf):
     c                                         %size(recbuf): *On)
     c                   return    %trim(sresult)
     P                 E

      ****************************
      * GetAddress Procedure
      ****************************
     P GetAddress      B
     D GetAddress      PI            10I 0
     D   peLine                        *   value
     D s               S          32766A   based(peLine)
      *
     c                   if        s <> ''
     c                   eval      request = 'pafGetAddressId' +
     c                             iqdelim + pafid + iqdelim + %trim(s)
     c                   else
     c                   eval      request = 'pafGetNextAddressId' +
     c                             iqdelim + pafid
     c                   endif
     c                   callp     WrLine(sock: %trim(request))
     c                   CallP     rdline(sock: %addr(recbuf):
     c                                         %size(recbuf): *On)
     c                   return    Rc
     P                 E

      *******************************
      * ValFullAddress Procedure
      *******************************
     P ValFullAddress  B
     D ValFullAddress  PI            10I 0
     D   peLine                        *   value
     D   peOption                     1A   value
     D s               S             30A   based(peLine)
     c                   eval      request = 'pafValidateFullAddressId' +
     c                             iqdelim + pafid + iqdelim + %trim(peOption)
     c                              + iqdelim + %trim(s)
     c                   callp     WrLine(sock: %trim(request))
     c                   CallP     rdline(sock: %addr(recbuf):
     c                                         %size(recbuf): *On)
     c                   return    Rc
     P                 E

      ****************************
      * Properties Procedure
      ****************************
     P Properties      B
     D Properties      PI            10I 0
     D   pProperty                  200A   value
      *
     c                   eval      request = 'pafGetPropertiesId' +
     c                             iqdelim + pafid + iqdelim
     c                             + %trim(pProperty)
     c                   callp     WrLine(sock: %trim(request))
     c                   callp     rdline(sock: %addr(recbuf):
     c                                         %size(recbuf): *On)
     c                   return    RC
     P                 E
