* PUNCH ' SETCODE AC(1) ' *********************************************************************** * WRITTEN BY K.M. (SAM) BASS (SBASS,SJB,KBASS,KMB) * *********************************************************************** *--------------------------------------------------------------------* * STPCOND : SCANS ALL STEPS, EXTRACTS CONDITION CODES * * SENDS COND CODES TO TSO USER AND/OR BRODCAST * * * * //STPCOND EXEC PGM=STPCOND,PARM=USERID * * IF PARM FIELD IS MISSING, IT USES RACF USERID OF * * THE JOB, IF NONE FOUND, THEN ERROR. * * * * ATTRIBUTES: RENT, REUS * * * * WRITTEN BY: SAM BASS * * CHANGE LOG: 94/02/10 SAM BASS - USE SWAREQ * * * * NOTES: NEEDS SYS1.MACLIB AND SYS1.MODGEN * * * *--------------------------------------------------------------------* STPCOND TITLE ' STEP CONDITION CODE DRIVER PROGRAM' STPCOND AMODE 31 STPCOND RMODE 24 STPCOND CSECT SAVE (14,12),T,STPCOND_&SYSDATC._&SYSTIME USING STPCOND,R12 LR R12,R15 LR R10,R1 STORAGE OBTAIN,SP=1,LENGTH=LWORK,LOC=BELOW ST R1,8(,R13) ST R13,4(,R1) LR R13,R1 USING WORK,R13 * LA R0,8(,R1) ZERO GOTTEN STORAGE LA R1,LWORK-8 LA R15,0 MVCL R0,R14 ZERO WORK AREA SPACE 2 MVC LWAWTO1(WTO1L),WTO1 MOVE IN WTO MVC LWACALL1(CALL1L),CALL1 MOVE IN CALL MVC LWAXTRC1(XTRC1L),XTRC1 MOVE IN CALL LA R1,LWAMSG LOAD UP PARAMETER ST R1,LWAMSGA STORE IT OI LWAMSGA,X'80' LAST ENTRY FLAG EJECT L R1,0(,R10) GET PARM ADDR LH R2,0(,R1) GET LENGTH LTR R2,R2 IS THERE A PARM? BNP TRYRACF NO -- CONTINUE CL R2,=F'7' SEE IF LENGTH IS 7 BH ERROR2 GREATER THAN 7 LA R3,2(,R1) LOAD A(USERID) B PARMOK AND CONTINUE SPACE 2 *--------------------------------------------------------------------* * SINCE NO PARAMETER WAS SPECIFIED, ATTEMPT TO SEND MESSAGES * * TO THE "OWNING" USER (AS VIEWED BY THE SECURITY SYSTEM). * *--------------------------------------------------------------------* TRYRACF DS 0H L R15,PSAAOLD-PSA LOAD A(ASCB) L R15,ASCBASXB-ASCB(,R15) A(ASXB) AND L R15,ASXBSENV-ASXB(,R15) A(ACEE) LTR R15,R15 ACEE AVAILABLE? RACF BZ ERROR1 NO -- CONTINUE RACF SLR R2,R2 CLEAR THE REGISTER AND RACF IC R2,ACEEUSRL-ACEE(,R15) INSERT USERID LENGTH RACF LA R3,ACEEUSRI-ACEE(,R15) LOAD USERID ADDRESS AND RACF B PARMOK CONTINUE PROCESSING RACF SPACE 2 ERROR1 DS 0H WTO 'USERID NOT ON PARM= ',ROUTCDE=11 B ERRRET SPACE 2 ERROR2 DS 0H WTO 'USERID > 7 CHARACTERS',ROUTCDE=11 B ERRRET SPACE 2 ERRRET DS 0H LR R1,R13 L R13,4(,R13) STORAGE RELEASE,SP=1,ADDR=(1),LENGTH=LWORK RETURN (14,12),RC=4 EJECT PARMOK DS 0H R2 =LENGTH, R3= @ OF USERID MVC LWAUSER,=CL8' ' ST R2,LWAUSERL BCTR R2,0 -1 FOR MOVE MVC LWAUSER(0),0(R3) MOVE IN USERID EX R2,*-6 MOVE ALL OF IT PARMOK1 DS 0H MVI LWAFLAG,X'00' CLEAR FLAG TESTAUTH FCTN=1,STATE=YES,RBLEVEL=1 LTR R15,R15 BNZ NOTAUTH NOT AUTHORIZED OI LWAFLAG,$AUTH NOTAUTH DS 0H *--------------------------------------------------------------------* * MAIN STEP LOOP * *--------------------------------------------------------------------* L R1,PSATNEW-PSA GET TCB NEW L R1,TCBJSCB-TCB(,R1) GET JSCB L R1,JSCBACT-JSCB(,R1) GET JSCB ACTIVE L R1,JSCBJCT-JSCB(,R1) GET JCT SVA 00FFFFFF L R15,=V(SWAREQ) *--------------------------- * BALR R14,R15 * R1 = SVA 00FFFFFF FMT * LTR R15,R15 * CALL SWAREQ TO CONVERT SVA * BNZ SWAERROR * R1 = CONVERTED SVA, NOPREF * LR R4,R1 *--------------------------- * * USING JCTDSECT,R4 USING SCTDSECT,R5 ICM R1,B'0111',JCTSDKAD GET SCT SVA BZ ERR2 LA R10,0 SCTLOOP DS 0H R1 = SVA OF SCT 00FFFFFF FMT LA R10,1(,R10) ADD 1 TO STEP CL R10,=F'256' MAX STEPS = 255 * BNL RETURN1 SPACE 1 R1 = SVA OF SCT L R15,=V(SWAREQ) *--------------------------- * BALR R14,R15 * R1 = SVA 00FFFFFF FMT * LTR R15,R15 * CALL SWAREQ TO CONVERT SVA * BNZ SWAERROR * R1 = CONVERTED SVA, NOPREF * LR R5,R1 *--------------------------- * * MVC $JOBN(8),JCTJNAME MOVE IN JOBNAME MVC $PROCN(8),SCTSCLPC MOVE IN PROC NAME MVC $STEPN(8),SCTSNAME MOVE IN STEP NAME STEPNLST DS 0H ICM R1,B'0111',SCTANSCT IS THIS THE LAST STEP BZ LASTSTEP YES, DONT PROCESS LAST STEP TM SCTCATCT+2+4,X'C0' HAS THIS STEP FINISHED BO STEPOK YES B NEXTSTEP * STEPOK DS 0H XR R1,R1 CLEAR R1 ICM R1,B'0011',SCTSEXEC MOVE IN STEP.COND.CODE/PARM LEN ST R1,LWARC MOVE IN STEP.COND.CODE * TM SCTABCND,SCTABEND DID THIS STEP ABEND BZ NOABEND NOPE MVC LWARC,JCTACODE YES, MOVE IN POSSIBLE ABND CODE NOABEND DS 0H * XR R1,R1 CLEAR R1 IC R1,SCTSNUMB IC IN STEP NUMBER ST R1,LWASTEP SAVE STEP NUMBER * CLC LWAHIRC,LWARC IS THIS ONE HIGHER BH HIRC10 NO MVC LWAHIRC,LWARC YES MVC LWAHISTP,LWASTEP YES HIRC DS 0H TM LWAFLAG,$HIGH BZ HIRC10 MVC LWARC,LWAHIRC HERE ONLY IF LAST STEP MVC $STEP#(4),BLANKS MVC $HIGHRC(18),=CL(18)' -- HIGHEST RC --' MVC LWASTEP,LWAHISTP HIRC10 DS 0H * L R1,LWASTEP LOAD UP STEP # CVD R1,LWADEC CONVERT TO LWADEC MVC $STEP#(4),=X'40212020' ED $STEP#(4),LWADEC+6 PUT IT IN * TM LWARC,X'80' ABEND BO ABEND *--------------------------------------------------------------------* * SIMPLE RC= * *--------------------------------------------------------------------* L R1,LWARC LOAD UP STEP RC N R1,=A(X'00000FFF') SET MAX RC=4095 CVD R1,LWADEC MVC WORKAREA(6),=X'F02120202020' ED WORKAREA(6),LWADEC+5 MVC $STEPRC+1(4),WORKAREA+2 MVI $STEPRC,C' ' B RCFILL *--------------------------------------------------------------------* * ABENDS * *--------------------------------------------------------------------* ABEND DS 0H L R1,LWARC LOAD UP STEP RC N R1,=A(X'00FFF000') SEE IF SYS ABEND LTR R1,R1 BNZ ABENDS SYSTEM ABENDD B ABENDU USER ABEND SPACE 2 *--------------------------------------------------------------------* * SYSTEM ABEND * *--------------------------------------------------------------------* ABENDS DS 0H R1 POINT AT ABEND SRL R1,4*3 MOVE TO LOW 3 NIBBLES ST R1,LWADEC+4 UNPK $STEPRC+1(5),LWADEC+6(3) UNPK IT TR $STEPRC+1(4),TRANS-240 TRANSLATE IT MVI $STEPRC+5,C' ' MVI $STEPRC,C'S' USER THEN MVI $STEPRC+1,C' ' B RCFILL SPACE 2 *--------------------------------------------------------------------* * USER ABEND * *--------------------------------------------------------------------* ABENDU DS 0H L R1,LWARC LOAD UP STEP RC N R1,=A(X'00000FFF') ISOLATE USER ABEND CVD R1,LWADEC MVC WORKAREA(6),=X'F02021202020' ED WORKAREA(6),LWADEC+5 MVC $STEPRC+1(4),WORKAREA+2 MVI $STEPRC,C'U' B RCFILL *--------------------------------------------------------------------* * PUT '.USERID,' IN FRONT OF MESSAGE IN LWAMSGT * * (THIS NOT USED NOW) * *--------------------------------------------------------------------* RCFILL DS 0H MVI LWAMSGT,C' ' BLANK IT OUT MVC LWAMSGT+1(L'LWAMSGT-1),LWAMSGT ... LA R9,LWAMSGT MVI 0(R9),C'.' LA R9,1(,R9) POINT PASSED '.' L R2,LWAUSERL USERID LENGTH BCTR R2,0 -1 MVC 0(*-*,R9),LWAUSER MOVE EX R2,*-6 USERID IN LA R9,1(R2,R9) POINT PASSED USERID MVI 0(R9),C',' LA R9,1(,R9) POINT PASSED ',' MVC 0($MSGL,R9),$MSGBEG MOVE IN MESSAGE FROM WTO MSG MVC LWAMSG(2),=AL2(L'LWAMSGT) *--------------------------------------------------------------------* * GET DATE * *--------------------------------------------------------------------* TIME DEC ST R1,LWAJULN LA R1,LWAJULN BAL R14,JULNGREG MVC $DATE,LWAGREG *--------------------------------------------------------------------* * PUT OUT WTO/TPUT * *--------------------------------------------------------------------* TM LWAFLAG,$HIGH+$AUTH AUTHORIZED AND 'HIGHEST RC' BO NOTIFY YES WTO MF=(E,LWAWTO1) TPUT $MSGBEG,$MSGL,EDIT,NOWAIT,NOHOLD,USERIDL=LWAUSER B NEXTSTEP NOTIFY DS 0H HERE ONLY IF SENDING LAST MSG BAL R14,SENDMSG GO SEND MSG VIA NOTIFY B RETURN2 NEXTSTEP DS 0H ICM R1,B'0111',SCTANSCT GET NEXT SCT ADDRESS BZ RETURN1 B SCTLOOP * LASTSTEP DS 0H RETURN1 DS 0H TM LWAFLAG,$HIGH BO RETURN2 OI LWAFLAG,$HIGH B HIRC RETURN2 DS 0H LR R1,R13 L R13,4(,R13) STORAGE RELEASE,SP=1,ADDR=(1),LENGTH=LWORK RETURN (14,12),RC=0 ERR2 DS 0H WTO 'STPCND JCT NOT FOUND',ROUTCDE=11 B RETURN2 SWAERROR DS 0H WTO 'STPCND SWAREQ ERROR',ROUTCDE=11 B RETURN2 EJECT *--------------------------------------------------------------------* * DATE SUBROUTINE * *--------------------------------------------------------------------* SPACE 3 *--------------------------------------------------------------------* * CONVERT JULNGREG DATE TO GREGORIAN * *--------------------------------------------------------------------* JULNGREG DS 0H *--------------------------------------------------------------------* * R1 = DATE IN YYDDDF FORMAT * *--------------------------------------------------------------------* STM R14,R12,LWASAVE2+12 LR R7,R1 ZAP LWADEC(8),=P'0' MVO LWADEC+6(2),1(1,R7) OI LWADEC+7,X'0F' CVB R1,LWADEC ST R1,LWAFYY SPACE 1 *--------------------------------------------------------------------* * DETERMINE IF LEAP YEAR * *--------------------------------------------------------------------* NI LWAFLAG,255-$LEAP SPACE 1 L R1,LWAFYY SLR R0,R0 D R0,=F'4' LEAP YEAR LTR R0,R0 ANY REMAINDER BNZ JULN0100 NO, NOT LEAP OI LWAFLAG,$LEAP SET LEAP YEAR B JULN0100 * SPACE 3 JULN0100 DS 0H ZAP LWADEC,=P'0' MVC LWADEC+6(2),2(R7) MOVE IN DDDF PORTION OI LWADEC+7,X'0F' CVB R1,LWADEC ST R1,LWAFDDD SPACE 2 *--------------------------------------------------------------------* * DETERMINE MONTH AND DAY OF MONTH * *--------------------------------------------------------------------* LA R0,12 # OF MONTHS LA R1,1 WHICH MONTH LA R2,DAYSNMTH DAYS IN MONTH TABLE LA R3,0 SUM REG SPACE 2 JULN0120 DS 0H LR R15,R3 SAVE PREV SUM AH R3,0(,R2) TM LWAFLAG,$LEAP LEAP YEAR BZ JULN0130 NO CL R1,=F'2' FEBRUARY BNE JULN0130 NO LA R3,1(,R3) YES +1 JULN0130 DS 0H C R3,LWAFDDD IN THIS MONTH BNL JULN0180 >= LR R15,R3 LA R1,1(,R1) NEXT MONTH INDEX LA R2,2(,R2) NEXT MONTH IN TABLE BCT R0,JULN0120 BCTR R1,0 -1 (13 MONTH) JULN0180 DS 0H ST R1,LWAFMM SAVE MONTH LR R3,R15 # DAYS TO START OF MONTH L R1,LWAFDDD GET JULIAN DATE SR R1,R3 - 1ST DAY OF MONTH ST R1,LWAFDD DAY OF MONTH SPACE 3 *--------------------------------------------------------------------* * GOT YY=LWAFYY, MM=LWAFMM, DD=LWAFDD * *--------------------------------------------------------------------* JULN0200 DS 0H MVC LWAGREG,BLANKS SPACE 1 L R1,LWAFMM # OF MONTH CVD R1,LWADEC OI LWADEC+7,X'0F' UNPK LWADEC+8(03),LWADEC+6(2) MVC LWAGMM(2),LWADEC+9 MVI LWAGMM+2,C'/' SPACE 1 L R1,LWAFDD DAY OF MONTH CVD R1,LWADEC OI LWADEC+7,X'0F' UNPK LWADEC+8(03),LWADEC+6(2) MVC LWAGDD(2),LWADEC+9 MVI LWAGDD+2,C'/' SPACE 1 L R1,LWAFYY YEAR CVD R1,LWADEC OI LWADEC+7,X'0F' UNPK LWADEC+8(03),LWADEC+6(2) MVC LWAGYY(2),LWADEC+9 MVI LWAGYY+2,C' ' SPACE 1 B JULNRC00 JULNRC00 DS 0H LM R14,R12,LWASAVE2+12 BR R14 SPACE 1 DAYSNMTH DC H'031,028,031,030,031,030' DC H'031,031,030,031,030,031' DAYSNMTHL EQU *-DAYSNMTH EJECT *--------------------------------------------------------------------* * ISSUE SEND COMMAND * *--------------------------------------------------------------------* SENDMSG DS 0H STM R14,R12,LWASAVE2+12 TM LWAFLAG,$AUTH BZ SMSGRET MVC SENDBFR,BLANKS LA R1,L'SENDBFR SLL R1,16 MOVE TO HI HALF ST R1,SENDMLEN SAVE LENGTH AND FLAGS SPACE 2 LA R2,SENDBFR BUILD SEND AROUND MSG MVC 0(07,R2),=C'SEND ''+' LA R2,7(,R2) MVC 0($MSGL,R2),$MSGBEG MOVE IN MSG LA R2,$MSGL(,R2) MVC 0(08,R2),=C''',USER=(' LA R2,8(,R2) MVC 0(7,R2),LWAUSER LA R3,8 SEND100 DS 0H CLI 0(R2),C' ' FIND END OF BE SEND120 USERID LA R2,1(,R2) NEXT CHAR BCT R3,SEND100 SEND120 DS 0H MVC 0(08,R2),=C'),LOGON ' END PAREN. LA R1,$MSGBEG * MODESET KEY=ZERO GET KEY ZERO FOR MGCR LA R1,SENDMLEN SET UP PARM. LIST ADDR. SLR R0,R0 SET OPERATION CODE SVC 34 ISSUE MGCR SVC * MODESET KEY=NZERO GET KEY ZERO FOR MGCR SMSGRET DS 0H LM R14,R12,LWASAVE2+12 SLR R15,R15 ZERO RETURN CODE BR R14 EJECT *--------------------------------------------------------------------* * DATA AREAS * *--------------------------------------------------------------------* DC 0D'0' CALL1 CALL ,(,),VL,MF=L CALL STPCND CALL1L EQU *-CALL1 SPACE 2 XTRC1 EXTRACT 0,'S',FIELDS=(TIOT),MF=L XTRC1L EQU *-XTRC1 SPACE 2 * 0 1 2 3 4 5 * 0123456789012345678901234567890123456789012345678901234 WTO1 WTO ' ### JJJJJJJJ.PPPPPPPP.SSSSSSSS MM/DD/YY RC=ZXXXX . ',DESC=7,ROUTCDE=(11),MF=L WTO1L EQU *-WTO1 $MSGL EQU WTO1L-4-4 $MSGBEG EQU LWAWTO1+4,$MSGL $STEP# EQU LWAWTO1+4+01,4 $JOBN EQU LWAWTO1+4+07,8 $PROCN EQU LWAWTO1+4+16,8 $STEPN EQU LWAWTO1+4+25,8 $DATE EQU LWAWTO1+4+35,8 $STEPRC EQU LWAWTO1+4+48,4 $HIGHRC EQU $PROCN-1,18 SPACE 2 TRANS DC C'0123456789ABCDEF' BLANKS DC CL120' ' SPACE 2 DC 0D'0' LTORG , DC 0D'0' EJECT WORK DSECT LWASAVE1 DC 18F'0' LWASAVE2 DC 18F'0' LWADEC DC D'0' DC D'0' SPACE 2 LWASTEP DC F'0' STEP # LWARC DC F'0' STEP RC LWASEND DC A(0) LOADED PGM ADDR LWAHIRC DC F'0' HIGHEST RC LWAHISTP DC F'0' HIGHEST RC STEP # LWACALL1 DC CL(CALL1L)' ' CALL STPCND SPACE 2 WORKAREA DC CL10' ' LWAWTO1 DC CL(WTO1L)' ' WTO LWAMSGA DC F'0' CNOP 2,4 LWAMSG DC 0CL($MSGL+10+2)' ' DC H'0' LWAMSGT DC CL($MSGL+10)' ' MSG SPACE 1 SENDWA DC 0D'0' SENDMLEN DC H'0' MGCR PREFIX AND TEXT LENGTH SENDMFLG DC H'0' MGCR FLAGS (SET TO ZERO) SENDBFR DC CL(120)' ' MGCR TEXT AREA SENDWL EQU *-SENDWA DSECT LENGTH SPACE 1 LWAFLAG DC XL1'00' $LEAP EQU X'01' $HIGH EQU X'02' $AUTH EQU X'04' LWAUSERL DC F'0' LWAUSER DC CL8' ' SPACE 1 LWAFYY DC F'0' YEAR LWAFDDD DC F'0' JULIAN DAY LWAFMM DC F'0' MONTH LWAFDD DC F'0' DAY OF MONTH LWAJULN DC F'0' 00YYDDDF SPACE 1 LWAGREG DC 0CL(LWAGREGL)' ' GREG. DATE LWAGMM DC CL2' ',C'/' | LWAGDD DC CL2' ',C'/' | LWAGYY DC CL2' ',C' ' | LWAGREGL EQU *-LWAGMM | DC F'0' LWAXTRC1 DC CL(XTRC1L)' ' LWATIOT DC F'0' DC 0D'0' LWORK EQU *-WORK EJECT *--------------------------------------------------------------------* * IBM DSECTS * *--------------------------------------------------------------------* IKJTCB , TCB SPACE 3 ---------------- IEZJSCB , JSCB JSCB EQU IEZJSCB SPACE 3 ---------------- JCTDSECT DSECT IEFAJCTB JCT SPACE 3 ---------------- SCTDSECT DSECT IEFASCTB SCT SPACE 3 ---------------- IHAPSA PSA RACF SPACE 3 ---------------- IHAASCB ASCB RACF SPACE 3 ---------------- IHAASXB ASXB RACF SPACE 3 ---------------- IHAACEE ACEE RACF SPACE 3 ---------------- YREGS END STPCOND