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:
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.
When a client program connects, the first message (message number 100) will ask the client for his name.
If the name is a good one, the server will respond with message number 101. "Login Accepted"
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