Are you excited about trying another example program? Are you? Are you?
As I mentioned before, this example program differs from the last one, in that it asks for a userid & password, then validates them, them changes it's 'effective user profile' to the user & password that you've signed in as.
Once you're signed in, it asks for a program name, and then it calls that program, passing the socket descriptor and user-id as passwords.
This design is very practical, because by using this server program, you can easily write many different client/server applications without needing to write a separate listener & server instance program for each.
This one involves 3 different programs. The Listener program, which hasn't changed much since our last example -- the only real difference is that the phrase 'SVREX6' has been changed to 'SVREX76' throughout the member. The server instance program, which now validates userid & password, and calls a program. And the 'program to call', for which I provide one sample program.
In the next topic, we'll talk about how to run this program, as well as giving a few samples of what you can do with this server.
So... here it is!
File: SOCKTUT/QRPGLESRC, Member: SVREX7L
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 D/copy socktut/qrpglesrc,jobinfo_h *** prototypes for external calls D Cmd PR ExtPgm('QCMDEXC') D command 200A const D length 15P 5 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 KillEmAll PR *** local variables & constants D MAXCLIENTS C CONST(256) D PRESTART C CONST(5) D svr S 10I 0 D cli S 10I 0 D msg S 256A D err S 10I 0 D calen S 10I 0 D clientaddr S * D jilen S 5P 0 D rc S 10I 0 D tolen S 10I 0 D timeout S * D readset S like(fdset) D excpset S like(fdset) c eval *inlr = *on C************************************************* C* Clean up any previous instances of the dtaq C************************************************* c callp(e) Cmd('DLTDTAQ SOCKTUT/SVREX7DQ': 200) c callp(e) Cmd('CRTDTAQ DTAQ(SOCKTUT/SVREX7DQ) ' + c ' MAXLEN(80) TEXT(''Data ' + c ' queue for SVREX7L'')': 200) c if %error c callp Die('Unable to create data queue!') c return c endif C************************************************* C* Start listening for connections on port 4000 C************************************************* c eval svr = NewListener(4000: msg) c if svr < 0 c callp die(msg) c return c endif C************************************************* C* Pre-start some server instances C************************************************* c do PRESTART c callp(e) Cmd('SBMJOB CMD(CALL PGM(SVREX7I))' + c ' JOB(SERVERINST) ' + c ' JOBQ(QSYSNOMAX) ' + c ' JOBD(QDFTJOBD) ' + c ' RTGDTA(QCMDB)': 200) c if %error c callp close(svr) c callp KillEmAll c callp Die('Unable to submit a new job to ' + c 'process clients!') c return c endif c enddo C************************************************* C* create a space to put client addr struct into C************************************************* c eval calen = %size(sockaddr_in) c alloc calen clientaddr c eval tolen = %size(timeval) c alloc tolen timeout c dow 1 = 1 C************************************ C* Get a new server instance ready C************************************ c callp(e) Cmd('SBMJOB CMD(CALL PGM(SVREX7I))' + c ' JOB(SERVERINST) ' + c ' JOBQ(QSYSNOMAX) ' + c ' JOBD(QDFTJOBD) ' + c ' RTGDTA(QCMDB)': 200) c if %error c callp close(svr) c callp KillEmAll c callp Die('Unable to submit a new job to ' + c 'process clients!') c return c endif C************************************ C* Check every 30 seconds for a C* system shutdown, until a client C* connects. C************************************ c dou rc > 0 c callp FD_ZERO(readset) c callp FD_ZERO(excpset) c callp FD_SET(svr: readset) c callp FD_SET(svr: excpset) c eval p_timeval = timeout c eval tv_sec = 20 c eval tv_usec = 0 c eval rc = select(svr+1: %addr(readset): c *NULL: %addr(excpset): timeout) c shtdn 99 c if *in99 = *on c callp close(svr) c callp KillEmAll c callp die('shutdown requested!') c return c endif c enddo C************************************ C* Accept a new client conn C************************************ c eval cli = accept(svr: clientaddr: calen) c if cli < 0 c eval err = errno c callp close(svr) c callp KillEmAll c callp die('accept(): ' + %str(strerror(err))) c return c endif c if calen <> %size(sockaddr_in) c callp close(cli) c eval calen = %size(sockaddr_in) c iter c endif C************************************ C* get the internal job id of a C* server instance to handle client C************************************ c eval jilen = %size(dsJobInfo) c callp RcvDtaQ('SVREX7DQ': 'SOCKTUT': jilen: c dsJobInfo: 60) c if jilen < 80 c callp close(cli) c callp KillEmAll c callp close(svr) c callp die('No response from server instance!') c return c endif C************************************ C* Pass descriptor to svr instance C************************************ c if givedescriptor(cli: %addr(InternalID))<0 c eval err = errno c callp close(cli) c callp KillEmAll c callp close(svr) c callp Die('givedescriptor(): ' + c %str(strerror(err))) c Return c endif c callp close(cli) c enddo *+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ * This ends any server instances that have been started, but * have not been connected with clients. *+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ P KillEmAll B D KillEmAll PI c dou jilen < 80 c eval jilen = %size(dsJobInfo) c callp RcvDtaQ('SVREX7DQ': 'SOCKTUT': jilen: c dsJobInfo: 1) c if jilen >= 80 c callp(E) Cmd('ENDJOB JOB(' + %trim(JobNbr) + c '/' + %trim(JobUser) + '/' + c %trim(jobName) + ') OPTION(*IMMED)'+ c ' LOGLMT(0)': 200) C endif c enddo P E *+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ * 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 * 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*** 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 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
File: SOCKTUT/QRPGLESRC, Member: SVREX7I
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 D/copy socktut/qrpglesrc,jobinfo_h *** Prototypes for local subprocedures: D die PR D peMsg 256A const D GetClient PR 10I 0 D SignIn PR 10I 0 D sock 10I 0 value D userid 10A D cli S 10I 0 D rc S 10I 0 D usrprf S 10A D pgmname S 21A D lower C 'abcdefghijklmnopqrstuvwxyz' D upper C 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' c eval *inlr = *on C********************************************************* C* Get socket descriptor from 'listener' program C********************************************************* c eval cli = GetClient c if cli < 0 c callp Die('Failure retrieving client socket '+ c 'descriptor.') c return c endif C********************************************************* C* Ask user to sign in, and set user profile. C********************************************************* c eval rc = SignIn(cli: usrprf) c select c when rc < 0 c callp Die('Client disconnected during sign-in') c callp close(cli) c return c when rc = 0 c callp Die('Authorization failure!') c callp close(cli) c return c endsl C********************************************************* C* Ask for the program to be called C********************************************************* c callp WrLine(cli: '102 Please enter the ' + c 'program you''d like to call') c if RdLine(cli: %addr(pgmname): 21: *On) < 0 c callp Die('Error calling RdLine()') c callp close(cli) c return c endif c lower:upper xlate pgmname pgmname C********************************************************* C* Call the program, passing the socket desc & profile C* as the parameters. C********************************************************* c call(e) PgmName c parm cli c parm usrprf c if not %error c callp WrLine(cli: '103 Call succeeded.') c else c callp WrLine(cli: '902 Call failed.') c endif C********************************************************* C* End. C********************************************************* c callp close(cli) c return *+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ * Sign a user-id into the system *+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ P SignIn B D SignIn PI 10I 0 D sock 10I 0 value D userid 10A D passwd S 10A D handle S 12A c dou userid <> *blanks c callp WrLine(sock: '100 Please enter your ' + c 'user-id now!') c if RdLine(sock: %addr(userid): 10: *On) < 0 c return -1 c endif c lower:upper xlate userid userid c callp WrLine(sock: '101 Please enter your ' + c 'password now!') c if RdLine(sock: %addr(passwd): 10: *On) < 0 c return -1 c endif c lower:upper xlate passwd passwd c callp GetProfile(userid: passwd: handle: dsEC) c if dsECBytesA > 0 c callp WrLine(sock: '900 Incorrect userid ' + c 'or password! ('+%trim(dsECMsgID)+')') c eval userid = *blanks c endif c enddo c callp SetProfile(handle: dsEC) c if dsECBytesA > 0 c callp WrLine(sock: '901 Unable to set ' + c 'profile! ('+%trim(dsECMsgID)+')') c return 0 c endif c return 1 P E *+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ * Get the new client from the listener application *+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ P GetClient B D GetClient PI 10I 0 D jilen S 5P 0 D sock S 10I 0 c callp RtvJobInf(dsJobI0100: %size(dsJobI0100): c 'JOBI0100': '*': *BLANKS: dsEC) c if dsECBytesA > 0 c return -1 c endif c eval JobName = JobI_JobName c eval JobUser = JobI_UserID c eval JobNbr = JobI_JobNbr c eval InternalID = JobI_IntJob c eval jilen = %size(dsJobInfo) c callp SndDtaq('SVREX7DQ': 'SOCKTUT': jilen: c dsJobInfo) c eval sock = TakeDescriptor(*NULL) c return sock 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
File: SOCKTUT/QRPGLESRC, Member: TESTPGM
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 sock S 10I 0 D user S 10A c *entry plist c parm sock c parm user c callp WrLine(sock: 'Hello ' + %trim(user)) c callp WrLine(sock: 'Goodbye ' + %trim(user)) c eval *inlr = *on