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