/* REXX */ /* CLS2REXXed by FSOX001 on 5 Jul 2016 at 10:41:04 */ /*Trace ?r*/ Signal On NoValue Call On Error Signal On Failure Signal On Syntax Parse source opsys . exec_name . Address ISREDIT "MACRO" /* CACM0007 EDIT MACRO .PDI(?????) */ /*********************************************************************/ /* 09/27/2024 CL Fenton Created to evaluate existance of programs */ /* for IFTP0040 for STIG IDs ACF2-US-000170, */ /* RACF-FT-000090, and TSS0-FT-000060. */ /* Script to be executed in CACJ0005 in CACC0010 for */ /* FTP, SCTASKU0221468. */ /* */ /* */ /* */ /*********************************************************************/ pgmname = "CACC0007 09/27/24" sysprompt = "OFF" /* CONTROL NOPROMPT */ sysflush = "OFF" /* CONTROL NOFLUSH */ sysasis = "ON" /* CONTROL ASIS - caps off */ Address ISPEXEC "CONTROL NONDISPL ENTER" Address ISPEXEC "CONTROL ERRORS RETURN" maxcc = 0 return_code = 0 Address ISPEXEC "VGET (CONSLIST COMLIST SYMLIST TERMMSGS) ASIS" cm07vget = return_code If return_code <> 0 then do Say pgmname "VGET RC =" return_code zerrsm Say pgmname "CONSLIST/"conslist "COMLIST/"comlist "SYMLIST/"symlist "TERMMSGS/"termmsgs SIGNAL ERR_EXIT End If CONSLIST = "ON" | COMLIST = "ON" | SYMLIST = "ON" , then Trace r maxcc = 0 return_code = 0 "DELETE ALL NX" return_code = 0 /*******************************************/ /* TURN ON MESSAGES */ /*******************************************/ syssymlist = symlist /* CONTROL SYMLIST/NOSYMLIST */ sysconlist = conslist /* CONTROL CONLIST/NOCONLIST */ syslist = comlist /* CONTROL LIST/NOLIST */ sysmsg = termmsgs /* CONTROL MSG/NOMSG */ /*******************************************/ /* MAIN PROCESS */ /*******************************************/ zispfrc = 0 Address ISPEXEC "VPUT (ZISPFRC) SHARED" otermmsgs = TERMMSGS ocomlist = COMLIST oconslist = CONSLIST osymlist = SYMLIST TERMMSGS = "OFF" COMLIST = "OFF" CONSLIST = "OFF" SYMLIST = "OFF" Address ISPEXEC "VPUT (CONSLIST COMLIST SYMLIST TERMMSGS)" a = outtrap("data.") a = CACC1000('DD JESPROC FTPD') TERMMSGS = otermmsgs COMLIST = ocomlist CONSLIST = oconslist SYMLIST = osymlist Address ISPEXEC "VPUT (CONSLIST COMLIST SYMLIST TERMMSGS)" a = outtrap("OFF") Address ISPEXEC "vget (STCPROC PROC dddsns) asis" Numeric digits 20 Call COMMON /* control blocks needed by multiple routines */ Call LPA /* LPA List information */ Call LNKLST /* LNKLST information */ Call APF /* APF List information */ /*********************************************************************/ /* Done looking at all control blocks */ /*********************************************************************/ programs = "FTCHKCMD" "FTCHKIP" "FTCHKJES" "FTCHKPWD", "FTPSMFEX" "FTPOSTPR" err = outtrap("var.") datasets. = x = 1 if pos("//STEPLIB",dddsns) > 0 then do parse var dddsns . "//STEPLIB" dsnmbr "//" datasets.x = dsnmbr x = x + 1 end Address TSO "MAKEBUF" do x = x to queued() parse pull ac parse var ac type dsn . datasets.x = dsn datasets.0 = x /*say pgmname "Type:" type "DSN:" dsn say pgmname right(x,4,"0") ac*/ do cnt = 1 to words(programs) if sysdsn("'"dsn"("word(programs,cnt)")'") = "OK" then, queue left(word(programs,cnt)" ",10) dsn end end if queued() = 0 then do say pgmname " 1 records written for IFTP0040." "LINE_AFTER .ZLAST = DATALINE 'Not a Finding'" "LINE_AFTER .ZLAST = DATALINE ' '" end else do x = queued() + 2 say pgmname right(x,4) "records written for IFTP0040." ac = "The following IBM z/OS user exits for the FTP server are in use." "LINE_AFTER .ZLAST = (AC)" "LINE_AFTER .ZLAST = DATALINE ' '" do x = 1 to queued() parse pull ac ac = " "ac "LINE_AFTER .ZLAST = (AC)" end "LINE_AFTER .ZLAST = DATALINE ' '" end return_code = 0 /*******************************************/ /* ERROR EXIT */ /*******************************************/ ERR_EXIT: If maxcc >= 16 | return_code > 0 then do Address ISPEXEC "VGET (ZISPFRC) SHARED" If maxcc > zispfrc then, zispfrc = maxcc Else zispfrc = return_code Address ISPEXEC "VPUT (ZISPFRC) SHARED" Say pgmname "ZISPFRC =" zispfrc end "END" Exit 0 /* End IPLINFO - RC 0 */ /*********************************************************************/ /* End of main IPLINFO code */ /*********************************************************************/ COMMON: /* Control blocks needed by multiple routines */ CVT = C2d(Storage(10,4)) /* point to CVT */ CVTFLAG2 = Storage(D2x(CVT+377),1) /* CVT flag byte 2 */ CVTEXT2 = C2d(Storage(D2x(CVT + 328),4)) /* point to CVTEXT2 */ PRODNAME = Storage(D2x(CVT - 40),7) /* point to mvs version */ If Substr(PRODNAME,3,1) >= 3 then do /* HBB3310 ESA V3 & > */ CVTOSLV0 = Storage(D2x(CVT + 1264),1) /* Byte 0 of CVTOSLVL */ CVTOSLV1 = Storage(D2x(CVT + 1265),1) /* Byte 1 of CVTOSLVL */ CVTOSLV2 = Storage(D2x(CVT + 1266),1) /* Byte 2 of CVTOSLVL */ CVTOSLV3 = Storage(D2x(CVT + 1267),1) /* Byte 3 of CVTOSLVL */ CVTOSLV4 = Storage(D2x(CVT + 1268),1) /* Byte 4 of CVTOSLVL */ CVTOSLV5 = Storage(D2x(CVT + 1269),1) /* Byte 5 of CVTOSLVL */ CVTOSLV6 = Storage(D2x(CVT + 1270),1) /* Byte 6 of CVTOSLVL */ CVTOSLV7 = Storage(D2x(CVT + 1271),1) /* Byte 7 of CVTOSLVL */ CVTOSLV8 = Storage(D2x(CVT + 1272),1) /* Byte 8 of CVTOSLVL */ CVTOSLV9 = Storage(D2x(CVT + 1273),1) /* Byte 9 of CVTOSLVL */ End If Bitand(CVTOSLV0,'08'x) = '08'x then , /* HBB4410 ESA V4 & > */ ECVT = C2d(Storage(D2x(CVT + 140),4)) /* point to CVTECVT */ FMIDNUM = Storage(D2x(CVT - 32),7) /* point to fmid */ JESCT = C2d(Storage(D2x(CVT + 296),4)) /* point to JESCT */ JESCTEXT = C2d(Storage(D2x(JESCT +100),4)) /* point to JESPEXT */ JESPJESN = Storage(D2x(JESCT + 28),4) /* name of primary JES */ CVTSNAME = Storage(D2x(CVT + 340),8) /* point to system name */ GRSNAME = Strip(CVTSNAME,'T') /* del trailing blanks */ CSD = C2d(Storage(D2x(CVT + 660),4)) /* point to CSD */ SMCA = Storage(D2x(CVT + 196),4) /* point to SMCA */ SMCA = Bitand(SMCA,'7FFFFFFF'x) /* zero high order bit */ SMCA = C2d(SMCA) /* convert to decimal */ ASMVT = C2d(Storage(D2x(CVT + 704),4)) /* point to ASMVT */ CVTSCPIN = D2x(CVT+832) /* point to SCPINFO */ If Bitand(CVTOSLV5,'08'x) = '08'x then do /* z/OS 1.10 and above */ ECVTSCPIN = D2x(ECVT+876) /* point to cur SCPINFO */ SCCB = C2d(Storage(ECVTSCPIN,4)) /* Service Call Cntl Blk*/ End Else SCCB = C2d(Storage(CVTSCPIN,4)) /* Service Call Cntl Blk*/ RCE = C2d(Storage(D2x(CVT + 1168),4)) /* point to RCE */ MODEL = C2d(Storage(D2x(CVT - 6),2)) /* point to cpu model */ /*********************************************************************/ /* The CPU model is stored in packed decimal format with no sign, */ /* so to make the model printable, it needs to be converted back */ /* to hex. */ /*********************************************************************/ MODEL = D2x(MODEL) /* convert back to hex */ PCCAVT = C2d(Storage(D2x(CVT + 764),4)) /* point to PCCA vect tb*/ If Bitand(CVTOSLV1,'01'x) = '01'x then do /* OS/390 R2 and above */ ECVTIPA = C2d(Storage(D2x(ECVT + 392),4)) /* point to IPA */ IPASCAT = Storage(D2x(ECVTIPA + 224),63) /* SYSCAT card image */ End zARCH = 1 /* default ARCHLVL */ If Bitand(CVTOSLV2,'01'x) = '01'x then do /* OS/390 R10 and above */ FLCARCH = Storage('A3',1) /* FLCARCH in PSA */ If C2d(FLCARCH) <> 0 then zARCH=2 /* non-zero is z/Arch. */ End Return LPA: /* LPA List sub-routine */ CVTSMEXT = C2d(Storage(D2x(CVT + 1196),4)) /* point to stg map ext.*/ CVTEPLPS = C2d(Storage(D2x(CVTSMEXT+56),4)) /* start vaddr of ELPA */ NUMLPA = C2d(Storage(D2x(CVTEPLPS+4),4)) /* # LPA libs in table */ LPAOFF = 8 /* first ent in LPA tbl */ /*Queue ' ' Queue 'LPA Library List ('NUMLPA' libraries):' Queue ' POSITION DSNAME'*/ Do I = 1 to NUMLPA LEN = C2d(Storage(D2x(CVTEPLPS+LPAOFF),1)) /* length of entry */ LPDSN = Storage(D2x(CVTEPLPS+LPAOFF+1),LEN) /* DSN of LPA library */ LPAOFF = LPAOFF + 44 + 1 /* next entry in table*/ LPAPOS = Right(I,3) /* position in LPA list */ RELLPPOS = Right('(+'I-1')',6) /* relative position in list */ /*Queue LPAPOS RELLPPOS ' ' LPDSN*/ Queue 'LPA' LPDSN End Return LNKLST: /* LNKLST sub-routine */ If Bitand(CVTOSLV1,'01'x) <> '01'x then do /* below OS/390 R2 */ CVTLLTA = C2d(Storage(D2x(CVT + 1244),4)) /* point to lnklst tbl */ NUMLNK = C2d(Storage(D2x(CVTLLTA+4),4)) /* # LNK libs in table */ LLTAPFTB = CVTLLTA + 8 + (NUMLNK*45) /* start of LLTAPFTB */ LNKOFF = 8 /*first ent in LBK tbl */ LKAPFOFF = 0 /*first ent in LLTAPFTB*/ /*Queue ' ' Queue 'LNKLST Library List ('NUMLNK' Libraries):' Queue ' POSITION APF DSNAME'*/ Do I = 1 to NUMLNK LEN = C2d(Storage(D2x(CVTLLTA+LNKOFF),1)) /* length of entry */ LKDSN = Storage(D2x(CVTLLTA+LNKOFF+1),LEN) /* DSN of LNK lib */ CHKAPF = Storage(D2x(LLTAPFTB+LKAPFOFF),1) /* APF flag */ If bitand(CHKAPF,'80'x) = '80'x then LKAPF = 'Y' /* flag on */ else LKAPF = ' ' /* APF flag off */ LNKOFF = LNKOFF + 44 + 1 /*next entry in tbl*/ LKAPFOFF = LKAPFOFF + 1 /* next entry in LLTAPFTB */ LNKPOS = Right(I,3) /*position in list */ RELLKPOS = Right('(+'I-1')',6) /* relative position in list */ /* Queue LNKPOS RELLKPOS ' ' LKAPF ' ' LKDSN*/ Queue 'LNKLST' LKDSN End End Else do /* OS/390 1.2 and above - PROGxx capable LNKLST */ ASCB = C2d(Storage(224,4)) /* point to ASCB */ ASSB = C2d(Storage(D2x(ASCB+336),4)) /* point to ASSB */ DLCB = C2d(Storage(D2x(ASSB+236),4)) /* point to CSVDLCB */ DLCBFLGS = Storage(d2x(DLCB + 32),1) /* DLCB flag bits */ SETNAME = Storage(D2x(DLCB + 36),16) /* LNKLST set name */ SETNAME = Strip(SETNAME,'T') /* del trailing blanks*/ CVTLLTA = C2d(Storage(D2x(DLCB + 16),4)) /* point to lnklst tbl*/ LLTX = C2d(Storage(D2x(DLCB + 20),4)) /* point to LLTX */ NUMLNK = C2d(Storage(D2x(CVTLLTA+4),4)) /* # LNK libs in table*/ LLTAPFTB = CVTLLTA + 8 + (NUMLNK*45) /* start of LLTAPFTB */ LNKOFF = 8 /*first ent in LLT tbl*/ VOLOFF = 8 /*first ent in LLTX */ LKAPFOFF = 0 /*first ent in LLTAPFTB*/ /*If Bitand(DLCBFLGS,'10'x) = '10'x then , /* bit for LNKAUTH */ LAUTH = 'LNKLST' /* LNKAUTH=LNKLST */ Else LAUTH = 'APFTAB' /* LNKAUTH=APFTAB */ Queue ' ' Queue 'LNKLST Library List - Set:' SETNAME , ' LNKAUTH='LAUTH '('NUMLNK' Libraries):' If LAUTH = 'LNKLST' then , Queue ' (All LNKLST data sets marked APF=Y due to' , 'LNKAUTH=LNKLST)' Queue ' POSITION APF VOLUME DSNAME'*/ Do I = 1 to NUMLNK LEN = C2d(Storage(D2x(CVTLLTA+LNKOFF),1)) /* length of entry */ LKDSN = Storage(D2x(CVTLLTA+LNKOFF+1),LEN) /* DSN of LNK lib */ LNKVOL = Storage(D2x(LLTX+VOLOFF),6) /* VOL of LNK lib */ CHKAPF = Storage(D2x(LLTAPFTB+LKAPFOFF),1) /* APF flag */ If bitand(CHKAPF,'80'x) = '80'x then LKAPF = 'Y' /* flag on */ else LKAPF = ' ' /* APF flag off */ LNKOFF = LNKOFF + 44 + 1 /*next entry in LLT*/ VOLOFF = VOLOFF + 8 /*next vol in LLTX */ LKAPFOFF = LKAPFOFF + 1 /* next entry in LLTAPFTB */ LNKPOS = Right(I,3) /*position in list */ RELLKPOS = Right('(+'I-1')',6) /* relative position in list */ /* Queue LNKPOS RELLKPOS ' ' LKAPF ' ' LNKVOL ' ' LKDSN*/ Queue 'LNKLST' LKDSN End End Return APF: /* APF List sub-routine */ CVTAUTHL = C2d(Storage(D2x(CVT + 484),4)) /* point to auth lib tbl*/ If CVTAUTHL <> C2d('7FFFF001'x) then do /* dynamic list ? */ NUMAPF = C2d(Storage(D2x(CVTAUTHL),2)) /* # APF libs in table */ APFOFF = 2 /* first ent in APF tbl */ /*Queue ' ' Queue 'APF Library List ('NUMAPF' libraries):' Queue ' ENTRY VOLUME DSNAME'*/ Do I = 1 to NUMAPF LEN = C2d(Storage(D2x(CVTAUTHL+APFOFF),1)) /* length of entry */ VOL = Storage(D2x(CVTAUTHL+APFOFF+1),6) /* VOLSER of APF LIB */ DSN = Storage(D2x(CVTAUTHL+APFOFF+1+6),LEN-6) /* DSN of apflib */ APFOFF = APFOFF + LEN +1 APFPOS = Right(I,4) /*position in APF list*/ /* Queue ' 'APFPOS ' ' VOL ' ' DSN*/ Queue 'APF' DSN End End Else Do ECVT = C2d(Storage(D2x(CVT + 140),4)) /* point to CVTECVT */ ECVTCSVT = C2d(Storage(D2x(ECVT + 228),4)) /* point to CSV table */ APFA = C2d(Storage(D2x(ECVTCSVT + 12),4)) /* APFA */ AFIRST = C2d(Storage(D2x(APFA + 8),4)) /* First entry */ ALAST = C2d(Storage(D2x(APFA + 12),4)) /* Last entry */ LASTONE = 0 /* flag for end of list */ NUMAPF = 1 /* tot # of entries in list */ Do forever DSN.NUMAPF = Storage(D2x(AFIRST+24),44) /* DSN of APF library */ DSN.NUMAPF = Strip(DSN.NUMAPF,'T') /* remove blanks */ CKSMS = Storage(D2x(AFIRST+4),1) /* DSN of APF library */ if bitand(CKSMS,'80'x) = '80'x /* SMS data set? */ then VOL.NUMAPF = '*SMS* ' /* SMS control dsn */ else VOL.NUMAPF = Storage(D2x(AFIRST+68),6) /* VOL of APF lib */ If Substr(DSN.NUMAPF,1,1) <> X2c('00') /* check for deleted */ then NUMAPF = NUMAPF + 1 /* APF entry */ AFIRST = C2d(Storage(D2x(AFIRST + 8),4)) /* next entry */ if LASTONE = 1 then leave If AFIRST = ALAST then LASTONE = 1 End /*Queue ' ' Queue 'APF Library List - Dynamic ('NUMAPF - 1' libraries):' Queue ' ENTRY VOLUME DSNAME'*/ Do I = 1 to NUMAPF-1 APFPOS = Right(I,4) /*position in APF list*/ /* Queue ' 'APFPOS ' ' VOL.I ' ' DSN.I*/ Queue 'APF' DSN.I End End Return /* End of iplinfo */ /*******************************************/ /* SYSCALL SUBROUTINES */ /*******************************************/ NoValue: Failure: Syntax: say pgmname 'REXX error' rc 'in line' sigl':' strip(ERRORTEXT(rc)) say SOURCELINE(sigl) SIGNAL ERR_EXIT Error: return_code = RC if RC > 4 & RC <> 8 then do say pgmname "LASTCC =" RC strip(zerrlm) say pgmname 'REXX error' rc 'in line' sigl':' ERRORTEXT(rc) say SOURCELINE(sigl) end if return_code > maxcc then, maxcc = return_code return