/* REXX */ /* */ /* AUTHOR: MARK ZELDEN */ /* */ /**************************************************************/ /* APF Authorized libraries checker REXX exec. */ /* */ /* This program will report on various errors in the */ /* in-storage APF list, such as non-existent data sets or */ /* volumes that no longer exist or are not online. */ /* */ /**************************************************************/ /* NOTE: The dynamic APF code in this exec uses undocumented */ /* IBM control blocks and may break at any time! */ /* ... tested on MVS ESA 4.3 up to z/OS V1R3 */ /**************************************************************/ /* EXECUTION SYNTAX: */ /* */ /* TSO %APFVER */ /* */ /* Any errors encountered are displayed on the terminal. */ /* */ /**************************************************************/ LASTUPD = '10/09/2007' /* date of last update */ If Sysvar(SYSISPF)='ACTIVE' then address ISREDIT "MACRO" /**************************************************************/ /* Trace ?R */ /* Trace ?I */ /* Trace err */ NUMERIC DIGITS 10 CVT = C2d(Storage(10,4)) /* point to cvt */ GRSNAME = Storage(D2x(CVT + 340),8) /* point to system name */ GRSNAME = Strip(GRSNAME,'T') /* del trailing blanks */ CVTAUTHL = C2d(Storage(D2x(CVT + 484),4)) /* point to auth lib tbl*/ If CVTAUTHL <> C2d('7FFFF001'x) then do /* static list ? */ NUMAPF = C2d(Storage(D2x(CVTAUTHL),2)) /* # APF libs in table */ APFOFF = 2 /* first ent in APF tbl */ Do I = 1 to NUMAPF LEN = C2d(Storage(D2x(CVTAUTHL+APFOFF),1)) /* length of entry */ VOL.I = Storage(D2x(CVTAUTHL+APFOFF+1),6) /* VOLSER of APF LIB */ DSN.I = Storage(D2x(CVTAUTHL+APFOFF+1+6),LEN-6) /*DSN of APF lib*/ APFOFF = APFOFF + LEN +1 End End Else Do /* dynamic APF list via PROGxx */ 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) /* VOLSER 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 NUMAPF = NUMAPF-1 End /**************************************/ /* We now have all of the APF entries */ /**************************************/ Say 'VERIFICATION OF IN-STORAGE APF LIST IN PROGRESS:', 'SYSTEM' grsname Translate(Date(N)) Queue 'VERIFICATION OF IN-STORAGE APF LIST IN PROGRESS:', 'SYSTEM' grsname Translate(Date(N)) Say ' ' Queue ' ' ERRCNT = 0 /* error count */ Do I = 1 to NUMAPF If VOL.I = '*SMS*' then , RETCODE = Listdsi(''''DSN.I'''' norecall) Else , RETCODE = Listdsi(''''DSN.I'''' 'volume('VOL.I')' norecall) If RETCODE <> 0 then do Say 'ERROR ENCOUNTERED WHILE VERIFYING THE FOLLOWING DATASET:' Queue 'ERROR ENCOUNTERED WHILE VERIFYING THE FOLLOWING DATASET:' Say DSN.I Queue DSN.I If SYSREASON = 24 then do Say DSN.I 'DOES NOT EXIST ON VOLUME 'VOL.I Queue DSN.I 'DOES NOT EXIST ON VOLUME 'VOL.I Say ' ' Queue ' ' ERRCNT = ERRCNT + 1 End Else Do Say SYSMSGLVL2 Queue SYSMSGLVL2 /* Say 'REASON CODE IN SYSREASON = 'SYSREASON */ Say ' ' Queue ' ' ERRCNT = ERRCNT + 1 End iterate /* get next record */ End /* if retcode */ End /* do i = 1 to NUMAPF */ If ERRCNT = 0 then do Say 'THE IN-STORAGE APF LIST HAD NO ERRORS' Queue 'THE IN-STORAGE APF LIST HAD NO ERRORS' End Else Do Say 'THE IN-STORAGE APF LIST HAD 'ERRCNT' ERROR(S)' Queue 'THE IN-STORAGE APF LIST HAD 'ERRCNT' ERROR(S)' End /*********************************************************************/ /* If ISPF is active, browse output - otherwise end */ /*********************************************************************/ Queue '' /* null queue to end stack */ If Sysvar(SYSISPF)='ACTIVE' then do /* BROWSE_ISPF: Browse output if ISPF is active */ Address ISPEXEC "CONTROL ERRORS RETURN" Address ISPEXEC "VGET ZENVIR" Address TSO prefix = sysvar('SYSPREF') /* tso profile prefix */ uid = sysvar('SYSUID') /* tso userid */ If prefix = '' then prefix = uid /* use uid if null prefix */ If prefix <> '' & prefix <> uid then /* different prefix than uid */ prefix = prefix || '.' || uid /* use prefix.uid */ ddnm1 = 'DDO'||random(1,99999) /* choose random ddname */ ddnm2 = 'DDP'||random(1,99999) /* choose random ddname */ junk = msg('off') "ALLOC FILE("||ddnm1||") UNIT(SYSALLDA) NEW TRACKS SPACE(2,1) DELETE", " REUSE LRECL(80) RECFM(F B) BLKSIZE(3120)" "ALLOC FILE("||ddnm2||") UNIT(SYSALLDA) NEW TRACKS SPACE(1,1) DELETE", " REUSE LRECL(80) RECFM(F B) BLKSIZE(3120) DIR(1)" junk = msg('on') "Newstack" /*************************/ /* APFVERP Panel source */ /*************************/ If Substr(ZENVIR,6,1) >= 4 then Queue ")PANEL KEYLIST(ISRSPBC,ISR)" Queue ")ATTR" Queue " _ TYPE(INPUT) INTENS(HIGH) COLOR(TURQ) CAPS(OFF)" , "FORMAT(&MIXED)" Queue " | AREA(DYNAMIC) EXTEND(ON) SCROLL(ON)" Queue " + TYPE(TEXT) INTENS(LOW) COLOR(BLUE)" Queue " @ TYPE(TEXT) INTENS(LOW) COLOR(TURQ)" Queue " % TYPE(TEXT) INTENS(HIGH) COLOR(GREEN)" Queue " ! TYPE(OUTPUT) INTENS(HIGH) COLOR(TURQ) PAD(-)" Queue " 01 TYPE(DATAOUT) INTENS(LOW)" Queue " 02 TYPE(DATAOUT) INTENS(HIGH)" Queue " 0B TYPE(DATAOUT) INTENS(HIGH) FORMAT(DBCS)" Queue " 0C TYPE(DATAOUT) INTENS(HIGH) FORMAT(EBCDIC)" Queue " 0D TYPE(DATAOUT) INTENS(HIGH) FORMAT(&MIXED)" Queue " 10 TYPE(DATAOUT) INTENS(LOW) FORMAT(DBCS)" Queue " 11 TYPE(DATAOUT) INTENS(LOW) FORMAT(EBCDIC)" Queue " 12 TYPE(DATAOUT) INTENS(LOW) FORMAT(&MIXED)" Queue ")BODY EXPAND(//)" Queue "%BROWSE @&ZTITLE / / %Line!ZLINES %Col!ZCOLUMS+" Queue "%Command ===>_ZCMD / / %Scroll ===>_Z +" Queue "|ZDATA ---------------/ /-------------------------|" Queue "| / / |" Queue "| --------------------/-/-------------------------|" Queue ")INIT" Queue " .HELP = ISR10000" Queue " .ZVARS = 'ZSCBR'" Queue " &ZTITLE = 'Mark''s MVS Utilities - APFVER'" Queue " &MIXED = MIX" Queue " IF (&ZPDMIX = N)" Queue " &MIXED = EBCDIC" Queue " VGET (ZSCBR) PROFILE" Queue " IF (&ZSCBR = ' ')" Queue " &ZSCBR = 'CSR'" Queue ")REINIT" Queue " REFRESH(ZCMD,ZSCBR,ZDATA,ZLINES,ZCOLUMS)" Queue ")PROC" Queue " &ZCURSOR = .CURSOR" Queue " &ZCSROFF = .CSRPOS" Queue " &ZLVLINE = LVLINE(ZDATA)" Queue " VPUT (ZSCBR) PROFILE" Queue ")END" Queue "" /* */ Address ISPEXEC "LMINIT DATAID(PAN) DDNAME("ddnm2")" Address ISPEXEC "LMOPEN DATAID("pan") OPTION(OUTPUT)" Do queued() Parse pull panline Address ISPEXEC "LMPUT DATAID("pan") MODE(INVAR)" , "DATALOC(PANLINE) DATALEN(80)" End Address ISPEXEC "LMMADD DATAID("pan") MEMBER(APFVERP)" Address ISPEXEC "LMFREE DATAID("pan")" "Delstack" "EXECIO * DISKW" ddnm1 "(FINIS" If ERRCNT = 0 then zedsmsg = 'NO ERRORS' else zedsmsg = ERRCNT 'ERROR(S)' zedlmsg = 'APFVER - Last updated on' , LASTUPD ||'. Written by' , 'Mark Zelden. Mark''s MVS Utilities -' , 'http://www.mzelden.com/mvsutil.html' address ISPEXEC "LIBDEF ISPPLIB LIBRARY ID("||ddnm2||") STACK" address ISPEXEC "SETMSG MSG(ISRZ000)" /* msg - no alarm */ address ISPEXEC "LMINIT DATAID(TEMP) DDNAME("||ddnm1||")" address ISPEXEC "BROWSE DATAID("||temp") PANEL(APFVERP)" address ISPEXEC "LMFREE DATAID("||temp")" address ISPEXEC "LIBDEF ISPPLIB" junk = msg('off') "FREE FI("||ddnm1||")" "FREE FI("||ddnm2||")" End Else "delstack" /* empty stack for non-ispf invocation */