ISREDIT MACRO /* CAAM0121 EDIT TEMP4(pdi*) */ /* 07/25/2007 CL.FENTON Copied from CAAM0421. /* 04/14/2008 CL.FENTON Corrected extract of UID string with space /* 07/16/2009 CL.FENTON Added positioning of cursor under lastline test. /* 03/05/2011 CL.FENTON Chgd mask from specific char to any char. /* Correct issue with logging other than READ. /* 06/17/2011 CL.FENTON Chgd exit to CANCEL and added ISREDIT CONTROLs. /* 05/23/2012 CL.FENTON Chgs to allow use of AUACCESS for authorized /* users list to prevent the possible "IKJ56548I INSUFFICIENT /* STORAGE FOR CLIST TO CONTINUE" message from occurring when /* a DIALOG user group contains an excessive number of user, /* CSD-AR003400969. /* 06/06/2012 CL Fenton Corrected 852 and 932 errors on REC2TBL on /* resources that have special characters (+, -, *, and /), /* CSD-AR003419256. /* 09/20/2012 CL Fenton Corrected 860 errors on RESNAME in the collection /* of REC3TBL entries with special characters (+, -, *, and /). /* 10/04/2013 CL Fenton Changes made to correct use of hilvl qual. /* 11/18/2013 CL Fenton Changes made to remove unused and unneccessary /* RECTYP 1 records, STS-003381, STS-003761, ... /* 01/29/2015 CL Fenton Changes in evaluation of specific and generic /* resources, (i.e. MVS.VARY.TCPIP and MVS.VARY.TCPIP.), /* STS-008372. /* 06/20/2016 CL Fenton Changes in evaluation to correct issues on resources /* requirements testing. /* 07/21/2016 CL Fenton Changes made to correct issue with more specific UID /* string permission that prevents access and less specific UID /* string that allows access, STS-015183. /* 02/16/2017 CL Fenton Changes made to correct issue with findings on hilvl /* qualifier on a more specific rule is specified, STS-016125 /* ex: SDSF.MODIFY. resource and rules SDSF.MODIFY.DISPLAY in /* finding details. /* 02/16/2017 CL Fenton Changes made to correct issue with findings on hilvl /* qualifier when more specific resource is specified, STS-016157, /* STS-016163. /* ex: JES2.MODIFY. resource and rules JES2.MODIFY.BATOUT, a /* more specific resource is available, in the finding details. /* 04/17/2019 CL.FENTON Chgs to evaluate ZCIC0021 for system that are running /* both production and test/developement CICS regions, STS-021044. SET PGMNAME = &STR(CAAM0121 04/17/19) SET SYSPROMPT = OFF /* CONTROL NOPROMPT */ SET SYSFLUSH = OFF /* CONTROL NOFLUSH */ SET SYSASIS = ON /* CONTROL ASIS - caps off */ /* ERROR ROUTINE */ ERROR DO SET RETURN_CODE = &LASTCC /* save LAST ERROR CODE */ IF &LASTCC GE 16 THEN DO WRITE &PGMNAME LASTCC = &LASTCC &ZERRLM WRITE &PGMNAME PDINAME = &PDINAME END RETURN END /* *************************************** */ /* VARIABLES ARE PASSED TO THIS MACRO */ /* CONSLIST */ /* COMLIST */ /* SYMLIST */ /* TERMMSGS */ /* *************************************** */ NGLOBAL PGMNAME RETURN_CODE PDIDD PDINAME TEMP4 CAAM0013 M Y0 ISPEXEC CONTROL NONDISPL ENTER ISPEXEC CONTROL ERRORS RETURN SET SPC = &STR( ) SET SPC = &STR(&SPC.&SPC.&SPC.&SPC.&SPC) ISREDIT (PDINAME) = MEMBER SET RETURN_CODE = 0 ISPEXEC VGET ( + CONSLIST + COMLIST + SYMLIST + TERMMSGS + PDIDD + TEMP4 + CNTL + AUACCESS + CACT0008 + CAAM0013 + CACM042R + ) ASIS SET AM21VGET = &RETURN_CODE IF &RETURN_CODE NE 0 THEN DO WRITE &PGMNAME VGET RC = &RETURN_CODE &ZERRSM WRITE &PGMNAME CONSLIST/&CONSLIST COMLIST/&COMLIST SYMLIST/&SYMLIST + TERMMSGS/&TERMMSGS WRITE &PGMNAME PDIDD/&PDIDD TEMP4/&TEMP4 CNTL/&CNTL+ CACT0008/&CACT0008 CAAM0013/&CAAM0013 CACM042R/&CACM042R GOTO ERR_EXIT END SET SYSSYMLIST = &SYMLIST /* CONTROL SYMLIST/NOSYMLIST */ SET SYSCONLIST = &CONSLIST /* CONTROL CONLIST/NOCONLIST */ SET SYSLIST = &COMLIST /* CONTROL LIST/NOLIST */ SET SYSMSG = &TERMMSGS /* CONTROL MSG/NOMSG */ SET BLANK = &STR( ) SET LP = &STR(( SET RP = ) SET M = 1 ISREDIT EXCLUDE ALL '3' 49 ISREDIT DELETE ALL X /*ISREDIT (LASTLINE) = LINENUM .ZLAST /*IF &LASTLINE GT 0 THEN DO /* ISREDIT CURSOR = 1 0 /* SYSCALL EXPAND_REC2 /* ISPEXEC VERASE ( + /* TESTUID + /* LIDRC + /* LIDLINE + /* LIDNAME + /* ) ASIS /* END SET RECTYPE = 2 SET RESNAME = ISPEXEC VPUT ( + RECTYPE + PDINAME + RESNAME + ) ASIS SET RETURN_CODE = 0 ISPEXEC VIEW DATAID(&CNTL) MEMBER(&CACT0008) MACRO(&CACM042R) ISPEXEC VGET ( + REC2TBL + ) ASIS SET Y0 = 0 /* Leading finding statement */ SET Y1 = 0 /* Resource not defined */ SET Y2 = 0 /* Access authorization */ SET Y3 = 0 /* Logging */ SET Y4 = 0 /* Resource defined with access when should be deny */ /*************************************************/ /* Undefined Resource */ /*************************************************/ IF &LASTLINE GT 0 THEN + ISREDIT CURSOR = 1 0 DO XX = 1 TO &LENGTH(&NRSTR(&REC2TBL)) IF &PDINAME EQ &STR(ZCIC0021) THEN + SET Y = &SYSINDEX(&STR( ),&NRSTR(&REC2TBL),&XX+13) ELSE + SET Y = &SYSINDEX(&STR( ),&NRSTR(&REC2TBL),&XX+9) SET RESOURCE = &SUBSTR(&XX+9:&Y-1,&NRSTR(&REC2TBL)) SET FLD = &SUBSTR(&XX+8,&NRSTR(&REC2TBL)) SET XX = &Y + 1 IF &FLD EQ &STR( ) THEN DO SET RETURN_CODE = 0 /* ISREDIT FIND '1&RESOURCE ' 49 ALL ISREDIT FIND '1&RESOURCE' 49 ALL IF &RETURN_CODE GT 0 THEN DO SYSCALL STATEMENT_WRITE Y1 TYPE(1) IF &PDINAME EQ &STR(ZCIC0021) THEN + SET AC = &STR( &SUBSTR(5:&LENGTH(&RESOURCE),&RESOURCE)) ELSE + SET AC = &STR( &RESOURCE) ISPEXEC LMPUT DATAID(&PDIDD) MODE(INVAR) DATALOC(AC) + DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDINAME) END END END /****************************************************/ /* Resource that are defined and donot have prevent */ /****************************************************/ IF &LASTLINE GT 0 THEN + ISREDIT CURSOR = 1 0 ISREDIT CURSOR = 1 0 DO XX = 1 TO &LENGTH(&NRSTR(&REC2TBL)) IF &PDINAME EQ &STR(ZCIC0021) THEN + SET Y = &SYSINDEX(&STR( ),&NRSTR(&REC2TBL),&XX+13) ELSE + SET Y = &SYSINDEX(&STR( ),&NRSTR(&REC2TBL),&XX+9) SET RESOURCE = &SUBSTR(&XX+9:&Y,&NRSTR(&REC2TBL)) SET FLD = &SUBSTR(&XX+8,&NRSTR(&REC2TBL)) SET XX = &Y + 1 IF &FLD EQ &STR( ) THEN GOTO DEFINE_END DEFINE_LOOP: + SET RETURN_CODE = 0 ISREDIT FIND '1&RESOURCE ' 49 IF &RETURN_CODE GT 0 THEN GOTO DEFINE_END ISREDIT (DATA) = LINE .ZCSR ISREDIT (CURLINE) = LINENUM .ZCSR SET KEYA = &SUBSTR(7:48,&STR(&DATA)) SET OKEY0 = /* added following line */ ISREDIT CURSOR = 1 0 DEFINE_LOOP1: + SET RETURN_CODE = 0 ISREDIT FIND "&STR(&KEYA)2" 7 IF &RETURN_CODE GT 0 THEN DO ISREDIT CURSOR = &CURLINE 50 GOTO DEFINE_LOOP END ISREDIT (DATA) = LINE .ZCSR ISREDIT (CURLINEA) = LINENUM .ZCSR SET X = &SYSINDEX(&STR(|),&NRSTR(&DATA)) SET KEY0 = &SUBSTR(7:&X,&NRSTR(&DATA)) SET KEY1 = &SUBSTR(&X+1:48,&NRSTR(&DATA)) SET X = &SYSINDEX(&STR( ),&NRSTR(&KEY1 )) IF &X EQ 1 THEN SET KEY1 = ELSE SET KEY1 = &SUBSTR(1:&X,&NRSTR(&KEY1)) SET KEY2 = &SUBSTR(50:93,&NRSTR(&DATA)) SET X = &SYSINDEX(&STR(&RP ),&NRSTR(&KEY2 )) SET KEY2 = &SUBSTR(1:&X,&NRSTR(&KEY2)) SET ACCESS = &SUBSTR(94,&NRSTR(&DATA)) SELECT &SUBSTR(1,&ACCESS) WHEN (A) SET ACCESS = &STR(ALLOW) WHEN (L) SET ACCESS = &STR(LOG) WHEN (P) GOTO DEFINE_LOOP1 END SYSCALL STATEMENT_WRITE Y4 TYPE(4) IF &NRSTR(&ORESOURCE) NE &NRSTR(&RESOURCE) THEN DO IF &NRSTR(&ORESOURCE) NE &STR( ) THEN DO SET AC = &STR( ) ISPEXEC LMPUT DATAID(&PDIDD) MODE(INVAR) DATALOC(AC) + DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDINAME) END IF &PDINAME EQ &STR(ZCIC0021) THEN + SET AC = &STR( &SUBSTR(5:&LENGTH(&RESOURCE),&RESOURCE)) ELSE + SET AC = &STR( &RESOURCE) ISPEXEC LMPUT DATAID(&PDIDD) MODE(INVAR) DATALOC(AC) + DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDINAME) SET ORESOURCE = &NRSTR(&RESOURCE) END SET SVC = &SUBSTR(95:99,&NRSTR(&DATA)) SET X = &SYSINDEX(&STR( ),&NRSTR(&DATA),100) SET NKEY = &SUBSTR(100:&X,&NRSTR(&DATA)) IF &NKEY EQ &STR( ) THEN SET NKEY = SET SVC_ACC = DO X = 1 TO 5 SELECT &STR(&SUBSTR(&X,&SVC)) WHEN (R) SET SVC_ACC = &STR(&SVC_ACC.READ,) WHEN (A) SET SVC_ACC = &STR(&SVC_ACC.ADD,) WHEN (U) SET SVC_ACC = &STR(&SVC_ACC.UPDATE,) WHEN (D) SET SVC_ACC = &STR(&SVC_ACC.DELETE,) WHEN (E) SET SVC_ACC = &STR(&SVC_ACC.EXECUTE,) END END SET X = &LENGTH(&STR(&SVC_ACC)) IF &X GT 0 THEN + SET SVC_ACC = &STR(SERVICE&LP&SUBSTR(1:&X-1,&STR(&SVC_ACC))&RP ) IF &NRSTR(&KEY0) NE &NRSTR(&OKEY0) THEN DO SET OKEY0 = &NRSTR(&KEY0) ISREDIT SEEK '&SUBSTR(01:42,&NRSTR(&KEY0)&SPC)0' 7 FIRST ISREDIT (DATA) = LINE .ZCSR SET X = &SYSINDEX(&STR(|),&NRSTR(&DATA)) SET KEY = &SUBSTR(7:&X-1,&NRSTR(&DATA)) SET AC = &STR( $KEY(&KEY) &SUBSTR(50:100,+ &NRSTR(&DATA))) ISPEXEC LMPUT DATAID(&PDIDD) MODE(INVAR) DATALOC(AC) + DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDINAME) ISREDIT CURSOR = &CURLINEA 50 END SET AC = &STR( &KEY1.&KEY2 &SVC_ACC&NKEY&ACCESS) ISPEXEC LMPUT DATAID(&PDIDD) MODE(INVAR) DATALOC(AC) + DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDINAME) GOTO DEFINE_LOOP1 ISREDIT CURSOR = &CURLINE 50 DEFINE_END: + END /*************************************************/ /* Resource access requirements */ /*************************************************/ ISREDIT CURSOR = 1 0 ISREDIT SORT 7 48 D 49 120 D /*ISREDIT SORT 100 100 D 7 48 D 49 99 D SET VARDATA = &STR('2UID(*) ') SET VARSW = &STR(NX) SET VARSW = UID_LOOP: + SET RETURN_CODE = 0 ISREDIT SEEK &VARDATA 49 &VARSW IF &RETURN_CODE NE 0 THEN + GOTO UID_END ISREDIT (UIDLINE) = CURSOR ISREDIT (DATA) = LINE .ZCSR SET N = &SUBSTR(100:116,&NRSTR(&DATA)) SET P = &SUBSTR(94,&NRSTR(&DATA)) SET X = &SYSINDEX(&STR(|),&NRSTR(&DATA),7) SET Y = &SYSINDEX(&STR( ),&NRSTR(&DATA),&X) IF &Y EQ &X+1 OR + &X EQ 0 THEN SET TKEY = ELSE SET TKEY = &SUBSTR(&X+1:&Y-1,&NRSTR(&DATA)) SET RKEY = &NRSTR(&TKEY) SYSCALL TRUNC_MASK TKEY /* SYSCALL 1 */ SET KEY0 = &SUBSTR(7:48,&STR(&DATA)) ISREDIT SEEK ALL "&NRSTR(&KEY0)2" 7 ISREDIT (A) = SEEK_COUNTS /*WRITE UIDLINE:&UIDLINE VARDATA:&VARDATA VARSW:&VARSW RKEY:&RKEY + /* TKEY:&TKEY N:*&N* IF &NRSTR(&N) NE &STR( ) OR + (&P EQ &STR(P) AND + &A EQ 1) THEN DO ISREDIT EXCLUDE ALL "&NRSTR(&KEY0)" 7 END ELSE DO SET RETURN_CODE = 0 ISREDIT SEEK "&STR(&KEY0)1" 7 ALL &VARSW DO UNTIL &RETURN_CODE GT 0 ISREDIT (CURLINE) = CURSOR ISREDIT (CURSW) = XSTATUS &CURLINE ISREDIT (DATA) = LINE .ZCSR SET KEY1 = &SUBSTR(50:93,&NRSTR(&DATA)) SET X = &SYSINDEX(&STR(.),&NRSTR(&KEY1)) SET Y = &SYSINDEX(&STR( ),&NRSTR(&KEY1),&X) IF &Y EQ &X+1 OR + &X EQ 0 THEN SET KEY11 = ELSE SET KEY11 = &SUBSTR(&X+1:&Y-1,&NRSTR(&KEY1)) SET RETURN_CODE = 0 ISREDIT SEEK "&NRSTR(&KEY0)1" 7 NX PREV SET C = &RETURN_CODE ISREDIT CURSOR = &CURLINE 0 SET RETURN_CODE = 0 ISREDIT SEEK "1&NRSTR(&KEY1)" 49 NX PREV SET C1 = &RETURN_CODE SET RETURN_CODE = 0 ISREDIT SEEK ALL "&NRSTR(&KEY0)1" 7 NX ISREDIT (A) = SEEK_COUNTS ISREDIT SEEK ALL "&NRSTR(&KEY0)1" 7 ISREDIT (B) = SEEK_COUNTS SET RETURN_CODE = 0 ISREDIT SEEK ALL "1&NRSTR(&KEY1)" 49 NX ISREDIT (A1) = SEEK_COUNTS ISREDIT SEEK ALL "1&NRSTR(&KEY1)" 49 ISREDIT (B1) = SEEK_COUNTS SET RETURN_CODE = 0 /* WRITE &CURLINE &CURSW KEY0:&KEY0 A:&A B:&B C:&C /* WRITE &CURLINE &CURSW KEY1:&KEY1 KEY11:&KEY11 A1:&A1 B1:&B1 C1:&C1 /* WRITE TKEY:&TKEY RKEY:&RKEY N:*&N* IF &NRSTR(&TKEY) NE &NRSTR(&RKEY) AND + &NRSTR(&N) EQ &STR( ) AND + &SYSINDEX(&NRSTR(&TKEY),&NRSTR(&KEY1)) GT 0 AND + &CURSW EQ &STR(NX) THEN DO IF &NRSTR(&VARDATA) NE &STR('1') THEN DO ISREDIT CURSOR = &CURLINE 0 ISREDIT EXCLUDE ALL "1&KEY1" 49 .ZCSR .ZLAST ISREDIT XSTATUS &CURLINE = NX GOTO UID_BYPASS END /* GOTO UID_BYPASS temp change */ END IF (&SYSINDEX(&NRSTR(&TKEY),&NRSTR(&KEY1)) EQ 0 OR + &SYSINDEX(&NRSTR(&KEY11),&NRSTR(&TKEY)) EQ 0) AND + &NRSTR(&TKEY ) NE &STR( ) AND + &NRSTR(&N ) EQ &STR( ) AND + &NRSTR(&CURSW) EQ &STR(NX) AND + &A1 GT 1 AND + &C EQ 0 THEN DO ISREDIT XSTATUS &CURLINE = X GOTO UID_BYPASS END IF (&SYSINDEX(&NRSTR(&TKEY),&NRSTR(&KEY1)) EQ 0 OR + &SYSINDEX(&NRSTR(&KEY11),&NRSTR(&TKEY)) EQ 0) AND + &NRSTR(&TKEY ) NE &STR( ) AND + &SYSINDEX(&STR(. ),&NRSTR(&KEY11 )) GT 0 AND + &NRSTR(&CURSW) EQ &STR(NX) AND + &C EQ 0 THEN DO ISREDIT XSTATUS &CURLINE = X GOTO UID_BYPASS END /* Added following if to exclude previous defined resource */ IF &SYSINDEX(&NRSTR(&TKEY),&NRSTR(&KEY11)) EQ 1 AND + &SYSINDEX(&NRSTR(&KEY11),&NRSTR(&RKEY)) EQ 0 AND + &A GT 1 AND + &A1 GT 1 AND + &NRSTR(&CURSW) EQ &STR(NX) AND + &C1 EQ 0 THEN DO ISREDIT XSTATUS &CURLINE = X GOTO UID_BYPASS temp change */ END IF &SYSINDEX(&NRSTR(&TKEY ),&NRSTR(&KEY1)) EQ 0 AND + &A GT 1 AND + &B GT 1 AND + (&A1 GT 1 OR + (&NRSTR(&KEY11) EQ &STR( ) AND + &A1 EQ 1)) AND + &NRSTR(&CURSW) EQ &STR(NX) AND + &C EQ 0 THEN DO ISREDIT XSTATUS &CURLINE = X GOTO UID_BYPASS END IF &NRSTR(&KEY11) EQ &STR( ) AND + &NRSTR(&TKEY) NE &STR( ) AND + &A EQ 1 AND + &B EQ 1 AND + &B1 GT 1 AND + &SYSINDEX(&STR(. ),&NRSTR(&KEY1)) NE 0 THEN DO /* ISREDIT XSTATUS &CURLINE = X*/ GOTO UID_BYPASS END IF &NRSTR(&KEY11) EQ &STR( ) AND + &NRSTR(&TKEY) NE &STR( ) AND + &A EQ 1 AND + &B EQ 1 AND + (&B1 GT 1 OR + &SYSINDEX(&STR(. ),&NRSTR(&KEY1)) NE 0) THEN DO ISREDIT XSTATUS &CURLINE = X GOTO UID_BYPASS END IF &NRSTR(&TKEY) EQ &NRSTR(&RKEY) AND + (&SYSINDEX(&NRSTR(&TKEY ),&NRSTR(&KEY1)) GT 0 OR + &NRSTR(&TKEY) EQ &NRSTR(&KEY11)) THEN DO IF &A GT 1 AND + &A1 EQ 1 AND + &B1 GT 1 THEN DO /* possible correction */ ISREDIT EXCLUDE ALL "&NRSTR(&KEY0)1" 7 .ZCSR .ZLAST ISREDIT CURSOR = &CURLINE 0 ISREDIT EXCLUDE ALL "1&KEY1" 49 .ZCSR .ZLAST ISREDIT XSTATUS &CURLINE = NX GOTO UID_BYPASS END /* Added below if */ IF &A GT 1 AND + &A1 GT 1 AND + &B1 GT 1 THEN DO ISREDIT EXCLUDE ALL "1&KEY1" 49 ISREDIT XSTATUS &CURLINE = NX GOTO UID_BYPASS END END /*IF &NRSTR(&TKEY) EQ &NRSTR(&RKEY) AND IF &SYSINDEX(&NRSTR(&TKEY ),&NRSTR(&KEY1)) EQ 0 THEN DO ISREDIT CURSOR = &CURLINE 0 SET RETURN_CODE = 0 ISREDIT SEEK "&NRSTR(&KEY0)1" 7 X PREV SET D1 = &RETURN_CODE /* Commented out the following if statement */ /* IF (&A GT 1 AND + /* &SYSINDEX(&STR(. ),&NRSTR(&KEY1)) EQ 0) OR + /* &NRSTR(&N) NE &STR( ) THEN + /* ISREDIT XSTATUS &CURLINE = X IF &A EQ 1 AND + &B GT 1 AND + &CURSW EQ &STR(X) AND + &NRSTR(&N) EQ &STR( ) AND + &C GT 0 AND + &SYSINDEX(&STR(. ),&NRSTR(&KEY11 )) GT 0 THEN + ISREDIT XSTATUS &CURLINE = NX IF &A EQ 1 AND + &B GT 1 AND + &D1 EQ 0 AND + &CURSW EQ &STR(NX) AND + &NRSTR(&KEY11 ) EQ &STR( ) THEN + ISREDIT XSTATUS &CURLINE = X END IF &NRSTR(&TKEY) EQ &NRSTR(&RKEY) AND + &NRSTR(&TKEY) NE &STR( ) AND + &NRSTR(&TKEY) NE &NRSTR(&KEY11) AND + &SYSINDEX(&STR(. ),&NRSTR(&KEY11 )) EQ 0 AND + &A GT 1 AND + &A1 GT 1 THEN + ISREDIT XSTATUS &CURLINE = X IF &SYSINDEX(&NRSTR(&KEY11),&NRSTR(&TKEY)) EQ 1 AND + &NRSTR(&TKEY ) NE &STR( ) AND + (&A EQ 0 OR + (&CURSW EQ &STR(X) AND + &A1 EQ 1)) THEN + ISREDIT XSTATUS &CURLINE = NX UID_BYPASS: + ISREDIT (CURSW) = XSTATUS &CURLINE /* WRITE &CURLINE &CURSW KEY0:&KEY0 KEY1:&KEY1 /* WRITE ISREDIT CURSOR = &CURLINE 50 SET RETURN_CODE = 0 ISREDIT SEEK "&STR(&KEY0)1" 7 &VARSW END END IF &STR(&VARDATA) NE &STR('1') THEN + ISREDIT CURSOR = &UIDLINE 50 ELSE + ISREDIT CURSOR = &CURLINE 50 GOTO UID_LOOP UID_END: + ISREDIT CURSOR = 1 0 IF &STR(&VARDATA) NE &STR('1') THEN DO SET VARDATA = &STR('1') SET VARSW = GOTO UID_LOOP END ISREDIT DELETE ALL X ISREDIT SORT ISREDIT (LASTLINE) = LINENUM .ZLAST IF &LASTLINE GT 0 THEN DO ISREDIT CURSOR = 1 0 SYSCALL EXPAND_REC2 ISPEXEC VERASE ( + TESTUID + LIDRC + LIDLINE + LIDNAME + ) ASIS END SET ORESOURCE = DO XX = 1 TO &LENGTH(&NRSTR(&REC2TBL)) SET OKEY0 = ISREDIT RESET ISREDIT EXCLUDE ALL 'P' 94 /* Exclude all records with Prevent */ ISREDIT CURSOR = 1 0 SET RETURN_CODE = 0 DO WHILE &RETURN_CODE = 0 ISREDIT SEEK 'P' 94 X IF &RETURN_CODE EQ 0 THEN DO ISREDIT (DATA) = LINE .ZCSR ISREDIT (CURLINE) = LINENUM .ZCSR SET KEY = &SUBSTR(7:48,&STR(&DATA)) SET EUID = &SYSINDEX(&RP,&STR(&DATA),50) SET RECTYPE = &SUBSTR(49,&NRSTR(&DATA)) SET LOGONID = &SUBSTR(100:107,&NRSTR(&DATA)) ISREDIT CURSOR = 1 0 IF &RECTYPE EQ 3 AND + &EUID GT 55 THEN + DO WHILE &RETURN_CODE = 0 ISREDIT SEEK '&LOGONID' 100 NX IF &RETURN_CODE EQ 0 THEN DO ISREDIT (DATA) = LINE .ZCSR SET NXKEY = &SUBSTR(7:48,&STR(&DATA)) SET NXEUID = &SYSINDEX(&RP,&STR(&DATA),50) IF &NRSTR(&NXKEY) EQ &NRSTR(&KEY) AND + &EUID GE &NXEUID THEN + ISREDIT XSTATUS .ZCSR = X END END ISREDIT CURSOR = &CURLINE 95 SET RETURN_CODE = 0 END END IF &PDINAME EQ &STR(ZCIC0021) THEN + SET Y = &SYSINDEX(&STR( ),&NRSTR(&REC2TBL),&XX+13) ELSE + SET Y = &SYSINDEX(&STR( ),&NRSTR(&REC2TBL),&XX+9) SET RESOURCE = &SUBSTR(&XX+9:&Y,&NRSTR(&REC2TBL)) SET FLD = &SUBSTR(&XX+8,&NRSTR(&REC2TBL)) SET XX = &Y + 1 IF &FLD EQ &STR(X) THEN GOTO END_ACCESS SET RECTYPE = 3 SET RESNAME = &NRSTR(&RESOURCE) ISPEXEC VPUT ( + RECTYPE + PDINAME + RESNAME + ) ASIS SET RETURN_CODE = 0 ISPEXEC VIEW DATAID(&CNTL) MEMBER(&CACT0008) MACRO(&CACM042R) SET VIEW_CACT0008_RC = &RETURN_CODE IF &VIEW_CACT0008_RC GT 4 THEN DO WRITE &PGMNAME VIEW CNTL &CACT0008 RC = &VIEW_CACT0008_RC GOTO END_ACCESS END ISPEXEC VGET ( + REC3TBL + AUACCCNT + ) ASIS IF &AUACCCNT GT 50 THEN DO SET RETURN_CODE = 0 ISPEXEC LMCLOSE DATAID(&AUACCESS) SET LMCLOSE_PDIDD_RC = &RETURN_CODE IF &RETURN_CODE NE 0 THEN DO WRITE &PGMNAME LMCLOSE_AUACCESS_RC &RETURN_CODE &ZERRSM END SET RETURN_CODE = 0 ISPEXEC LMCOMP DATAID(&AUACCESS) SET LMCOMP_AUACCESS_RC = &RETURN_CODE IF &RETURN_CODE NE 0 THEN DO WRITE &PGMNAME LMCOMP_AUACCESS_RC &RETURN_CODE &ZERRSM END SET RETURN_CODE = 0 ISPEXEC LMOPEN DATAID(&AUACCESS) OPTION(INPUT) SET LMOPEN_AUACCESS_RC = &RETURN_CODE IF &RETURN_CODE NE 0 THEN DO WRITE &PGMNAME LMOPEN_AUACCESS_RC &RETURN_CODE &ZERRSM END SET AUACCCCNT = 0 ISPEXEC VPUT (AUACCCNT) ASIS END ISPEXEC VERASE ( + REC3TBL + ) ASIS SET AUUACC_LVL = 0 SET X = &SYSINDEX(&STR(* ),&STR(&REC3TBL)) IF &X GT 0 THEN DO SET AUUACC_LVL = &SUBSTR(&X+8:&X+8,&NRSTR(&REC3TBL)) END SELECT &STR(&AUUACC_LVL) WHEN (0) GOTO BYPASS_AUUACC WHEN (1) SET AUUACC_MASK = &STR( =) WHEN (2) SET AUUACC_MASK = &STR( =) WHEN (3) SET AUUACC_MASK = &STR(= =) WHEN (4) SET AUUACC_MASK = &STR(= =) WHEN (5) SET AUUACC_MASK = &STR(= = =) WHEN (6) SET AUUACC_MASK = &STR(= ===) WHEN (7) SET AUUACC_MASK = &STR(= ===) WHEN (8) SET AUUACC_MASK = &STR(= ===) WHEN (9) SET AUUACC_MASK = &STR(=====) END IF &LASTLINE GT 0 THEN + ISREDIT CURSOR = 1 0 ISREDIT EXCLUDE ALL P'&STR(&AUUACC_MASK)' 95 BYPASS_AUUACC: + SET RETURN_CODE = 0 ISPEXEC LMMFIND DATAID(&AUACCESS) MEMBER(&PDINAME) GET_AUACCESS: + SET RETURN_CODE = 0 ISPEXEC LMGET DATAID(&AUACCESS) MODE(INVAR) DATALOC(AUREC) + DATALEN(LRECL) MAXLEN(255) IF &RETURN_CODE EQ 8 THEN DO GOTO END_AUACCESS END IF &RETURN_CODE GT 4 THEN DO WRITE &PGMNAME LMGET AUACCESS RC = &RETURN_CODE &ZERRSM SET RETURN_CODE = &RETURN_CODE + 16 GOTO END_AUACCESS END SET AULID = &SUBSTR(1:8,&NRSTR(&AUREC)) SET AULVL = &SUBSTR(9,&NRSTR(&AUREC)) SELECT &STR(&AULVL) WHEN (0) SET AUMASK = &STR(P' &AULID') WHEN (1) SET AUMASK = &STR(P' =&AULID') WHEN (2) SET AUMASK = &STR(P' =&AULID') WHEN (3) SET AUMASK = &STR(P'= =&AULID') WHEN (4) SET AUMASK = &STR(P'= =&AULID') WHEN (5) SET AUMASK = &STR(P'= = =&AULID') WHEN (6) SET AUMASK = &STR(P'= ===&AULID') WHEN (7) SET AUMASK = &STR(P'= ===&AULID') WHEN (8) SET AUMASK = &STR(P'= ===&AULID') WHEN (9) SET AUMASK = &STR(P'=====&AULID') END ISREDIT EXCLUDE ALL &AUMASK 95 GOTO GET_AUACCESS END_AUACCESS: + IF &LASTLINE GT 0 THEN + ISREDIT CURSOR = 1 0 LOOP_ACCESS: + SET RETURN_CODE = 0 ISREDIT SEEK '1&RESOURCE ' 49 IF &RETURN_CODE NE 0 THEN + GOTO END_ACCESS ISREDIT (DATA) = LINE .ZCSR SET KEY = &SUBSTR(7:48,&STR(&DATA)) SET OKEY2 = USER_ACCESS: + SET RETURN_CODE = 0 ISREDIT FIND '&NRSTR(&KEY)3' 7 NX IF &RETURN_CODE NE 0 THEN + GOTO LOOP_ACCESS SYSCALL STATEMENT_WRITE Y2 TYPE(2) IF &NRSTR(&ORESOURCE) NE &NRSTR(&RESOURCE) THEN DO IF &NRSTR(&ORESOURCE) NE &STR( ) THEN DO SET AC = &STR( ) ISPEXEC LMPUT DATAID(&PDIDD) MODE(INVAR) DATALOC(AC) + DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDINAME) END IF &PDINAME EQ &STR(ZCIC0021) THEN + SET AC = &STR( &SUBSTR(5:&LENGTH(&RESOURCE),&RESOURCE)) ELSE + SET AC = &STR( &RESOURCE) ISPEXEC LMPUT DATAID(&PDIDD) MODE(INVAR) DATALOC(AC) + DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDINAME) SET ORESOURCE = &NRSTR(&RESOURCE) END ISREDIT (DATA) = LINE .ZCSR ISREDIT (CURLINE) = LINENUM .ZCSR SET X = &SYSINDEX(&STR(|),&NRSTR(&DATA)) SET KEY0 = &SUBSTR(7:&X,&NRSTR(&DATA)) SET KEY1 = &SUBSTR(&X+1:48,&NRSTR(&DATA)) SET X = &SYSINDEX(&STR( ),&NRSTR(&KEY1 )) IF &X EQ 1 THEN SET KEY1 = ELSE SET KEY1 = &SUBSTR(1:&X,&NRSTR(&KEY1)) SET KEY2 = &SUBSTR(50:93,&NRSTR(&DATA)) SET X = &SYSINDEX(&STR(&RP ),&NRSTR(&KEY2 )) SET KEY2 = &SUBSTR(1:&X,&NRSTR(&KEY2)) SET ACCESS = &SUBSTR(94,&NRSTR(&DATA)) SET USER_DATA = &SUBSTR(100:140,&NRSTR(&DATA)) SET LOGONID = &SUBSTR(100:107,&NRSTR(&DATA)) SELECT &SUBSTR(1,&ACCESS) WHEN (A) SET ACCESS = &STR(ALLOW) WHEN (L) SET ACCESS = &STR(LOG) WHEN (P) SET ACCESS = &STR(PREVENT) END SET SVC = &SUBSTR(95:99,&NRSTR(&DATA)) SET X = &SYSINDEX(&STR( ),&NRSTR(&DATA),100) SET SVC_ACC = DO X = 1 TO 5 SELECT &STR(&SUBSTR(&X,&SVC)) WHEN (R) SET SVC_ACC = &STR(&SVC_ACC.READ,) WHEN (A) SET SVC_ACC = &STR(&SVC_ACC.ADD,) WHEN (U) SET SVC_ACC = &STR(&SVC_ACC.UPDATE,) WHEN (D) SET SVC_ACC = &STR(&SVC_ACC.DELETE,) WHEN (E) SET SVC_ACC = &STR(&SVC_ACC.EXECUTE,) END END SET X = &LENGTH(&STR(&SVC_ACC)) IF &X GT 0 THEN + SET SVC_ACC = &STR(SERVICE&LP&SUBSTR(1:&X-1,&STR(&SVC_ACC))&RP ) IF &NRSTR(&KEY0) NE &NRSTR(&OKEY0) THEN DO SET OKEY0 = &NRSTR(&KEY0) ISREDIT SEEK '&SUBSTR(01:42,&NRSTR(&KEY0)&SPC)0' 7 FIRST ISREDIT (DATA) = LINE .ZCSR SET X = &SYSINDEX(&STR(|),&NRSTR(&DATA)) SET KEYX = &SUBSTR(7:&X-1,&NRSTR(&DATA)) SET AC = &STR( $KEY(&KEYX) &SUBSTR(50:100,+ &NRSTR(&DATA))) ISPEXEC LMPUT DATAID(&PDIDD) MODE(INVAR) DATALOC(AC) + DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDINAME) SET OKEY2 = END IF &NRSTR(&KEY2) NE &NRSTR(&OKEY2) THEN DO SET OKEY2 = &NRSTR(&KEY2) SET AC = &STR( &KEY1.&KEY2 &SVC_ACC.&ACCESS) ISPEXEC LMPUT DATAID(&PDIDD) MODE(INVAR) DATALOC(AC) + DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDINAME) END SET AC = &STR( &USER_DATA) ISPEXEC LMPUT DATAID(&PDIDD) MODE(INVAR) DATALOC(AC) + DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDINAME) ISREDIT CURSOR = &CURLINE 50 GOTO USER_ACCESS END_ACCESS: + END /*************************************************/ /* Resource logging requirement */ /*************************************************/ SET EQ_MASK = &STR(==========) SET EQ_MASK = &STR(&EQ_MASK&EQ_MASK&EQ_MASK&EQ_MASK&EQ_MASK) SET ORESOURCE = DO XX = 1 TO &LENGTH(&NRSTR(&REC2TBL)) ISREDIT RESET ISREDIT EXCLUDE ALL 'L' 94 /* Exclude all records with Logging */ ISREDIT EXCLUDE ALL 'P' 94 /* Exclude all records with Prevent */ SET OKEY0 = SET AULOG = &SUBSTR(&XX:&XX+7,&NRSTR(&REC2TBL)) SELECT (&AULOG) WHEN ( ) SET AULOG_LVL = 0 WHEN (NONE ) SET AULOG_LVL = 0 WHEN (EXECUTE ) DO SET AULOG_LVL = 3 SET AULOG = &STR(READ ) END WHEN (READ ) SET AULOG_LVL = 3 WHEN (UPDATE ) SET AULOG_LVL = 5 WHEN (CONTROL ) SET AULOG_LVL = 6 WHEN (ALTER ) SET AULOG_LVL = 9 OTHERWISE DO WRITE &PGMNAME Unknown access &ACCESS not found in list. SET AULOG_LVL = 9 END END IF &PDINAME EQ &STR(ZCIC0021) THEN + SET Y = &SYSINDEX(&STR( ),&NRSTR(&REC2TBL),&XX+13) ELSE + SET Y = &SYSINDEX(&STR( ),&NRSTR(&REC2TBL),&XX+9) SET RESOURCE = &SUBSTR(&XX+9:&Y,&NRSTR(&REC2TBL)) SET XX = &Y + 1 IF &LASTLINE GT 0 THEN + ISREDIT CURSOR = 1 0 IF &AULOG_LVL EQ 0 THEN + GOTO END_LOGGING SELECT &AULOG_LVL - 1 WHEN (1) SET SVC = &STR( =) WHEN (2) SET SVC = &STR( =) WHEN (3) SET SVC = &STR(= =) WHEN (4) SET SVC = &STR(= =) WHEN (5) SET SVC = &STR(= = =) WHEN (6) SET SVC = &STR(= ===) WHEN (7) SET SVC = &STR(= ===) WHEN (8) SET SVC = &STR(= ===) WHEN (9) SET SVC = &STR(=====) END /* ISREDIT EXCLUDE ALL '&SVC' 95 LOOP_LOGGING: + SET RETURN_CODE = 0 ISREDIT FIND '1&RESOURCE ' 49 NX IF &RETURN_CODE NE 0 THEN + GOTO END_LOGGING ISREDIT (DATA) = LINE .ZCSR SET KEY0 = &SUBSTR(7:48,&STR(&DATA)) SET KEY1 = &STR(&KEY0.2&EQ_MASK) SET KEY1 = &SUBSTR(1:88,&STR(&KEY1)) ISREDIT EXCLUDE ALL P"&STR(&KEY1&SVC)" 7 LOGGING_LOOP: + SET RETURN_CODE = 0 ISREDIT FIND "&STR(&KEY0)2" 7 NX IF &RETURN_CODE GT 0 THEN + GOTO LOOP_LOGGING SYSCALL STATEMENT_WRITE Y3 TYPE(3) IF &NRSTR(&ORESOURCE) NE &NRSTR(&RESOURCE) THEN DO IF &NRSTR(&ORESOURCE) NE &STR( ) THEN DO SET AC = &STR( ) ISPEXEC LMPUT DATAID(&PDIDD) MODE(INVAR) DATALOC(AC) + DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDINAME) END IF &PDINAME EQ &STR(ZCIC0021) THEN + SET AC = &STR( &SUBSTR(5:&LENGTH(&RESOURCE),&RESOURCE)) ELSE + SET AC = &STR( &RESOURCE) ISPEXEC LMPUT DATAID(&PDIDD) MODE(INVAR) DATALOC(AC) + DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDINAME) SET ORESOURCE = &NRSTR(&RESOURCE) END ISREDIT (DATA) = LINE .ZCSR ISREDIT (CURLINE) = LINENUM .ZCSR SET X = &SYSINDEX(&STR(|),&NRSTR(&DATA)) SET KEY0 = &SUBSTR(7:&X,&NRSTR(&DATA)) SET KEY1 = &SUBSTR(&X+1:48,&NRSTR(&DATA)) SET X = &SYSINDEX(&STR( ),&NRSTR(&KEY1 )) IF &X EQ 1 THEN SET KEY1 = ELSE SET KEY1 = &SUBSTR(1:&X,&NRSTR(&KEY1)) SET KEY2 = &SUBSTR(50:93,&NRSTR(&DATA)) SET X = &SYSINDEX(&STR(&RP ),&NRSTR(&KEY2 )) SET KEY2 = &SUBSTR(1:&X,&NRSTR(&KEY2)) SET ACCESS = &SUBSTR(94,&NRSTR(&DATA)) SELECT &SUBSTR(1,&ACCESS) WHEN (A) SET ACCESS = &STR(ALLOW) WHEN (L) SET ACCESS = &STR(LOG) WHEN (P) SET ACCESS = &STR(PREVENT) END SET SVC = &SUBSTR(95:99,&NRSTR(&DATA)) SET X = &SYSINDEX(&STR( ),&NRSTR(&DATA),100) SET NKEY = &SUBSTR(100:&X,&NRSTR(&DATA)) IF &NKEY EQ &STR( ) THEN SET NKEY = SET SVC_ACC = DO X = 1 TO 5 SELECT &STR(&SUBSTR(&X,&SVC)) WHEN (R) SET SVC_ACC = &STR(&SVC_ACC.READ,) WHEN (A) SET SVC_ACC = &STR(&SVC_ACC.ADD,) WHEN (U) SET SVC_ACC = &STR(&SVC_ACC.UPDATE,) WHEN (D) SET SVC_ACC = &STR(&SVC_ACC.DELETE,) WHEN (E) SET SVC_ACC = &STR(&SVC_ACC.EXECUTE,) END END SET X = &LENGTH(&STR(&SVC_ACC)) IF &X GT 0 THEN + SET SVC_ACC = &STR(SERVICE&LP&SUBSTR(1:&X-1,&STR(&SVC_ACC))&RP ) IF &NRSTR(&KEY0) NE &NRSTR(&OKEY0) THEN DO SET OKEY0 = &NRSTR(&KEY0) ISREDIT SEEK '&SUBSTR(01:42,&NRSTR(&KEY0)&SPC)0' 7 FIRST ISREDIT (DATA) = LINE .ZCSR SET X = &SYSINDEX(&STR(|),&NRSTR(&DATA)) SET KEY = &SUBSTR(7:&X-1,&NRSTR(&DATA)) SET AC = &STR( $KEY(&KEY) &SUBSTR(50:100,+ &NRSTR(&DATA))) ISPEXEC LMPUT DATAID(&PDIDD) MODE(INVAR) DATALOC(AC) + DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDINAME) ISREDIT CURSOR = &CURLINE 50 END SET AC = &STR( &KEY1.&KEY2 &SVC_ACC&NKEY&ACCESS) ISPEXEC LMPUT DATAID(&PDIDD) MODE(INVAR) DATALOC(AC) + DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDINAME) GOTO LOGGING_LOOP END_LOGGING: + END END_EDIT: - SET RETURN_CODE = 0 IF &Y0 EQ 0 THEN DO SET AC = &STR(Not a Finding) ISPEXEC LMPUT DATAID(&PDIDD) MODE(INVAR) DATALOC(AC) - DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDINAME) END IF &ENDER EQ 0 THEN DO SET AC = &STR( ) ISPEXEC LMPUT DATAID(&PDIDD) MODE(INVAR) DATALOC(AC) - DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDINAME) SET AC = &STR(No data available &MEMBER is empty.) ISPEXEC LMPUT DATAID(&PDIDD) MODE(INVAR) DATALOC(AC) - DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDINAME) END ISPEXEC LMMADD DATAID(&PDIDD) MEMBER(&PDINAME) IF &RETURN_CODE EQ 4 THEN DO /* MEMBER ALREADY EXISTS SET RETURN_CODE = 0 ISPEXEC LMMREP DATAID(&PDIDD) MEMBER(&PDINAME) IF &RETURN_CODE NE 0 THEN + WRITE &PGMNAME LMMREP_PDIDD_RCODE = &RETURN_CODE &PDINAME &ZERRSM END ELSE + IF &RETURN_CODE GT 0 THEN + WRITE &PGMNAME LMMADD_PDIDD_RCODE = &RETURN_CODE &PDINAME &ZERRSM ERR_EXIT: + IF &MAXCC GE 16 OR + &RETURN_CODE GT 0 THEN DO ISPEXEC VGET (ZISPFRC) SHARED IF &MAXCC GT &ZISPFRC THEN + SET ZISPFRC = &MAXCC ELSE + SET ZISPFRC = &RETURN_CODE ISPEXEC VPUT (ZISPFRC) SHARED WRITE &PGMNAME ZISPFRC = &ZISPFRC END ISPEXEC VPUT ( - AM21VGET - ) ASIS /* *************************************** */ /* SAVE OUTPUT */ /* *************************************** */ ISREDIT CANCEL EXIT CODE(0) EXPAND_REC2: PROC 0 SET LP = &STR(( SET RP = ) SET SPC = &STR( ) SET SPC = &STR(&SPC.&SPC.&SPC.&SPC.&SPC) REC2_START: + ISREDIT CURSOR = 1 0 SET RETURN_CODE = 0 ISREDIT FIND '2' 49 NX IF &RETURN_CODE NE 0 THEN + DO SET RETURN_CODE = 0 SET CNT = 1 GOTO EXPAND_END END ISREDIT (DATA) = LINE .ZCSR SET KEY = &SUBSTR(49:93,&NRSTR(&DATA)) SET KEY1 = &SUBSTR(01:48,&NRSTR(&DATA)) SET RECTYPE = &SUBSTR(49,&NRSTR(&DATA)) SET KEY2 = &SUBSTR(50:99,&NRSTR(&DATA)) SET X = &SYSINDEX(&LP,&NRSTR(&KEY2)) + 1 SET Y = &SYSINDEX(&RP,&NRSTR(&KEY2)) IF &Y = 0 THEN + SET Y = &SYSINDEX(&STR( ),&NRSTR(&KEY2)) IF &X GT 0 AND &X LT &Y THEN + SET TESTUID = &SUBSTR(&X:&Y-1,&NRSTR(&KEY2)) IF &STR(&TESTUID) EQ &STR(*) THEN + DO SET DATA = &STR(&KEY1.3&KEY2)+ &STR(ALL LOGONIDS MATCH SPECIFIED UID STRING) ISREDIT LINE_AFTER .ZCSR = (DATA) ISREDIT XSTATUS .ZCSR = X GOTO REC2_START END SET X = 0 SET Y = &LENGTH(&STR(&TESTUID)) DO UNTIL &X EQ 0 SET X = &SYSINDEX(&STR(*),&STR(&TESTUID)) IF &X EQ 1 THEN + SET TESTUID = &STR(=)&SUBSTR(&X+1:&Y,&STR(&TESTUID)) IF &X GT 1 THEN + SET TESTUID = &SUBSTR(1:&X-1,&STR(&TESTUID))&STR(=)+ &SUBSTR(&X+1:&Y,&STR(&TESTUID)) END SET LIDRC = 0 SET LIDLINE = 1 GET_LID_LOOP: + ISPEXEC VPUT ( + TESTUID + LIDRC + LIDLINE + ) ASIS ISPEXEC EDIT DATAID(&TEMP4) MACRO(&CAAM0013) MEMBER(LIDS) ISPEXEC VGET ( + TESTUID + LIDRC + LIDLINE + LIDNAME + ) ASIS IF &LIDLINE GT 1 THEN - DO X = 1 TO &LENGTH(&STR(&LIDNAME)) BY 30 ISREDIT CURSOR = 1 0 REC2_START1: + SET RETURN_CODE = 0 ISREDIT FIND '&NRSTR(&KEY)' 49 NX IF &RETURN_CODE NE 0 THEN DO SET RETURN_CODE = 0 SET CNT = 1 GOTO EXPAND_END1 END ISREDIT (DATA) = LINE .ZCSR SET KEY1 = &SUBSTR(01:48,&NRSTR(&DATA)) SET KEY2 = &SUBSTR(50:99,&NRSTR(&DATA)) SET DATA = &STR(&KEY1.3&KEY2)+ &SUBSTR(&X:&X+29,&STR(&LIDNAME)&SPC) ISREDIT LINE_AFTER .ZCSR = (DATA) GOTO REC2_START1 EXPAND_END1: + END ISREDIT EXCLUDE ALL "&NRSTR(&KEY)" 49 GOTO REC2_START EXPAND_END: + RETURN END TRUNC_MASK: PROC 1 STRING SYSREF &STRING SET RETURN_CODE = 0 SET DL = &LENGTH(&NRSTR(&STRING)) IF &DL EQ 0 THEN RETURN CODE(&RETURN_CODE) IF &SUBSTR(&DL,&NRSTR(&STRING)) EQ &STR(-) THEN + SET DL = &DL - 1 IF &DL GT 1 THEN + IF &SUBSTR(&DL-1:&DL,&NRSTR(&STRING)) EQ &STR(-.) THEN + SET DL = &DL - 2 IF &DL GT 0 THEN + IF &SUBSTR(&DL,&NRSTR(&STRING)) EQ &STR(.) THEN + SET DL = &DL - 1 IF &DL GT 0 THEN + SET &STRING = &SUBSTR(1:&DL,&NRSTR(&STRING)) ELSE + SET &STRING = RETURN CODE(&RETURN_CODE) END WRITE_REC: PROC 0 ISPEXEC VGET ( + CONSLIST + COMLIST + SYMLIST + TERMMSGS + PDIDD + PDINAME + RPTMBR + ODSNAME + TBLUSR + ) ASIS SET ACC_TBL = &STR(READ WRITEALLOCEXEC ) SET LP = &STR(( SET RP = ) SET RETURN_CODE = 0 ISREDIT CURSOR = 1 0 WRITE_LOOP: + SET RETURN_CODE = 0 ISREDIT FIND P'^' 1 1 NX IF &RETURN_CODE GT 0 THEN + GOTO WRITE_END ISREDIT (DATA) = LINE .ZCSR SET X = &SYSINDEX(&STR(|),&NRSTR(&KEY1)) SET KEY = &SUBSTR(7:&X-1,&STR(&DATA)) SET KEY1 = &SUBSTR(&X+1:48,&STR(&DATA)) SET X = &SYSINDEX(&STR( ),&NRSTR(&KEY1 )) IF &X EQ 1 THEN SET KEY1 = ELSE SET KEY1 = &SUBSTR(1:&X,&NRSTR(&KEY1)) SET RECTYPE = &SUBSTR(49,&STR(&DATA)) SET KEY2 = &SUBSTR(50:93,&STR(&DATA)) DO X = &LENGTH(&NRSTR(&KEY2)) TO 1 BY -1 + UNTIL &SUBSTR(&X,&NRSTR(&KEY2)) NE &STR( ) END SET KEY2 = &SUBSTR(1:&X+1,&NRSTR(&KEY2 )) SELECT (&RECTYPE) WHEN (0) GOTO WRITE_REC0 WHEN (1) GOTO WRITE_REC1 WHEN (2) GOTO WRITE_REC2 WHEN (3) GOTO WRITE_REC3 OTHERWISE WRITE INVALID RECORD TYPE &RECTYPE END SET COUNT = &COUNT + 1 GOTO WRITE_LOOP WRITE_REC0: + SET CMD = &STR( ) ISPEXEC LMPUT DATAID(&PDIDD) MODE(INVAR) DATALOC(CMD) + DATALEN(&LENGTH(&STR(&CMD))) MEMBER(&PDINAME) SET CMD = &STR( $KEY(&KEY) &SUBSTR(40:&LENGTH(&STR(&DATA)),+ &STR(&DATA))) ISPEXEC LMPUT DATAID(&PDIDD) MODE(INVAR) DATALOC(CMD) + DATALEN(&LENGTH(&STR(&CMD))) MEMBER(&PDINAME) SET COUNT = &COUNT + 1 GOTO WRITE_LOOP WRITE_REC1: + SET CMD = &STR( &KEY2) ISPEXEC LMPUT DATAID(&PDIDD) MODE(INVAR) DATALOC(CMD) + DATALEN(&LENGTH(&STR(&CMD))) MEMBER(&PDINAME) SET COUNT = &COUNT + 1 GOTO WRITE_LOOP WRITE_REC2: + SET ACCESS = &SUBSTR(84:87,&STR(&DATA)) SET EXP_ACC = DO X = 1 TO 4 SET X1 = &X * 5 IF &SUBSTR(&X:&X,&ACCESS) NE &STR( ) THEN + DO SET ACC_T = &SUBSTR(&X1-4:&X1,&ACC_TBL) SET ACC_T = &ACC_T SET EXP_ACC = &STR(&EXP_ACC+ &ACC_T&LP&SUBSTR(&X:&X,&ACCESS)&RP ) END END SET CMD = &STR( &KEY1&KEY2&EXP_ACC) ISPEXEC LMPUT DATAID(&PDIDD) MODE(INVAR) DATALOC(CMD) + DATALEN(&LENGTH(&STR(&CMD))) MEMBER(&PDINAME) SET COUNT = &COUNT + 1 GOTO WRITE_LOOP WRITE_REC3: + SET CMD = &STR( &SUBSTR(88:130,&STR(&DATA))) ISPEXEC LMPUT DATAID(&PDIDD) MODE(INVAR) DATALOC(CMD) + DATALEN(&LENGTH(&STR(&CMD))) MEMBER(&PDINAME) SET COUNT = &COUNT + 1 GOTO WRITE_LOOP WRITE_END: + END FIND_REC: PROC 1 P1 SET RETURN_CODE = 0 SET LP = &STR(( SET RP = ) SET SPC = &STR( ) SET SPC = &STR(&SPC.&SPC.&SPC.&SPC.&SPC) ISREDIT CURSOR = 1 0 REC_LOOP: + ISREDIT FIND '&P1' NEXT 39 39 NX IF &RETURN_CODE NE 0 THEN + IF &P1 EQ 3 THEN + DO SET P1 = &P1 - 1 ISREDIT CURSOR = 1 0 SET RETURN_CODE = 0 GOTO REC_LOOP END ELSE + GOTO REC_END ISREDIT (CURLINE) = LINENUM .ZCSR ISREDIT (DATA) = LINE &CURLINE SET X = &SYSINDEX(&STR(|),&NRSTR(&KEY1)) SET KEY0 = &SUBSTR(7:&X,&STR(&DATA)) SET KEY0 = &SUBSTR(1:42,&STR(&KEY0)&SPC) SET KEY1 = &SUBSTR(7:48,&STR(&DATA)) SET RECTYPE = &SUBSTR(49,&STR(&DATA)) SET KEY2 = &SUBSTR(50:93,&STR(&DATA)) IF &P1 EQ 3 THEN + ISREDIT FIND "&STR(&KEY1.2&KEY2)" 7 ALL ISREDIT FIND "&STR(&KEY1.1)" 7 ALL ISREDIT FIND "&STR(&KEY0.0)" 7 ALL ISREDIT CURSOR = &CURLINE 50 SET RETURN_CODE = 0 GOTO REC_LOOP REC_END: + END STATEMENT_WRITE: PROC 1 P1 TYPE() IF &TYPE GT 0 THEN + SYSCALL STATEMENT_WRITE Y0 TYPE(0) SET RETURN_CODE = 0 SET LP = &STR(( SET RP = ) SYSREF &P1 SET RETURN_CODE = 0 IF &P1 EQ 0 THEN DO SET &P1 = &P1 + 1 SELECT (&TYPE) WHEN (0) DO SELECT &STR(&PDINAME) WHEN (ZJES0051) + SET AC = &STR(The JES2 resource is protected improperly.) OTHERWISE + SET AC = &STR(The following access authorization&LP.s&RP + is &LP.are&RP inappropriate:) END ISPEXEC LMPUT DATAID(&PDIDD) MODE(INVAR) DATALOC(AC) + DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDINAME) END WHEN (1) DO SET AC = &STR( ) ISPEXEC LMPUT DATAID(&PDIDD) MODE(INVAR) DATALOC(AC) - DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDINAME) SET AC = &STR(&M&RP Required resource&LP.s&RP is &LP.are&RP + not defined.) ISPEXEC LMPUT DATAID(&PDIDD) MODE(INVAR) DATALOC(AC) - DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDINAME) SET AC = &STR( ) ISPEXEC LMPUT DATAID(&PDIDD) MODE(INVAR) DATALOC(AC) + DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDINAME) SET M = &M + 1 END WHEN (2) DO SET AC = &STR( ) ISPEXEC LMPUT DATAID(&PDIDD) MODE(INVAR) DATALOC(AC) + DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDINAME) SET AC = &STR(&M&RP Access authorization does not + restrict access to appropriate personnel.) ISPEXEC LMPUT DATAID(&PDIDD) MODE(INVAR) DATALOC(AC) - DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDINAME) SET M = &M + 1 SET AC = &STR(&M&RP Justification for access authorization was + not provided.) ISPEXEC LMPUT DATAID(&PDIDD) MODE(INVAR) DATALOC(AC) - DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDINAME) SET AC = &STR( ) ISPEXEC LMPUT DATAID(&PDIDD) MODE(INVAR) DATALOC(AC) - DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDINAME) SET M = &M + 1 END WHEN (3) DO SET AC = &STR( ) ISPEXEC LMPUT DATAID(&PDIDD) MODE(INVAR) DATALOC(AC) + DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDINAME) SET AC = &STR(&M&RP All resource access is not logged.) ISPEXEC LMPUT DATAID(&PDIDD) MODE(INVAR) DATALOC(AC) - DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDINAME) SET AC = &STR( ) ISPEXEC LMPUT DATAID(&PDIDD) MODE(INVAR) DATALOC(AC) - DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDINAME) SET M = &M + 1 END WHEN (4) DO SET AC = &STR( ) ISPEXEC LMPUT DATAID(&PDIDD) MODE(INVAR) DATALOC(AC) - DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDINAME) SET AC = &STR(&M&RP Resource&LP.s&RP is &LP.are&RP + defined.) ISPEXEC LMPUT DATAID(&PDIDD) MODE(INVAR) DATALOC(AC) - DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDINAME) SET AC = &STR( ) ISPEXEC LMPUT DATAID(&PDIDD) MODE(INVAR) DATALOC(AC) + DATALEN(&LENGTH(&NRSTR(&AC))) MEMBER(&PDINAME) SET M = &M + 1 END OTHERWISE WRITE &PGMNAME Invalid TYPE &TYPE. END END END