Page History
The JSMDIRECT program calls CL program JSMDRTEXT when the following life cycle events occur:
ENTRY | Program starts. |
EXIT | Program finishes successfully. |
ERRnnnn | where nnnn is a 4 digit number starting from 3000. |
The JSMDRTEXT program reads the JSMDRTDTA data area to get any libraries that need to be added to the current CGI job before the JSMLSAEXT/LANSA program is called. Blank library entries are ignored.
...
The data area is 2000 bytes in size and the layout is:
1-10 | Library (LANSA Program Library) |
11-10 | Library (LANSA Shared Library) |
21-10 | Library |
xx-10 | Libraries... |
1991-10 | Library |
The source code for this exit program is stored in QCLSRC in the JSM library.
...
/* JSMDIRECT EXIT PROGRAM */
...
PGM PARM(&EVENT &SERVICE &SERVERHOST &HOST &PORT +
...
&REMOTEUSER &REMOTEADDR &CONTINUE &MESSAGE)
...
DCL VAR(&EVENT) TYPE(*CHAR) LEN(10)
...
DCL VAR(&SERVICE) TYPE(*CHAR) LEN(30)
...
DCL VAR(&SERVERHOST) TYPE(*CHAR) LEN(80)
...
DCL VAR(&HOST) TYPE(*CHAR) LEN(80)
...
DCL VAR(&PORT) TYPE(*CHAR) LEN(5)
...
DCL VAR(&REMOTEUSER) TYPE(*CHAR) LEN(30)
...
DCL VAR(&REMOTEADDR) TYPE(*CHAR) LEN(45)
...
DCL VAR(&CONTINUE) TYPE(*CHAR) LEN(1)
...
DCL VAR(&MESSAGE) TYPE(*CHAR) LEN(256)
...
DCL VAR(&JOBNAME) TYPE(*CHAR) LEN(10)
...
DCL VAR(&JOBUSER) TYPE(*CHAR) LEN(10)
...
DCL VAR(&JOBNUMBER) TYPE(*CHAR) LEN(6)
...
DCL VAR(&JOBCMD) TYPE(*CHAR) LEN(50)
...
DCL VAR(&JOBMSG) TYPE(*CHAR) LEN(100)
...
DCL VAR(&JOBCHGSTS) TYPE(*CHAR) LEN(7) VALUE(OK)
...
DCL VAR(&TMPLIB) TYPE(*CHAR) LEN(10)
...
DCL VAR(&TMPLIBPOS) TYPE(*DEC) LEN(5)
...
DCL VAR(&TMPLIBLIST) TYPE(*CHAR) LEN(2000)
...
DCL VAR(&CTIME) TYPE(*CHAR) LEN(6)
...
DCL VAR(&REQUESTID) TYPE(*CHAR) LEN(24)
...
MONMSG MSGID(CPF0000)
...
/* RETRIEVE LIBRARIES */
...
RTVDTAARA DTAARA(JSMDRTDTA (1 2000)) RTNVAR(&TMPLIBLIST)
...
IF COND(&EVENT *EQ 'ENTRY') THEN(DO)
...
/* DEFAULT VALUE FOR CONTINUE IS 'Y' */
...
/* CHGVAR VAR(&CONTINUE) VALUE('N') */
...
/* CHGVAR VAR(&MESSAGE) VALUE('I do not know you') */
...
/* GOTO END */
...
/* PREPARE JOB FOR CURRENT SERVICE */
...
/* CALLSUBR SUBR(LOGSTR) */
...
CALLSUBR SUBR(ADDLIB)
...
GOTO END
...
ENDDO
IF COND(&EVENT *EQ 'EXIT') THEN(DO)
...
/* RESTORE JOB FOR NEXT SERVICE */
...
CALLSUBR SUBR(RMVLIB)
...
/* CALLSUBR SUBR(LOGEND) */
...
GOTO END
...
ENDDO
IF COND(%SUBSTRING(&EVENT 1 3) *EQ 'ERR') THEN(DO)
...
/* LOG ERROR */
...
CALLSUBR SUBR(LOGERR)
...
CALLSUBR SUBR(RMVLIB)
...
/* CALLSUBR SUBR(LOGEND) */
...
GOTO END
...
ENDDO
/* =================================================================== */
...
/* SUBROUTINES */
...
/* =================================================================== */
...
SUBR SUBR(LOGSTR)
...
/* REQUEST ID */
...
CALL PGM(GETREQID) PARM(&REQUESTID)
...
/* START TIME */
...
SNDPGMMSG MSG('============ START ============')
...
RTVSYSVAL SYSVAL(QTIME) RTNVAR(&CTIME)
...
CHGVAR VAR(&JOBMSG) VALUE('JSMDRTEXT START' *BCAT &CTIME)
...
SNDPGMMSG MSGID(CPF9897) MSGF(QCPFMSG) MSGDTA(&JOBMSG)
...
SNDPGMMSG MSGID(CPF9897) MSGF(QCPFMSG) MSGDTA(&REQUESTID)
...
SNDPGMMSG MSGID(CPF9897) MSGF(QCPFMSG) MSGDTA(&SERVICE)
...
/* CALL PGM(JSMTRCENV) */
...
ENDSUBR
SUBR SUBR(LOGEND)
...
/* END TIME */
...
RTVSYSVAL SYSVAL(QTIME) RTNVAR(&CTIME)
...
CHGVAR VAR(&JOBMSG) VALUE('JSMDRTEXT END' *BCAT &CTIME)
...
SNDPGMMSG MSGID(CPF9897) MSGF(QCPFMSG) MSGDTA(&JOBMSG)
...
SNDPGMMSG MSG('============= END =============')
...
ENDSUBR
SUBR SUBR(ADDLIB)
...
/* ADD LIBRARIES FOR JSMLSAEXT AND LANSA CALL */
...
CHGVAR VAR(&TMPLIBPOS) VALUE(1)
...
ADDLIB:
...
CHGVAR VAR(&TMPLIB) VALUE(%SST(&TMPLIBLIST &TMPLIBPOS 10))
...
IF (&TMPLIB *EQ ' ' ) THEN(RTNSUBR)
...
ADDLIBLE LIB(&TMPLIB) POSITION(*LAST)
...
RCVMSG MSGQ(*PGMQ) /* CPF2104, CPF2110, CPF2196 CPF2197 */
...
CHGVAR VAR(&TMPLIBPOS) VALUE(&TMPLIBPOS + 10)
...
IF (&TMPLIBPOS *GE 2000) THEN(RTNSUBR)
...
GOTO ADDLIB
...
ENDSUBR
SUBR SUBR(RMVLIB)
...
/* REMOVE LIBRARIES */
...
CHGVAR VAR(&TMPLIBPOS) VALUE(1)
...
RMVLIB:
...
CHGVAR VAR(&TMPLIB) VALUE(%SST(&TMPLIBLIST &TMPLIBPOS 10))
...
IF (&TMPLIB *EQ ' ' ) THEN(RTNSUBR)
...
RMVLIBLE LIB(&TMPLIB)
...
RCVMSG MSGQ(*PGMQ) /* CPF2104, CPF2110, CPF2196 CPF2197 */
...
CHGVAR VAR(&TMPLIBPOS) VALUE(&TMPLIBPOS + 10)
...
IF (&TMPLIBPOS *GE 2000) THEN(RTNSUBR)
...
GOTO RMVLIB
...
ENDSUBR
SUBR SUBR(LOGERR)
...
/* LOG ERROR EVENT */
...
SNDPGMMSG MSG('------- JSMDIRECT ERROR -------')
...
SNDPGMMSG MSGID(CPF9897) MSGF(QCPFMSG) MSGDTA(&EVENT)
...
SNDPGMMSG MSGID(&EVENT) MSGF(JSMMSGF)
...
SNDPGMMSG MSGID(CPF9897) MSGF(QCPFMSG) MSGDTA(&SERVICE)
...
SNDPGMMSG MSGID(CPF9897) MSGF(QCPFMSG) MSGDTA(&SERVERHOST)
...
SNDPGMMSG MSGID(CPF9897) MSGF(QCPFMSG) MSGDTA(&REMOTEUSER)
...
SNDPGMMSG MSGID(CPF9897) MSGF(QCPFMSG) MSGDTA(&REMOTEADDR)
...
SNDPGMMSG MSG('-------------------------------')
...
/* CREATE MESSAGE - WRKJOB JOB(464971/QTMHHTTP/JSMINST) */
...
RTVJOBA JOB(&JOBNAME) USER(&JOBUSER) NBR(&JOBNUMBER)
...
CHGVAR VAR(&JOBCMD) VALUE('WRKJOB JOB(' *TCAT +
...
&JOBNUMBER *TCAT '/' *TCAT +
...
&JOBUSER *TCAT '/' *TCAT +
...
&JOBNAME *TCAT ')' )
...
CHGVAR VAR(&JOBMSG) VALUE('JSMDirect error, use command' *BCAT &JOBCMD)
...
/* SNDMSG MSG(&JOBMSG) TOUSR(*SYSOPR) */
...
ENDSUBR
SUBR SUBR(CHGJOB)
...
CALL PGM(JSMCHGJOB) PARM(&JOBCHGSTS)
...
IF COND(&JOBCHGSTS *NE 'OK') THEN(DO)
...
CHGVAR VAR(&JOBMSG) VALUE('Change job exception' *BCAT +
...
&JOBCHGSTS)
...
SNDPGMMSG MSGID(CPF9897) MSGF(QCPFMSG) MSGDTA(&JOBMSG)
...
ENDDO
...
ENDSUBR
END: ENDPGM