/* REXX QPWEXP Calculate the expiration date of the user's password. If RACF doesn't run on this system, the response to the "LU" command is "RACF PRODUCT DISABLED". Calc the date on an ACF2 system. Use '(routine name) ?' for HELP-text. Written by Frank Clarke 20160526 rexxhead@yahoo.com Impact Analysis . SYSEXEC TRAPOUT Modification History 20210503 fxc made STACK work; REXXSKEL; add HELP 20230726 fxc adjust HELP; 20230806 fxc chg SYSPROC to SYSEXEC in Impact Analysis; 20230810 fxc set msglim based on screen width; 20240308 fxc chg dollar-sign to @ everywhere; */ arg argline /* pro-forma quick-start */ address TSO arg parms "((" opts signal on syntax signal on novalue call TOOLKIT_INIT /* conventional start-up -*/ rc = Trace("O"); rc = Trace(tv) info = parms /* to enable parsing */ call A_INIT /* Initialize; set switches -*/ call G_GET_EXPDT /* Calc EXPDT; output -*/ exit /*@ QPWEXP */ /* . ----------------------------------------------------------------- */ A_INIT: /*@ */ if branch then call BRANCH address TSO msglim = SYSVAR( "SYSWTERM" ) - 12 parse value "" with , mxday usrname pdate pinterval . sw.0ListAll = Switch("DUMP") sw.0Stack = Switch("STACK") return /*@ A_INIT */ /* . ----------------------------------------------------------------- */ G_GET_EXPDT: /*@ */ if branch then call BRANCH address TSO uid = Userid() rc = Outtrap("OUT.") /* trap command output */ secprod = "R" /* RACF */ "LU" uid "TSO" lurc = rc if lurc > 20 then do rc = Outtrap("OFF") ; rc = Outtrap("OUT.") /* reset */ secprod = "A" /* ACF2 */ queue "LIST *" /* ACF2 command */ queue "END" /* ACF2 command */ "ACF" /* provoke ACF2 */ end rc = Outtrap("OFF") /* process command output */ do ss = 1 to out.0 if secprod = "R" then do if Pos("PASSDATE=",out.ss) > 0 then do parse var out.ss "PASSDATE=" pdate . /* yy.ddd */ parse var pdate yy "." ddd bpdate = Date("B",yy||ddd,"J") /* date pw last chgd */ end if Pos("PASS-INTERVAL=",out.ss) > 0 then, parse var out.ss "PASS-INTERVAL=" mxday . if Pos("NAME=",out.ss) > 0 then, parse var out.ss "NAME=" usrname "OWNER" end /* R */ else, if secprod = "A" then do if Pos("PSWD-DAT(",out.ss) > 0 then do parse var out.ss "PSWD-DAT(" pdate ")" /* Date("U") */ bpdate = Date("B",pdate,"U") end if Pos("MAXDAYS",out.ss) > 0 then , parse var out.ss "MAXDAYS(" mxday ")" . if Word(out.ss,1) = uid then, parse var out.ss 48 usrname end /* A */ if usrname <> "" & pdate <> "" & mxday <> "" then leave ss end /* ss */ bpdate = bpdate + mxday expdate = Date("S",bpdate,"B") if sw.0Stack then do /* send it back to caller */ queue bpdate secprod mxday Strip(usrname) end /* Stack */ else, if sw.0ListAll then do /* show entire profile + calc */ do nn = 1 to out.0 msgtext = out.nn do while Length(msgtext) > msglim pt = LastPos(" ",msgtext,msglim) slug = Left(msgtext,pt) queue slug msgtext = Copies(" ",21)Substr(msgtext,pt) end /* while msglim */ queue msgtext end /* nn */ rc = Trace("O"); rc = Trace(tv) push " " push "Your password will expire on", Translate("CcYy-Mm-Dd",expdate,"CcYyMmDd") "ALLOC FI(@RPT) UNIT(SYSDA) NEW REU SPACE(1) TRACKS", "RECFM(V B) LRECL(121) BLKSIZE(0)" "EXECIO" queued() "DISKW @RPT (FINIS" address ISPEXEC "LMINIT DATAID(RPT) DDNAME(@RPT)" "VIEW DATAID(&RPT) PROFILE(DEFAULT)" end /* ListAll */ else, /* display on screen */ say "Your password will expire on", Translate("CcYy-Mm-Dd",expdate,"CcYyMmDd") return /*@ G_GET_EXPDT */ /* . ----------------------------------------------------------------- */ LOCAL_PREINIT: /*@ customize opts */ address TSO return /*@ LOCAL_PREINIT */ /* subroutines below LOCAL_PREINIT are not selected by SHOWFLOW */ /* . ----------------------------------------------------------------- */ HELP: /*@ */ address TSO;"CLEAR" if helpmsg <> "" then say helpmsg ex_nam = Left(exec_name,8) /* predictable size */ say " " say " "ex_nam" calculates the date on which your password will expire and" say " you will be required to change it. It does this by " say " examining your RACF or ACF2 profile to determine the date " say " your password was last changed and your 'password " say " interval', which yields the expiration date. " say " " say " Syntax: "ex_nam" STACK " say " DUMP " say " " say " STACK (switch in parms) causes the datapoints 'exp-date', " say " 'security-product', 'interval', and 'user-name' to " say " be placed on the stack for use by a calling routine." say " " say " DUMP (switch in parms) copies the RACF or ACF2 profile " say " to a temporary dataset and places you in VIEW " say " on it. " say " " say " If neither STACK nor DUMP is specified, the default action is " say " to write a message 'Your password will expire on " say " .' " "NEWSTACK"; pull ; "CLEAR" ; "DELSTACK" say " Debugging tools provided include: " say " " say " BRANCH show all paragraph entries. " say " " say " TRACE tv will use value following TRACE to place the " say " execution in REXX TRACE Mode. " say " " say " " say " Debugging tools can be accessed in the following manner: " say " " say " TSO "ex_nam" parameters (( debug-options " say " " say " For example " say " " say " TSO "ex_nam" (( MONITOR TRACE ?R " if sw.inispf then, address ISPEXEC "CONTROL DISPLAY REFRESH" exit /*@ HELP */ /* . ----------------------------------------------------------------- */ BRANCH: Procedure expose, /*@ */ sigl exec_name rc = trace("O") /* we do not want to see this */ arg brparm . origin = sigl /* where was I called from ? */ do currln = origin to 1 by -1 /* inch backward to label */ if Right(Word(Sourceline(currln),1),1) = ":" then do parse value sourceline(currln) with pgfname ":" . /* Label */ leave ; end /* name */ end /* currln */ select when brparm = "NAME" then return(pgfname) /* Return full name */ when brparm = "ID" then do /* wants the prefix */ parse var pgfname pgfpref "_" . /* get the prefix */ return(pgfpref) end /* brparm = "ID" */ otherwise say left(sigl,6) left(pgfname,40) exec_name "Time:" time("L") end /* select */ return /*@ BRANCH */ /* . ----------------------------------------------------------------- */ DUMP_QUEUE: /*@ Take whatever is in stack */ rc = trace("O") /* and write to the screen */ address TSO "QSTACK" /* how many stacks? */ stk2dump = rc - tk_init_stacks /* remaining stacks */ if stk2dump = 0 & queued() = 0 then return say "Total Stacks" rc , /* rc = #of stacks */ " Begin Stacks" tk_init_stacks , /* Stacks present at start */ " Excess Stacks to dump" stk2dump do dd = rc to tk_init_stacks by -1 /* empty each one. */ say "Processing Stack #" dd " Total Lines:" queued() do queued();pull line;say line;end /* pump to the screen */ "DELSTACK" /* remove stack */ end /* dd = 1 to rc */ return /*@ DUMP_QUEUE */ /* Handle CLIST-form keywords added 20020513 . ----------------------------------------------------------------- */ CLKWD: Procedure expose info /*@ hide all except info */ arg kw kw = kw"(" /* form is 'KEY(DATA)' */ kw_pos = Pos(kw,info) /* find where it is, maybe */ if kw_pos = 0 then return "" /* send back a null, not found*/ rtpt = Pos(") ",info" ",kw_pos) /* locate end-paren */ slug = Substr(info,kw_pos,rtpt-kw_pos+1) /* isolate */ info = Delstr(info,kw_pos,rtpt-kw_pos+1) /* excise */ parse var slug (kw) slug /* drop kw */ slug = Reverse(Substr(Reverse(Strip(slug)),2)) return slug /*@CLKWD */ /* Handle multi-word keys 20020513 . ----------------------------------------------------------------- */ KEYWD: Procedure expose info /*@ hide all vars, except info*/ arg kw kw_pos = wordpos(kw,info) /* find where it is, maybe */ if kw_pos = 0 then return "" /* send back a null, not found*/ kw_val = word(info,kw_pos+Words(kw))/* get the next word */ info = Delword(info,kw_pos,2) /* remove both */ return kw_val /*@ KEYWD */ /* . ----------------------------------------------------------------- */ KEYPHRS: Procedure expose, /*@ */ info helpmsg exec_name /* except these three */ arg kp wp = wordpos(kp,info) /* where is it? */ if wp = 0 then return "" /* not found */ front = subword(info,1,wp-1) /* everything before kp */ back = subword(info,wp+1) /* everything after kp */ parse var back dlm back /* 1st token must be 2 bytes */ if length(dlm) <> 2 then /* Must be two bytes */ helpmsg = helpmsg, "Invalid length for delimiter("dlm") with KEYPHRS("kp")" if wordpos(dlm,back) = 0 then /* search for ending delimiter*/ helpmsg = helpmsg, "No matching second delimiter("dlm") with KEYPHRS("kp")" if helpmsg <> "" then call HELP /* Something is wrong */ parse var back kpval (dlm) back /* get everything b/w delim */ info = front back /* restore remainder */ return Strip(kpval) /*@ KEYPHRS */ /* . ----------------------------------------------------------------- */ NOVALUE: /*@ */ say exec_name "raised NOVALUE at line" sigl say " " say "The referenced variable is" condition("D") say " " zsigl = sigl signal SHOW_SOURCE /*@ NOVALUE */ /* . ----------------------------------------------------------------- */ SHOW_SOURCE: /*@ */ call DUMP_QUEUE /* Spill contents of stacks -*/ if sourceline() <> "0" then /* to screen */ say sourceline(zsigl) rc = trace("?R") nop exit /*@ SHOW_SOURCE */ /* . ----------------------------------------------------------------- */ SS: Procedure /*@ Show Source */ arg ssbeg ssend . if ssend = "" then ssend = 10 if \datatype(ssbeg,"W") | \datatype(ssend,"W") then return ssend = ssbeg + ssend do ssii = ssbeg to ssend ; say Strip(sourceline(ssii),'T') ; end return /*@ SS */ /* . ----------------------------------------------------------------- */ SWITCH: Procedure expose info /*@ */ arg kw sw_val = Wordpos(kw,info) > 0 /* exists = 1; not found = 0 */ if sw_val then /* exists */ info = Delword(info,Wordpos(kw,info),1) /* remove it */ return sw_val /*@ SWITCH */ /* . ----------------------------------------------------------------- */ SYNTAX: /*@ */ errormsg = exec_name "encountered REXX error" rc "in line" sigl":", errortext(rc) say errormsg zsigl = sigl signal SHOW_SOURCE /*@ SYNTAX */ /* Can call TRAPOUT. . ----------------------------------------------------------------- */ TOOLKIT_INIT: /*@ */ address TSO info = Strip(opts,"T",")") /* clip trailing paren */ parse source sys_id how_invokt exec_name DD_nm DS_nm, as_invokt cmd_env addr_spc usr_tokn parse value "" with tv helpmsg . parse value 0 "ISR00000 YES" "Error-Press PF1" with, sw. zerrhm zerralrm zerrsm if SWITCH("TRAPOUT") then do "TRAPOUT" exec_name parms "(( TRACE R" info exit end /* trapout */ sw.nested = sysvar("SYSNEST") = "YES" sw.batch = sysvar("SYSENV") = "BACK" sw.inispf = sysvar("SYSISPF") = "ACTIVE" if Word(parms,1) = "?" then call HELP /* I won't be back */ "QSTACK" ; tk_init_stacks = rc /* How many stacks? */ parse value SWITCH("BRANCH") SWITCH("MONITOR") SWITCH("NOUPDT") with, branch monitor noupdt . parse value mvsvar("SYSNAME") sysvar("SYSNODE") with, #tk_cpu node . parse value KEYWD("TRACE") "N" with tv . tk_globalvars = "exec_name tv helpmsg sw. zerrhm zerralrm ", "zerrsm zerrlm tk_init_stacks branch monitor ", "noupdt" call LOCAL_PREINIT /* for more opts -*/ return /*@ TOOLKIT_INIT */