/* REXX */
/* */
/* ISSUES THE RACF 'SETR LIST' COMMAND AND ROUTES THE OUTPUT */
/* TO A SCROLLABLE TEMP DATASET OR DIRECTLY TO THE PRINTER. */
/* */
/* CREATED 11/02/2002 STEVE NEELAND */
/* */
PARSE UPPER ARG $DEST .
IF $DEST = 'P' THEN $PRINT_FLAG = 'Y'
ELSE $PRINT_FLAG = 'N'
/*------------------------------------------------------------------*/
/* ALLOCATE THE TEMP FILE FOR DISPLAYING THE OUTPUT DATA */
/*------------------------------------------------------------------*/
OUTPUT = "L"RANDOM(99999)
SELECT
WHEN $PRINT_FLAG = 'Y' THEN
/*--- SEND TO PRINTER --------------------------*/
"ALLOC FI("OUTPUT") SYSOUT(A) DEST(U0022) FORMS(STD) ,
COPIES(1) RECFM(F,B) LRECL(80)"
OTHERWISE
/*--- SEND TO SCREEN ---------------------------*/
"ALLOC FI("OUTPUT") DELETE TRACK ,
SPACE (5,5) LRECL(133) RECFM(F B) BLKSIZE(0) UNIT(SYSDA)"
END /* SELECT */
/*-------- GET RACF USERID PROFILE INFO --------------*/
Z = OUTTRAP('LIST.')
"SETROPTS LIST"
Z = OUTTRAP('OFF')
/*-------- PRINT DATE/TIME STAMP -----------------------*/
$TODAY = DATE()
$TODAY = SUBWORD($TODAY,2,1) SUBWORD($TODAY,1,1)"," SUBWORD($TODAY,3)
QUEUE COPIES('=',80)
QUEUE "TODAY'S DATE:" DATE('W') $TODAY " JULIAN: "DATE('D') ,
" TIME IS:" TIME()
QUEUE COPIES('=',80)
QUEUE ' '
"EXECIO 4 DISKW" OUTPUT
/*-------- LIST ONLY THE USERID ATTRIBUTE INFO --------*/
DO $LOOP = 1 TO LIST.0
QUEUE LIST.$LOOP
"EXECIO 1 DISKW" OUTPUT
END /* DO LIST.0 */
/*------------------------------------------------------------------*/
/* CALl SYSTEM INFO REPORT */
/*------------------------------------------------------------------*/
CALL VERINFO
CALL SYSINFO
/*------------------------------------------------------------------*/
/* CLOSE THE 'DISPLAY' FILE */
/*------------------------------------------------------------------*/
QUEUE ''
"EXECIO 1 DISKW "OUTPUT" (FINIS"
/*------------------------------------------------------------------*/
/* CLEANUP */
/*------------------------------------------------------------------*/
IF $PRINT_FLAG = 'N' THEN DO
/*--------------------------------------------------------------*/
/* DISPLAY RESULTS TO SCREEN */
/*--------------------------------------------------------------*/
ADDRESS ISPEXEC "LMINIT DATAID(DATAID) DDNAME("OUTPUT")"
ADDRESS ISPEXEC "BROWSE DATAID("DATAID")"
END /* IF PRINT_FLAG... */
"FREE F("OUTPUT")"
DROPBUF 0
EXIT
/*********************************************************************/
VERINFO:
OPTION = 'VERSION'
Parse source . . . . . . . ENV . .
Numeric digits 10 /* dflt of 9 not enough */
Call HEADING /* Heading sub-routine */
Call COMMON /* control blocks needed by multiple routines */
Call VERSION /* Version information */
/*********************************************************************/
/* Done looking at all control blocks */
/*********************************************************************/
RETURN /* END VERINFO - RC 0 */
/*********************************************************************/
/* Start of sub-routines */
/*********************************************************************/
HEADING: /* Heading sub-routine */
QUEUE ; QUEUE
Queue '********************************************************' || ,
'***********************'
QUEUE '************************ VERSION INFORMATION *********' || ,
'***********************'
Queue '********************************************************' || ,
'***********************'
"EXECIO 5 DISKW" OUTPUT
return
/*********************************************************************/
COMMON: /* Control blocks needed by multiple routines */
CVT = C2d(Storage(10,4)) /* point to CVT */
PRODNAME = Storage(D2x(CVT - 40),7) /* point to mvs version */
If Substr(PRODNAME,3,1) > 3 then
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 */
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 */
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 */
If Substr(FMIDNUM,4,4) >= 6602 then ,
ECVTIPA = C2d(Storage(D2x(ECVT + 392),4)) /* point to IPA */
If Substr(FMIDNUM,4,4) > 6609 then ,
IPAARCHL = Storage(D2x(ECVTIPA + 2143),1) /* ARCHLVL (1 or 2) */
Return
/*********************************************************************/
VERSION: /* Version information sub-routine */
JESNAME = Storage(D2x(JESCT + 28),4) /* point to JESNAME */
If JESNAME = 'JES3' then do /* Is this JES3? */
JESLEV = SYSVAR(SYSJES) /* TSO/E VAR for JESLVL */
JESNODE = SYSVAR(SYSNODE) /* TSO/E VAR for JESNODE*/
End
Else do /* JES2 */
SSCVT = C2d(Storage(D2x(JESCT+24),4)) /* point to SSCVT */
SSCTSUSE = C2d(Storage(D2x(SSCVT+20),4)) /* point to SS usage */
JESLEV = Strip(Storage(D2x(SSCTSUSE),8)) /* JES Version */
SSCTSUS2 = C2d(Storage(D2x(SSCVT+28),4)) /* point to $HCCT */
Select
When Substr(JESLEV,1,6) == 'OS 1.1' | , /* OS/390 1.1 or */
Substr(JESLEV,1,4) == 'SP 5' then , /* ESA V5 JES2 */
JESNODE = Strip(Storage(D2x(SSCTSUS2+336),8)) /* JES2 NODE */
When Substr(JESLEV,1,6) == 'OS 2.1' then, /* OS/390 2.10 and > */
JESNODE = Strip(Storage(D2x(SSCTSUS2+452),8)) /* JES2 NODE */
When Substr(JESLEV,1,5) == 'OS 1.' | , /* OS/390 1.2 */
Substr(JESLEV,1,5) == 'OS 2.' then, /* through OS/390 2.9 */
JESNODE = Strip(Storage(D2x(SSCTSUS2+372),8)) /* JES2 NODE */
Otherwise , /* Lower than ESA V5 */
JESNODE = SYSVAR(SYSNODE) /* TSO/E VAR for JESNODE*/
End /* select */
End /* else do */
/* */
CVTRAC = C2d(Storage(D2x(CVT + 992),4)) /* point to RACF CVT */
RCVTID = Storage(D2x(CVTRAC),4) /* point to RCVTID */
/* RCVT, ACF2, or RTSS */
If RCVTID = 'RCVT' then RCVTID = 'RACF' /* RCVT is RACF */
If RCVTID = 'RTSS' then RCVTID = 'Top Secret' /* RTSS is Top Secret */
RACFVRM = Storage(D2x(CVTRAC + 616),4) /* RACF Ver/Rel/Mod */
RACFVER = Substr(RACFVRM,1,1) /* RACF Version */
RACFREL = Substr(RACFVRM,2,2) /* RACF Release */
RACFREL = Format(RACFREL) /* Remove leading 0 */
RACFMOD = Substr(RACFVRM,4,1) /* RACF MOD level */
RACFLEV = RACFVER || '.' || RACFREL || '.' || RACFMOD
/* */
CVTDFA = C2d(Storage(D2x(CVT + 1216),4)) /* point to DFP ID table*/
DFAPROD = C2d(Storage(D2x(CVTDFA +16),1)) /* point to relese byte */
If DFAPROD = 0 then do /* DFP not DF/SMS */
DFAREL = C2x(Storage(D2x(CVTDFA+2),2)) /* point to DFP release */
DFPVER = Substr(DFAREL,1,1) /* DFP Version */
DFPREL = Substr(DFAREL,2,1) /* DFP Release */
DFPMOD = Substr(DFAREL,3,1) /* DFP Mod Lvl */
DFPRD = 'DFP' /* product is DFP */
DFLEV = DFPVER || '.' || DFPREL || '.' || DFPMOD
End
Else do /* DFSMS not DFP */
DFARELS = C2x(Storage(D2x(CVTDFA+16),4)) /* point to DF/SMS rel */
DFAVER = X2d(Substr(DFARELS,3,2)) /* DF/SMS Version */
DFAREL = X2d(Substr(DFARELS,5,2)) /* DF/SMS Release */
DFAMOD = X2d(Substr(DFARELS,7,2)) /* DF/SMS Mod Lvl */
DFPRD = 'DFSMS' /* product is DF/SMS */
DFLEV = DFAVER || '.' || DFAREL || '.' || DFAMOD
End
/* */
CVTTVT = C2d(Storage(D2x(CVT + 156),4)) /* point to TSO vect tbl*/
TSVTLVER = Storage(D2x(CVTTVT+100),1) /* point to TSO Version */
TSVTLREL = Storage(D2x(CVTTVT+101),2) /* point to TSO Release */
TSVTLREL = Format(TSVTLREL) /* Remove leading 0 */
TSVTLMOD = Storage(D2x(CVTTVT+103),1) /* point to TSO Mod Lvl */
TSOLEV = TSVTLVER || '.' || TSVTLREL || '.' || TSVTLMOD
/* */
CVTEXT2 = C2d(Storage(D2x(CVT + 328),4)) /* point to CVTEXT2 */
CVTATCVT = C2d(Storage(D2x(CVTEXT2 + 65),3)) /* point to VTAM AVT */
ISTATCVT = C2d(Storage(D2x(CVTATCVT + 0),4)) /* point to VTAM CVT */
ATCVTLVL = Storage(D2x(ISTATCVT + 0),8) /* VTAM Rel Lvl VOVRP */
VTAMVER = Substr(ATCVTLVL,3,1) /* VTAM Version V */
VTAMREL = Substr(ATCVTLVL,4,1) /* VTAM Release R */
VTAMMOD = Substr(ATCVTLVL,5,1) /* VTAM Mod Lvl P */
If VTAMMOD = ' ' then VTAMLEV = VTAMVER || '.' || VTAMREL
else VTAMLEV = VTAMVER || '.' || VTAMREL || '.' || VTAMMOD
/* */
If Substr(PRODNAME,3,1) < 6 then
Queue 'The MVS version is 'PRODNAME' - FMID 'FMIDNUM'.'
Else do
PRODNAM2 = Storage(D2x(ECVT+496),16) /* point to product name*/
PRODNAM2 = Strip(PRODNAM2,T) /* del trailing blanks */
VER = Storage(D2x(ECVT+512),2) /* point to version */
REL = Storage(D2x(ECVT+514),2) /* point to release */
MOD = Storage(D2x(ECVT+516),2) /* point to mod level */
VRM = VER'.'REL'.'MOD
Queue 'The OS version is 'PRODNAM2 VRM' - FMID 'FMIDNUM'.'
End
Queue 'The primary job entry subsystem is 'JESNAME'.'
Queue 'The 'JESNAME 'level is 'JESLEV'.' ,
'The 'JESNAME 'node name is 'JESNODE'.'
If RACFVRM < '2608' then ,
Queue 'The security software is 'RCVTID'.' ,
'The RACF level is 'RACFLEV'.'
Else ,
Queue 'The security software is OS/390 Security Server (RACF).' ,
'The FMID is HRF' || RACFVRM || '.'
Queue 'The' DFPRD 'level is' DFLEV'.'
Queue 'The TSO level is 'TSOLEV'.'
If SYSISPF = 'ACTIVE' then do /* is ISPF active? */
Address ISPEXEC "VGET ZISPFOS" /* yes, is it OS?390? */
If RC = 0 then do /* yes, get OS/390 var */
ISPFLEV = Substr(ZISPFOS,10,15) /* only need version */
Queue 'The ISPF level is 'ISPFLEV'.'
End /* if RC */
Else do /* not OS/390 - use old variables */
Address ISPEXEC "VGET ZPDFREL" /* get pdf release info */
ISPFLEV = Substr(ZENVIR,6,3) /* ISPF level */
PDFLEV = Substr(ZPDFREL,5,3) /* PDF level */
Queue 'The ISPF level is 'ISPFLEV'. The PDF level is' PDFLEV'.'
End /* else do */
End /* if SYSISPF */
Queue 'The VTAM level is 'VTAMLEV'.'
$Q = QUEUED()
"EXECIO" $Q "DISKW" OUTPUT
Return
/*------------------------------------------------------------------*/
SYSINFO:
queue ' '
queue ' ----------------------------------------------------------'
queue ' '
CVT = C2D(STORAGE(10,4))
CVTPREF = CVT - X2D(100)
CSD = C2D(STORAGE(D2X(CVT + X2D(294)),4))
ECVT = C2D(STORAGE(D2X(CVT + X2D(8C)),4))
ECVTHDNM = STORAGE(D2X(ECVT+X2D(150)),8)
ECVTLPNM = STORAGE(D2X(ECVT+X2D(158)),8)
CSDPLPN = C2D(STORAGE(D2X(CSD + X2D(FC)),1))
PROCESSR = ECVTHDNM
LPAR = STRIP(ECVTLPNM)' (LPAR #'CSDPLPN')'
CVTRLSE = D2X(CVTPREF + X2D(FC))
RELEASE = STORAGE(CVTRLSE,4)
CVTSMCA = D2X(CVT + X2D(C5))
SMCA = C2D(STORAGE(CVTSMCA,3))
SMCAD = SMCA + X2D(154)
SMCAX = D2X(SMCAD)
SMCAXDTE = C2X(STORAGE(SMCAX,4))
IPLDATE = SUBSTR(SMCAXDTE,3,5)
IPLDAY = SUBSTR(SMCAXDTE,5,3)
SMCAD = SMCA + X2D(150)
SMCAX = D2X(SMCAD)
SMCATIME = C2D(STORAGE(SMCAX,4))
SECPAST0 = SMCATIME % 100
IPLTIME = STOHHMMSS(SECPAST0)
TODAY = SUBSTR(DATE('J'),3,3)
NOW = TIME('S')
DAYS = TODAY - IPLDAY
HOURS = NOW - SECPAST0
IF HOURS < 0
THEN
DO
DAYS = DAYS - 1
HOURS = HOURS + (24 * 3600)
END
IF DAYS = 1
THEN DAYLIT = 'DAY'
ELSE DAYLIT = 'DAYS'
IPLUPTIME= STOHHMMSS(HOURS)
CVTUCB = D2X(CVT + X2D(30))
UCB = C2D(STORAGE(CVTUCB,4))
UCBC = UCB + 4
UCBCHAN = D2X(UCBC)
IUCB = STORAGE(UCBCHAN,2)
IPLUCB = C2X(IUCB)
UCBV = UCB + X2D(1C)
UCBVOLI = D2X(UCBV)
IPLVOL = STORAGE(UCBVOLI,6)
RV = SYSVAR("SYSLRACF") /* RETURNS RACF LEVEL */
TV = SYSVAR("SYSTSOE") /* RETURNS VERSION OF TSO/E */
queue " RACF =" LEFT(RV,1)'.'SUBSTR(RV,3,1)'.'SUBSTR(RV,4,1)
queue ' TSO/E =' LEFT(TV,1)'.'SUBSTR(TV,3,1)'.'SUBSTR(TV,4,1)
queue " USER ID =" USERID()
queue " MVS =" MVSVAR('SYSMVS')
queue " RELEASE =" RELEASE
queue " SYSNAME =" MVSVAR('SYSNAME')
queue "PROCESSOR =" PROCESSR
queue " LPAR =" LPAR
queue " OPSYS =" MVSVAR('SYSOPSYS')
queue " UPTIME =" DAYS DAYLIT "+" IPLUPTIME
queue " IPL =" IPLDATE IPLTIME 'FROM' STRIP(IPLUCB,'L','0') IPLVOL
queue " SYSPLEX =" MVSVAR('SYSPLEX')
queue " SYSCLONE =" MVSVAR('SYSCLONE')
queue "DFP LEVEL =" MVSVAR('SYSDFP')
queue " SMF ID =" MVSVAR('SYSSMFID')
queue " SMS IS =" MVSVAR('SYSSMS' )
HID=C2D(STORAGE(D2X(CVT + X2D(42C)),4))
queue ' CPUTYPE =' STRIP(STORAGE(D2X(HID+26),6),'L','0'),
'MODEL='STRIP(STORAGE(D2X(HID+32),3),'L','0'),
'MANUFACTURER='STORAGE(D2X(HID+35),3),
'PLANT='STORAGE(D2X(HID+38),2),
'SEQNO='STRIP(STORAGE(D2X(HID+40),12),'L','0')
$Q = QUEUED()
"EXECIO" $Q "DISKW" OUTPUT
return
STOHHMMSS: PROCEDURE;
ARG TOD;
HRS = RIGHT(TOD % 3600,2,'0');
SECS = RIGHT(TOD//60,2,'0');
MINS = RIGHT((TOD - (HRS*3600))%60,2,'0');
RETURN(HRS':'MINS':'SECS);