/********************************************************************/ /* CHECK USER JOBS - CHKUSRJOBS */ /* */ /* */ /* */ /* */ /*==================================================================*/ /* */ /* THIS PROGRAM IS BROKEN INTO TWO PROCESSING COMPONENTS */ /* */ /* 1) IBM CODE TO COUNT ACTIVE SESSIONS */ /* 2) New CODE TO ANALYZE THE ACTIVE SESSIONS */ /* */ /* IBM GAVE US SOME CODE THAT DETERMINES IF THE USERS IS TRYING TO */ /* ACCESS AN ILLEGAL SESSION (MORE THAN 1). THE END RESULT IS */ /* TURNING ON A &SESSLIMIT FLAG, WHICH INDICATES THE USER IS */ /* SIGNING ON AGAIN (AFTER A HUNG SESSION OR THEY HAVE FORGOTTEN */ /* ABOUT THE FIRST SESSION. THE &SESSLIMIT FLAG IS USED TO */ /* continue prOCESSING, WHICH IS DETAILED BELOW */ /* */ /* */ /* THIS PROGRAM IS USED TO CHECK TO SEE IF USERS INADVERTENTLY HAVE */ /* OR INCORRECTLY HAVE MULTIPLE SESSIONS. THAT IS, IF THE USER */ /* HAS AN OLD SESSION STILL ACTIVE IN THE SYSTEM, WE WILL KILL THE */ /* SESSIONS AND FORCE THE USER TO RESIGN ON. THIS PROGRAM WAS */ /* A RESULT OF THE FIELD FLOODING THE help desk with CALLS TO KILL */ /* OLD SESSIONS DURING THE SIGN ON PROCESS. */ /* */ /* THIS PROGRAM UTILIZES THE WRKUSRJOB COMMAND (*PRINT OPTION) AND */ /* COPIES THE COMMAND OUTPUT FROM SPOOL TO A USRJOBS PHYSICAL FILE.*/ /* THIS FILE IS THEN READ BY AN RPG PROGRAM, WHICH SENDS PERTINENT */ /* SESSIONS DATA BACK TO THIS CL PROGRAM. IF NO MULTIPLE SESSIONS */ /* EXIST, WE WILL SIGN ON AS NORMAL. IF A MULTIPLE SESSION DOES EXIST,*/ /* WE WILL DETERNINE OUR CURRENT SESSIONS (THE ONE WE ARE SIGNING */ /* ON AS, AND SIMPLY DO A ENDJOB ON THE OLD SESSION. */ /* */ /* CHKJOBS: RPG PROGRAM THAT CHECKS THE USRJOBS FILE TO INVENTORY */ /* JOBS ASSOCIATED WITH EACH USER. */ /*==================================================================*/ /* MODIFICATIONS: */ /* */ /* */ /* DATE PROGRAMMER EXPLANATION OF CHANGE */ /* */ /********************************************************************/ /* THIS DESCRIBES THE IBM CODE: */ /* NAME: Q$$CHKSES */ /* */ /* PURPOSE: CHECKS THE NUMBER OF ACTIVE INTERACTIVE SESSIONS FOR */ /* A SPECIFIED USER. IF THAT USER HAS MORE ACTIVE */ /* SESSIONS THAN DEFINED BY THE VALUE OF THE PARAMETER */ /* PASSED TO THIS PROGAM THEN THE USER IS SENT A BREAK */ /* MESSAGE NOTIFYING HIM OF THAT. WHEN HE SIGNS OFF THEN */ /* HIS JOB DOES A SIGNOFF AND HE GETS A NEW SIGNON SCREEN.*/ /* */ /* NOTE THAT THIS PROGRAM IS NOT SUPPORTED BY IBM */ /* . */ /* THIS PROGRAM MAY CALLED VIA THE CALLING CALL SEQUENCE: */ /* CALL PGM(*LIBL/CHKUSRJOBS) PARM(X'00001C') */ /* |--> INDICATES 1 */ /* SESSION ALLOWED */ /* WHERE LIBNAM IS THE NAME OF THE LIBRARY */ /* PARM IS A DECIMAL VARIABLE FIELD. THE FOLLOWING */ /* ILLUSTRATES CODE THAT MAY BE USED TO DEFINE THE */ /* VARIABLE WITH A VALUE OF 2 AND THEN THE CALL TO */ /* THIS PROGRAM: */ /* DCL VAR(&MAX) TYPE(*DEC) LEN(5 0) VALUE(2) */ /* CALL PGM(PGMLIBX/Q$$CHKSES) PARM(&MAX) */ /* */ /* */ /* NOTE THAT 4 COMMENT LINES HAVE BEEN ADDED WHICH SHOWED THE */ /* NUMBER OF EMBEDDED BLANKS THAT NEEDED TO BE INCLUDED IN */ /* QUOTED STRINGS. EACH 'B' IN THOSE EXAMPLE LINES REPRESENT */ /* */ /* */ /* */ /* */ /* */ /***END OF SPECIFICATIONS********************************************/ PGM PARM(&MAX) DCLF FILE(CHKUSRJOBS) DCL VAR(&SESSLIMIT) TYPE(*CHAR) LEN(1) DCL VAR(&MAX) TYPE(*DEC) LEN(5 0) DCL VAR(&USRNAME) TYPE(*CHAR) LEN(10) DCL VAR(&USRNAME2) TYPE(*CHAR) LEN(4) DCL VAR(&JOB) TYPE(*CHAR) LEN(10) DCL VAR(&FORMAT) TYPE(*CHAR) LEN(8) + VALUE('JOBL0100') DCL VAR(&JOBNAME) TYPE(*CHAR) LEN(26) + VALUE('*ALL *ALL ') DCL VAR(&STATUS) TYPE(*CHAR) LEN(10) VALUE(*ACTIVE) DCL VAR(&JOBTYPE) TYPE(*CHAR) LEN(1) VALUE('I') DCL VAR(&ERRCODE) TYPE(*CHAR) LEN(8) + VALUE(X'0000000000000000') DCL VAR(&COUNT) TYPE(*DEC) LEN(5 0) DCL VAR(&USRSPC) TYPE(*CHAR) LEN(20) + VALUE('XTEMPSPACEQTEMP ') DCL VAR(&NUMENTB) TYPE(*CHAR) LEN(4) DCL VAR(&NUMENT) TYPE(*DEC) LEN(8 0) DCL VAR(&GENHDR) TYPE(*CHAR) LEN(140) DCL VAR(&SYSNAME) TYPE(*CHAR) LEN(8) DCL VAR(&TRIES) TYPE(*DEC) LEN(2) DCL VAR(&MSGCOUNT) TYPE(*DEC) LEN(2) DCL VAR(&SESSLIMIT) TYPE(*CHAR) LEN(1) DCL VAR(&CURJOBNAME) TYPE(*CHAR) LEN(10) DCL VAR(&CURJOBUSER) TYPE(*CHAR) LEN(10) DCL VAR(&CURJOBNBR) TYPE(*CHAR) LEN(6) DCL VAR(&JOBNAME1) TYPE(*CHAR) LEN(10) DCL VAR(&JOBUSER1) TYPE(*CHAR) LEN(10) DCL VAR(&JOBNBR1) TYPE(*CHAR) LEN(6) DCL VAR(&STATUS1) TYPE(*CHAR) LEN(7) DCL VAR(&JOBNAME2) TYPE(*CHAR) LEN(10) DCL VAR(&JOBUSER2) TYPE(*CHAR) LEN(10) DCL VAR(&JOBNBR2) TYPE(*CHAR) LEN(6) DCL VAR(&STATUS2) TYPE(*CHAR) LEN(7) DCL VAR(&JOBNAME3) TYPE(*CHAR) LEN(10) DCL VAR(&JOBUSER3) TYPE(*CHAR) LEN(10) DCL VAR(&JOBNBR3) TYPE(*CHAR) LEN(6) DCL VAR(&STATUS3) TYPE(*CHAR) LEN(7) DCL VAR(&NUMJOBS) TYPE(*DEC) LEN(1 00) DCL VAR(&GRPPRF) TYPE(*CHAR) LEN(10) /*******************************************************************/ /* CREATE THE USER SPACE */ /********************************************************************/ PROCED1: SETATNPGM PGM(*CURRENT) SET(*OFF) CHGVAR VAR(&SESSLIMIT) VALUE('N') CALL PGM(QUSCRTUS) PARM('XTEMPSPACEQTEMP ' ' + ' X'00000100' ' ' '*ALL ' ' ') MONMSG MSGID(CPF9870) + EXEC(GOTO CMDLBL(PROCED2)) /********************************************************************/ /* GET THE CURRENT USER NAME */ /********************************************************************/ PROCED2: RTVJOBA JOB(&JOB) USER(&USRNAME) /********************************************************************/ /* PUT RETRIEVED USERNAME INTO &JOBNAME VAR */ /********************************************************************/ CHGVAR VAR(%SST(&JOBNAME 11 10)) VALUE(&USRNAME) /********************************************************************/ /* CALL THE API TO GET THE JOB INFORMATION */ /********************************************************************/ CALL PGM(QUSLJOB) PARM(&USRSPC &FORMAT &JOBNAME + &STATUS &ERRCODE &JOBTYPE X'00000000' + X'00000000') MONMSG MSGID(CPF0000) EXEC(GOTO CMDLBL(ABORT)) /********************************************************************/ /* READ THE GENERIC HEADER FROM THE USER SPACE */ /********************************************************************/ CALL PGM(QUSRTVUS) PARM(&USRSPC X'00000001' + X'0000008C' &GENHDR) CHGVAR VAR(&NUMENTB) VALUE(%SST(&GENHDR 133 4)) CHGVAR VAR(&NUMENT) VALUE(%BIN(&NUMENTB)) CHGVAR VAR(&COUNT) VALUE(&NUMENT) /********************************************************************/ /* CHECK IF NO JOBS FOUND, IF NOT THEN EXIT EARLY */ /* THIS COULD HAPPEN IF THE PROGRAM WAS CALLED BY A BATCH JOB */ /********************************************************************/ IF COND(&COUNT *NE 0) THEN(GOTO CMDLBL(CHECKNUM)) SNDMSG MSG('NO JOBS FOUND FOR SPECIFIED USER') + TOUSR(&USRNAME) GOTO CMDLBL(ABORT) /********************************************************************/ /* CHECK IF TOO MANY JOBS FOR THIS USER */ /* INSTEAD OF SENDING MESSAGE FOR AN ILLEGAL SIGNON, WE WILL SET */ /* THE SESSION LIMIT FLAG TO YES - THIS WILL BE USED DURING THE */ /* END JOB ANALYSIS / PROCESS. */ /********************************************************************/ CHECKNUM: IF COND(&NUMENT *LE &MAX) THEN(GOTO + CMDLBL(CLEANUP)) CHGVAR VAR(&SESSLIMIT) VALUE('Y') GOTO CMDLBL(CHKUSRJOBS) /********************************************************************/ /* DELETE THE USER SPACE */ /********************************************************************/ CLEANUP: DLTUSRSPC USRSPC(QTEMP/XTEMPSPACE) /********************************************************************/ /* MONITOR FOR ERROR CAUSED BY USER SPACE NOT EXISTING */ /********************************************************************/ MONMSG MSGID(CPF2110) EXEC(GOTO CMDLBL(EXITPGM)) GOTO CMDLBL(EXITPGM) ABORT: SNDMSG MSG('JOB CHECK DID NOT COMPLETE + SUCCESSFULLY') TOUSR(*SYSOPR) GOTO CMDLBL(CLEANUP) /********************************************************************/ /* WE'VE DETERMINED USER HAS EXCEEDED THE SESSION LIMIT...WE */ /* DETERMINE IF ANY JOBS CAN BE DELETED... */ /********************************************************************/ CHKUSRJOBS: SNDPGMMSG MSG('STARTING CHKUSRJOBS') TOPGMQ(*SAME) CHKOBJ OBJ(*LIBL/USRJOBS) OBJTYPE(*FILE) MONMSG MSGID(CPF9801) EXEC(GOTO CMDLBL(OBJERR)) CLRPFM FILE(*LIBL/USRJOBS) RTVJOBA JOB(&CURJOBNAME) USER(&CURJOBUSER) + NBR(&CURJOBNBR) /********************************************************************/ /* DO A WRKUSRJOB TO SPOOL - THIS WILL BE USED AS INPUT */ /* FOR THE USRJOBSF FILE, WHICH IS READ BY THE CHKJOBS PGM TO */ /* DETERMINE IF THE MULTIPLE JOBS EXIST. */ /********************************************************************/ WRKUSRJOB USER(&CURJOBUSER) STATUS(*ACTIVE) + OUTPUT(*PRINT) RETRYSPLF: CPYSPLF FILE(QPDSPSBJ) TOFILE(*LIBL/USRJOBS) + SPLNBR(*LAST) MONMSG MSGID(CPF3482) EXEC(GOTO CMDLBL(CHKTRIES)) GOTO CMDLBL(COUNTJOBS) /********************************************************************/ /* IF UNABLE TO COPY THE FILE FOR ANY REASON, WE WILL TRY 10 TIMES */ /* BEFORE ERRORING OUT. IF A USER DID HAVE A SIGN-ON PROBLEM AT */ /* THIS POINT, THE ETAC WOULD NEED TO BE CALLED FOR A MANUAL */ /* CANCELATION OF THE JOB. (SYSTEM WAS ABNORMALLY BUSY) */ /********************************************************************/ CHKTRIES: IF COND(&TRIES *GT 10) THEN(DO) SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) + MSGDTA('CHKUSRJOB COULD NOT DETERMINE IF + DUPLICATE JOBS EXIST...') TOPGMQ(*EXT) + MSGTYPE(*INFO) GOTO CMDLBL(END) ENDDO CHGVAR VAR(&TRIES) VALUE(&TRIES + 1) DELAY: DLYJOB DLY(1) GOTO CMDLBL(RETRYSPLF) /********************************************************************/ /* CALLS CHKJOBS PROGRAM TO DETERMINE IF MULTIPLE JOBS ACTIVE... */ /*****************`**************************************************/ COUNTJOBS: USRJOBS: CALL PGM(*LIBL/CHKACTJOBS) PARM(&JOBNAME1 + &JOBUSER1 &JOBNBR1 &STATUS1 &JOBNAME2 + &JOBUSER2 &JOBNBR2 &STATUS2 &JOBNAME3 + &JOBUSER3 &JOBNBR3 &STATUS3 &NUMJOBS) /* SEE IF YOURSYSTEM OR Group Profile... */ RTVNETA SYSNAME(&SYSNAME) IF COND(&SYSNAME *EQ 'YOURSYSTEM') THEN(GOTO + CMDLBL(ALTSYS)) RTVUSRPRF GRPPRF(&GRPPRF) IF COND(&GRPPRF *EQ 'XXXXXX') THEN(GOTO + CMDLBL(ALTSYS)) GOTO CMDLBL(NOTYOURSYSTEM) /* IF USER HAS A ALT SYS REQ SESSION - ALLOW 2ND SIGN ON... */ ALTSYS: IF COND(&CURJOBNAME *EQ &JOBNAME1) THEN(DO) IF COND(&STATUS1 *EQ 'SYSREQ') THEN(GOTO + CMDLBL(EXIT)) ENDDO IF COND(&CURJOBNAME *EQ &JOBNAME2) THEN(DO) IF COND(&STATUS2 *EQ 'SYSREQ') THEN(GOTO + CMDLBL(EXIT)) ENDDO NOTYOURSYSTEM: IF COND(&SESSLIMIT *EQ 'Y') THEN(GOTO + CMDLBL(CHKJOBS)) GOTO CMDLBL(EXIT) CHKJOBS: SNDSCRN: RMVMSG CLEAR(*ALL) SNDRCVF RCDFMT(SESSWARN2) IF COND(&IN09 *EQ '1') THEN(GOTO + CMDLBL(DELETEOLD)) IF COND(&IN03 *EQ '1') THEN(GOTO + CMDLBL(DELETECUR)) IF COND(&IN12 *EQ '1') THEN(GOTO + CMDLBL(DELETECUR)) GOTO CMDLBL(SNDSCRN) DELETECUR: SNDBRKMSG MSG('Current sign on is canceled. Press + ENTER') TOMSGQ(&JOB) SIGNOFF GOTO CMDLBL(EXIT) DELETEOLD: IF COND(&CURJOBNBR *EQ &JOBNBR1) THEN(DO) ENDJOB JOB(&JOBNBR2/&JOBUSER2/&JOBNAME2) + OPTION(*IMMED) DELAY(1) + ADLINTJOBS(*GRPJOB) /* End immediately + with no spool or log entries! */ MONMSG MSGID(CPF1360 CPF1361 CPF1362) IF COND(&JOBNBR3 *GT ' ') THEN(DO) CHGVAR VAR(&JOBNAME3) VALUE(&JOBNAME2) CHGVAR VAR(&JOBUSER3) VALUE(&JOBUSER2) ENDJOB JOB(&JOBNBR3/&JOBUSER3/&JOBNAME3) + OPTION(*IMMED) DELAY(3) + ADLINTJOBS(*GRPJOB) /* end immediately + with no spool or log entries! */ MONMSG MSGID(CPF1360 CPF1361 CPF1362) ENDDO DLYJOB DLY(05) GOTO CMDLBL(EXIT) ENDDO IF COND(&CURJOBNBR *EQ &JOBNBR2) THEN(DO) ENDJOB JOB(&JOBNBR1/&JOBUSER1/&JOBNAME1) + OPTION(*IMMED) DELAY(3) + ADLINTJOBS(*GRPJOB) /* End immediately + with no spool or log entries! */ MONMSG MSGID(CPF1360 CPF1361 CPF1362) IF COND(&JOBNBR3 *GT ' ') THEN(DO) CHGVAR VAR(&JOBNAME3) VALUE(&JOBNAME1) CHGVAR VAR(&JOBUSER3) VALUE(&JOBUSER1) ENDJOB JOB(&JOBNBR3/&JOBUSER3/&JOBNAME3) + OPTION(*IMMED) DELAY(3) + ADLINTJOBS(*GRPJOB) /* End immediately + with no spool or log entries! */ MONMSG MSGID(CPF1360 CPF1361 CPF1362) ENDDO DLYJOB DLY(05) GOTO CMDLBL(EXIT) ENDDO IF COND(&CURJOBNBR *EQ &JOBNBR3) THEN(DO) ENDJOB JOB(&JOBNBR1/&JOBUSER1/&JOBNAME1) + OPTION(*IMMED) DELAY(3) + ADLINTJOBS(*GRPJOB) /* End immediately + with no spool or log entries! */ MONMSG MSGID(CPF1360 CPF1361 CPF1362) CHGVAR VAR(&JOBNAME2) VALUE(&JOBNAME1) CHGVAR VAR(&JOBUSER2) VALUE(&JOBUSER1) ENDJOB JOB(&JOBNBR2/&JOBUSER2/&JOBNAME2) + OPTION(*IMMED) DELAY(3) + ADLINTJOBS(*GRPJOB) /* End immediately + with no spool or log entries! */ MONMSG MSGID(CPF1360 CPF1361 CPF1362) DLYJOB DLY(05) ENDDO GOTO CMDLBL(EXIT) END: OBJERR: SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA('Sign on + ended abnormally - Critical file is + missing (USRJOBS). Call ETAC') + TOPGMQ(*EXT) MSGTYPE(*INFO) SIGNOFF GOTO CMDLBL(EXIT) EXITPGM: EXIT: SETATNPGM PGM(*CURRENT) SET(*ON) /*=== DLYJOB DLY(05) */ /********************************************************************/ /* WE CHECK FOR MESSAGE QUEUE ALLOCATION HERE..IF LOCK STATE EXISTS */ /* WE LOOP 10 TIMES OR UNTIL ALLOCATION OCCURS. IF NOT GOTO ENDPGM */ /********************************************************************/ CHKACTOBJ: CHKACTOBJ OBJ(QUSRSYS/&USRNAME) OBJTYPE(*MSGQ) /* Use + of this command allows checking of the + state of the user's message queue before + continuing. */ MONMSG MSGID(CPF2451 CPA0701 CPF9898 CPF9999) + EXEC(GOTO CMDLBL(CHECKIT)) /* Message + indicates object still locked..goto retry + section. */ GOTO CMDLBL(CHGMSGQ) /* No lock!..Continue with + signon processing. */ CHECKIT: IF COND(&TRIES *GT 10) THEN(DO) GOTO CMDLBL(ENDPGM) /* Bypass message queue + allocation and end program! */ ENDDO CHGVAR VAR(&TRIES) VALUE(&TRIES + 1) DELAY1: DLYJOB DLY(1) GOTO CMDLBL(CHKACTOBJ) CHGMSGQ: RTVJOBA USER(&USRNAME) CHGMSGQ MSGQ(&USRNAME) DLVRY(*BREAK) ENDPGM: ENDPGM