6.9. A Chat Application

In the last topic, you improved upon the 'example server' that we've been using since the start of the server portion of this tutorial. Yes, it's a nice, simple, example of writing a server.

But how practical is all of this knowledge you've picked up? Can you do anything truly useful with it?

Okay. Lets modify that last example, the 'simple example server' program and turn it into a simple 'chat room'.

Here's what we want to do:

  1. Each message going from the server to the client should be prefixed by a unique 'message number'. This makes it much easier for a client program to understand the purpose for each message we send.

  2. When a client program connects, the first message (message number 100) will ask the client for his name.

  3. If the name is a good one, the server will respond with message number 101. "Login Accepted"

  4. From this point on, each line that the client types will be sent to all of the other clients that are logged in. Each of these messages will be prefixed by the name of the person using the client which sent the message.

This will involve surprisingly few changes to the program that we created in the previous topic.

Here's our 'chat server':

    File: SOCKTUT/QRPGLESRC, Member: SERVEREX5
         H DFTACTGRP(*NO) ACTGRP(*NEW)
         H BNDDIR('SOCKTUT/SOCKUTIL') BNDDIR('QC2LE')
         
         *** header files for calling service programs & APIs
         
         D/copy socktut/qrpglesrc,socket_h
         D/copy socktut/qrpglesrc,sockutil_h
         D/copy socktut/qrpglesrc,errno_h
         
         *** Prototypes for externally called programs:
         
         D Translate       PR                  ExtPgm('QDCXLATE')
         D    peLength                    5P 0 const
         D    peBuffer                32766A   options(*varsize)
         D    peTable                    10A   const
         
         *** Prototypes for local subprocedures:
         
         D die             PR
         D   peMsg                      256A   const
         
         D NewListener     PR            10I 0
         D   pePort                       5U 0 value
         D   peError                    256A
         
         D NewClient       PR            10I 0
         D   peServ                      10I 0 value
         
         D ReadClient      PR            10I 0
         D   peClient                    10I 0 value
         
         D WriteClient     PR            10I 0
         D   peClient                    10I 0 value
         
         D HandleClient    PR            10I 0
         D   peClient                    10I 0 value
         
         D EndClient       PR            10I 0
         D   peClient                    10I 0 value
         
         D GetLine         PR            10I 0
         D   peClient                    10I 0 value
         D   peLine                     256A
         
         D PutLine         PR            10I 0
         D   peClient                    10I 0 value
         D   peLine                     256A   const
         
         *** Configuration
         
         D MAXCLIENTS      C                   CONST(100)
         
         *** Global Variables:
         
         D Msg             S            256A
         D to              S               *
         D tolen           S             10I 0
         D serv            S             10I 0
         D max             S             10I 0
         D rc              S             10I 0
         D C               S             10I 0
         D readset         S                   like(fdset)
         D excpset         S                   like(fdset)
         D writeset        S                   like(fdset)
         D endpgm          S              1N   inz(*off)
         
         *** Variables in the "client" data structure are kept
         *** seperate for each connected client socket.
         
         D Client          DS                  Occurs(MAXCLIENTS)
         D   sock                        10I 0
         D   rdbuf                      256A
         D   rdbuflen                    10I 0
         D   state                       10I 0
         D   wrbuf                     2048A
         D   wrbuflen                    10I 0
         D   name                        20A
         
         
         c                   eval      *inlr = *on
         
         c                   exsr      Initialize
         
         C*********************************************************
         C*  Main execution loop:
         C*
         C*     1) Make read/write/exception descriptor sets.
         C*         and figure out the timeout value for select()
         C*
         C*    2) Call select() to find out which descriptors need
         C*         data to be written or read, and also to find
         C*         any exceptions to handle.
         C*
         C*    3) Check to see if a user told us to shut down, or
         C*         if the job/subsystem/system has requested us to
         C*         end the program.
         C*
         C*    4) If the listener socket ("server socket") has data
         C*         to read, it means someone is trying to connect
         C*         to us, so call the NewClient procedure.
         C*
         C*    5) Check each socket for incoming data and load into
         C*         the appropriate read buffer.
         C*
         C*    6) Check each client for outgoing data and write into
         C*         the appropriate socket.
         C*
         C*    7) Do the next "task" that each socket needs.
         C*         (could be sending a line of text, or waiting
         C*         for input, or disconnecting, etc)
         C*********************************************************
         c                   dow       1 = 1
    
         c                   exsr      MakeDescSets
    
         c                   eval      rc = select(max+1: %addr(readset):
         c                                %addr(writeset): %addr(excpset): to)
    
         c                   exsr      ChkShutDown
    
         c                   if        rc > 0
         c                   if        FD_ISSET(serv: readset)
         c                   callp     NewClient(serv)
         c                   endif
         c                   exsr      CheckSockets
         c                   endif
    
         c                   exsr      DoClients
    
         c                   enddo
    
    
         C*===============================================================
         C* Initialize some program vars & set up a server socket:
         C*===============================================================
         CSR   Initialize    begsr
         C*------------------------
         c                   do        MAXCLIENTS    C
         c     C             occur     client
         c                   eval      sock = -1
         c                   callp     EndClient(C)
         c                   enddo
    
         c                   eval      tolen = %size(timeval)
         c                   alloc     tolen         to
         c                   eval      p_timeval = to
    
         C*********************************************************
         C* Start listening to port 4000
         C*********************************************************
         c                   eval      serv = NewListener(4000: Msg)
         c                   if        serv < 0
         c                   callp     die(Msg)
         c                   endif
         C*------------------------
         CSR                 endsr
    
    
         C*===============================================================
         C*  This makes the descriptor sets:
         C*     readset -- includes the 'server' (listener) socket plus
         C*          any clients that still have space in their read buffer
         C*    writeset -- includes any clients that have data in their
         C*          write buffer.
         C*     excpset -- includes all socket descriptors, since all of
         C*          them should be checked for exceptional conditions
         C*===============================================================
         CSR   MakeDescSets  begsr
         C*------------------------
         c                   callp     FD_ZERO(writeset)
         c                   callp     FD_ZERO(readset)
         c                   callp     FD_ZERO(excpset)
    
         c                   callp     FD_SET(serv: readset)
         c                   callp     FD_SET(serv: excpset)
    
         C* the 60 second timeout is just so that we can check for
         C*  system shutdown periodically.
         c                   eval      tv_sec = 60
         c                   eval      tv_usec = 0
         c                   eval      max = serv
    
         c                   do        MAXCLIENTS    C
         c     C             occur     client
         c                   if        sock <> -1
         c                   callp     FD_SET(sock: excpset)
         c                   if        rdbuflen < %size(rdbuf)
         c                   callp     FD_SET(sock: readset)
         c                   endif
         c                   if        wrbuflen > 0
         c                   callp     FD_SET(sock: writeset)
         c                   endif
         c                   if        sock > max
         c                   eval      max = sock
         c                   endif
         c                   endif
         c                   enddo
         C*------------------------
         CSR                 endsr
    
    
         C*===============================================================
         C*  Check for a 'shutdown' condition.  If shutdown was requested
         C*  tell all connected sockets, and then close them.
         C*===============================================================
         CSR   ChkShutDown   begsr
         C*------------------------
         c                   shtdn                                        99
         c                   if        *in99 = *on
         c                   eval      endpgm = *On
         c                   endif
    
          * Note that the 'endpgm' flag can also be set by the
          *   'HandleClient' subprocedure, not just the code above...
    
         c                   if        endpgm = *on
         c                   do        MAXCLIENTS    C
         c     C             occur     client
         c                   if        sock <> -1
         c                   callp     WrLine(sock: '902 Sorry!  We''re ' +
         c                              'shutting down now!')
         c                   callp     EndClient(C)
         c                   endif
         c                   enddo
         c                   callp     close(serv)
         c                   callp     Die('shut down requested...')
         c                   return
         c                   endif
         C*------------------------
         CSR                 endsr
    
    
         C*===============================================================
         C*  This reads any data that's waiting to be read from each
         C*   socket, and writes any data that's waiting to be written.
         C*
         C*  Also disconnects any socket that returns an error, or has
         C*  and exceptional condition pending.
         C*===============================================================
         CSR   CheckSockets  begsr
         C*------------------------
         c                   do        MAXCLIENTS    C
    
         c     C             occur     client
    
         c                   if        sock <> -1
    
         c                   if        FD_ISSET(sock: readset)
         c                   if        ReadClient(C) < 0
         c                   callp     EndClient(C)
         c                   callp     FD_CLR(sock: excpset)
         c                   callp     FD_CLR(sock: writeset)
         c                   endif
         c                   endif
    
         c                   if        FD_ISSET(sock: writeset)
         c                   if        WriteClient(C) < 0
         c                   callp     EndClient(C)
         c                   callp     FD_CLR(sock: excpset)
         c                   callp     FD_CLR(sock: writeset)
         c                   endif
         c                   endif
    
         c                   if        FD_ISSET(sock: excpset)
         c                   callp     EndClient(C)
         c                   endif
    
         c                   endif
    
         c                   enddo
         C*------------------------
         CSR                 endsr
    
    
         C*===============================================================
         C*  This finally gets down to "talking" to the client programs.
         C*  It switches between each connected client, and then sends
         C*  data or receives data as appropriate...
         C*===============================================================
         CSR   DoClients     begsr
         C*------------------------
         c                   do        MAXCLIENTS    C
         c     C             occur     client
         c                   if        sock <> -1
         c                   callp     HandleClient(C)
         c                   endif
         c                   enddo
         C*------------------------
         CSR                 endsr
    
    
          *+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
          *  Create a new TCP socket that's listening to a port
          *
          *       parms:
          *         pePort = port to listen to
          *        peError = Error message (returned)
          *
          *    returns: socket descriptor upon success, or -1 upon error
          *+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
         P NewListener     B
         D NewListener     PI            10I 0
         D   pePort                       5U 0 value
         D   peError                    256A
    
         D sock            S             10I 0
         D len             S             10I 0
         D bindto          S               *
         D on              S             10I 0 inz(1)
         D linglen         S             10I 0
         D ling            S               *
         D flags           S             10I 0
    
         C*** Create a socket
         c                   eval      sock = socket(AF_INET:SOCK_STREAM:
         c                                           IPPROTO_IP)
         c                   if        sock < 0
         c                   eval      peError = %str(strerror(errno))
         c                   return    -1
         c                   endif
    
         C*** Tell socket that we want to be able to re-use the server
         C***  port without waiting for the MSL timeout:
         c                   callp     setsockopt(sock: SOL_SOCKET:
         c                                SO_REUSEADDR: %addr(on): %size(on))
    
         C*** create space for a linger structure
         c                   eval      linglen = %size(linger)
         c                   alloc     linglen       ling
         c                   eval      p_linger = ling
    
         C*** tell socket to only linger for 2 minutes, then discard:
         c                   eval      l_onoff = 1
         c                   eval      l_linger = 120
         c                   callp     setsockopt(sock: SOL_SOCKET: SO_LINGER:
         c                                ling: linglen)
    
         C*** free up resources used by linger structure
         c                   dealloc(E)              ling
    
         C*** tell socket we don't want blocking...
         c                   eval      flags = fcntl(sock: F_GETFL)
         c                   eval      flags = flags + O_NONBLOCK
         c                   if        fcntl(sock: F_SETFL: flags) < 0
         c                   eval      peError = %str(strerror(errno))
         c                   return    -1
         c                   endif
    
         C*** Create a sockaddr_in structure
         c                   eval      len = %size(sockaddr_in)
         c                   alloc     len           bindto
         c                   eval      p_sockaddr = bindto
    
         c                   eval      sin_family = AF_INET
         c                   eval      sin_addr = INADDR_ANY
         c                   eval      sin_port = pePort
         c                   eval      sin_zero = *ALLx'00'
    
         C*** Bind socket to port
         c                   if        bind(sock: bindto: len) < 0
         c                   eval      peError = %str(strerror(errno))
         c                   callp     close(sock)
         c                   dealloc(E)              bindto
         c                   return    -1
         c                   endif
    
         C*** Listen for a connection
         c                   if        listen(sock: MAXCLIENTS) < 0
         c                   eval      peError = %str(strerror(errno))
         c                   callp     close(sock)
         c                   dealloc(E)              bindto
         c                   return    -1
         c                   endif
    
         C*** Return newly set-up socket:
         c                   dealloc(E)              bindto
         c                   return    sock
         P                 E
    
    
          *+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
          *  This accepts a new client connection, and adds him to
          *   the 'client' data structure.
          *+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
         P NewClient       B
         D NewClient       PI            10I 0
         D   peServ                      10I 0 value
    
         D X               S             10I 0
         D S               S             10I 0
         D cl              S             10I 0
         D flags           S             10I 0
         D ling            S               *
         D connfrom        S               *
         D len             S             10I 0
         D Msg             S             52A
    
         C*************************************************
         C* See if there is an empty spot in the data
         C* structure.
         C*************************************************
         c                   eval      cl = 0
         c                   do        MAXCLIENTS    X
         c     X             occur     Client
         c                   if        sock = -1
         c                   eval      cl = X
         c                   leave
         c                   endif
         c                   enddo
    
         C*************************************************
         C*  Accept new connection
         C*************************************************
         c                   eval      len = %size(sockaddr_in)
         c                   alloc     len           connfrom
    
         c                   eval      S = accept(peServ: connfrom: len)
         c                   if        S < 0
         c                   return    -1
         c                   endif
    
         c                   dealloc(E)              connfrom
    
         C*************************************************
         C* Turn off blocking & limit lingering
         C*************************************************
         c                   eval      flags = fcntl(S: F_GETFL: 0)
         c                   eval      flags = flags + O_NONBLOCK
         c                   if        fcntl(S: F_SETFL: flags) < 0
         c                   eval      Msg = %str(strerror(errno))
         c                   dsply                   Msg
         c                   return    -1
         c                   endif
    
         c                   eval      len = %size(linger)
         c                   alloc     len           ling
         c                   eval      p_linger = ling
         c                   eval      l_onoff = 1
         c                   eval      l_linger = 120
         c                   callp     setsockopt(S: SOL_SOCKET: SO_LINGER:
         c                                ling: len)
         c                   dealloc(E)              ling
    
         C*************************************************
         C*  If we've already reached the maximum number
         C*  of connections, let client know and then
         C*  get rid of him
         C*************************************************
         c                   if        cl = 0
         c                   callp     wrline(S: '901 Maximum number of ' +
         c                              'connections has been reached!')
         c                   callp     close(s)
         c                   return    -1
         c                   endif
    
         C*************************************************
         C*  Add client into the structure
         C*************************************************
         c     cl            occur     client
         c                   eval      sock = S
         c                   return    0
         P                 E
    
    
          *+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
          *  If there is data to be read from a Client's socket, add it
          *    to the client's buffer, here...
          *+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
         P ReadClient      B
         D ReadClient      PI            10I 0
         D   peClient                    10I 0 value
    
         D left            S             10I 0
         D p_read          S               *
         D err             S             10I 0
         D len             S             10I 0
    
         c     peClient      occur     client
    
         c                   eval      left = %size(rdbuf) - rdbuflen
         c                   eval      p_read = %addr(rdbuf) + rdbuflen
    
         c                   eval      len = recv(sock: p_read: left: 0)
         c                   if        len < 0
         c                   eval      err = errno
         c                   if        err = EWOULDBLOCK
         c                   return    0
         c                   else
         c                   return    -1
         c                   endif
         c                   endif
    
         c                   eval      rdbuflen = rdbuflen + len
         c                   return    len
         P                 E
    
    
          *+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
          *  If a client's socket is ready to write data to, and theres
          *    data to write, go ahead and write it...
          *+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
         P WriteClient     B
         D WriteClient     PI            10I 0
         D   peClient                    10I 0 value
    
         D len             S             10I 0
    
         c     peClient      occur     client
         c                   if        wrbuflen < 1
         c                   return    0
         c                   endif
    
         c                   eval      len = send(sock:%addr(wrbuf):wrbuflen:0)
    
         c                   if        len > 0
         c                   eval      wrbuf = %subst(wrbuf: len+1)
         c                   eval      wrbuflen = wrbuflen - len
         c                   endif
    
         c                   return    len
         P                 E
    
    
          *+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
          *  This disconnects a client and cleans up his spot in the
          *    client data structure.
          *+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
         P EndClient       B
         D EndClient       PI            10I 0
         D   peClient                    10I 0 value
         c     peClient      occur     client
         c                   if        sock >= 0
         c                   callp     close(sock)
         c                   endif
         c                   eval      sock = -1
         c                   eval      rdbuf = *Blanks
         c                   eval      rdbuflen = 0
         c                   eval      state = 0
         c                   eval      wrbuflen = 0
         c                   eval      wrbuf = *Blanks
         c                   return    0
         P                 E
    
    
          *+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
          *  As we're switching between each different client, this
          *  routine is called to handle whatever the next 'step' is
          *  for a given client.
          *+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
         P HandleClient    B
         D HandleClient    PI            10I 0
         D   peClient                    10I 0 value
    
         D X               S             10I 0
         D from            S             24A
         D msg             S            256A
    
         c     peClient      occur     client
    
         c                   select
         c                   when      state = 0
         c                   callp     PutLine(peClient: '100 Please enter ' +
         c                                   'your name now!')
         c                   eval      state = 1
    
         c                   when      state = 1
         c                   if        GetLine(peClient: msg) > 0
    
         c                   if        %trim(msg) = 'quit'
         c                   eval      endpgm = *on
         c                   callp     PutLine(peClient: ' ')
         c                   eval      state = 3
         c                   else
         c                   eval      name = %trim(msg)
         c                   callp     PutLine(peClient: '101 Login Accepted.')
         c                   eval      state = 2
         c                   endif
    
         c                   endif
    
         c                   when      state = 2
         c                   if        GetLine(peClient: msg) > 0
         c                   eval      from = '200 ' + name
    
         C*         copy message to each client:
         c                   do        MAXCLIENTS    X
         c     X             occur     client
         c                   if        sock <> -1 and state > 1
         c                   callp     PutLine(X: %trimr(from) + ': ' + msg)
         c                   endif
         c                   enddo
    
         c     peClient      occur     client
         c                   endif
    
    
         c                   when      state = 3
         c                   callp     EndClient(peClient)
         c                   endsl
    
         c                   return    0
         P                 E
    
    
          *+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
          *  This removes one line of data from a client's read buffer
          *+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
         P GetLine         B
         D GetLine         PI            10I 0
         D   peClient                    10I 0 value
         D   peLine                     256A
    
         D pos             S             10I 0
    
         C*** Load correct client:
         c     peClient      occur     client
         c                   if        rdbuflen < 1
         c                   return    0
         c                   endif
    
         C*** Look for an end-of-line character:
         c                   eval      pos = %scan(x'0A': rdbuf)
    
         C*** If buffer is completely full, take the whole thing
         C***   even if there is no end-of-line char.
         c                   if        pos<1 and rdbuflen>=%size(rdbuf)
         c                   eval      peLine = rdbuf
         c                   eval      pos = rdbuflen
         c                   eval      rdbuf = *blanks
         c                   eval      rdbuflen = 0
         c                   callp     Translate(pos: peLine: 'QTCPEBC')
         c                   return    pos
         c                   endif
    
         C*** otherwise, only return something if end of line existed
         c                   if        pos < 1 or pos > rdbuflen
         c                   return    0
         c                   endif
    
         C*** Add line to peLine variable, and remove from rdbuf:
         c                   eval      peLine = %subst(rdbuf:1:pos-1)
    
         c                   if        pos < %size(rdbuf)
         c                   eval      rdbuf = %subst(rdBuf:pos+1)
         c                   else
         c                   eval      rdbuf = *blanks
         c                   endif
    
         c                   eval      rdbuflen = rdbuflen - pos
    
         C*** If CR character found, remove that too...
         c                   eval      pos = pos - 1
         c                   if        %subst(peLine:pos:1) = x'0D'
         c                   eval      peLine = %subst(peLine:1:pos-1)
         c                   eval      pos = pos - 1
         c                   endif
    
         C*** Convert to EBCDIC:
         c                   if        pos > 0
         c                   callp     Translate(pos: peLine: 'QTCPEBC')
         c                   endif
    
         C*** return length of line:
         c                   return    pos
         P                 E
    
    
          *+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
          *  Add a line of text onto the end of a client's write buffer
          *+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
         P PutLine         B
         D PutLine         PI            10I 0
         D   peClient                    10I 0 value
         D   peLine                     256A   const
    
         D wkLine          S            258A
         D saveme          S             10I 0
         D len             S             10I 0
    
         c                   occur     client        saveme
         c     peClient      occur     client
    
         C* Add CRLF & calculate length & translate to ASCII
         c                   eval      wkLine = %trimr(peLine) + x'0D25'
         c                   eval      len = %len(%trimr(wkLine))
         c                   callp     Translate(len: wkLine: 'QTCPASC')
    
         C* make sure we don't overflow buffer
         c                   if        (wrbuflen+len) > %size(wrbuf)
         c                   eval      len = %size(wrbuf) - wrbuflen
         c                   endif
         c                   if        len < 1
         c     saveme        occur     client
         c                   return    0
         c                   endif
    
         C* add data onto end of buffer
         c                   eval      %subst(wrbuf:wrbuflen+1) =
         c                                  %subst(wkLine:1:len)
         c                   eval      wrbuflen = wrbuflen + len
         c     saveme        occur     client
         c                   return    len
         P                 E
    
    
          *+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
          *  This ends this program abnormally, and sends back an escape.
          *   message explaining the failure.
          *+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
         P die             B
         D die             PI
         D   peMsg                      256A   const
    
         D SndPgmMsg       PR                  ExtPgm('QMHSNDPM')
         D   MessageID                    7A   Const
         D   QualMsgF                    20A   Const
         D   MsgData                    256A   Const
         D   MsgDtaLen                   10I 0 Const
         D   MsgType                     10A   Const
         D   CallStkEnt                  10A   Const
         D   CallStkCnt                  10I 0 Const
         D   MessageKey                   4A
         D   ErrorCode                32766A   options(*varsize)
    
         D dsEC            DS
         D  dsECBytesP             1      4I 0 INZ(256)
         D  dsECBytesA             5      8I 0 INZ(0)
         D  dsECMsgID              9     15
         D  dsECReserv            16     16
         D  dsECMsgDta            17    256
    
         D wwMsgLen        S             10I 0
         D wwTheKey        S              4A
    
         c                   eval      wwMsgLen = %len(%trimr(peMsg))
         c                   if        wwMsgLen<1
         c                   return
         c                   endif
    
         c                   callp     SndPgmMsg('CPF9897': 'QCPFMSG   *LIBL':
         c                               peMsg: wwMsgLen: '*ESCAPE':
         c                               '*PGMBDY': 1: wwTheKey: dsEC)
    
         c                   return
         P                 E
    
          /define ERRNO_LOAD_PROCEDURE
          /copy socktut/qrpglesrc,errno_h