/* REXX ATTACH a routine to perform LOGON-time customization of a TSO user environment, especially as regards file allocations. Use '(routine name) ?' for HELP-text. Written by Frank Clarke rexxhead@yahoo.com 19970921 . Impact Analysis . SYSEXEC LA . SYSEXEC NOOP . SYSEXEC TRAPOUT Some files are pre-allocated; an input file will provide additional information in the following form: ATTACH filename dsname (AHEAD, BEHIND, UNIQUE, FIRST, LAST, ONLY) DETACH filename dsname DROP filename INCLUDE dsname TSO CLIST or REXX EXEC REXX executable-command The default primary input file is member 'START' from the caller's ISPF.PROFILE dataset. . Process: Each command will be processed in the order encountered, except that all INCLUDE statements and nested INCLUDEs must first be expanded. All allocations will be collected and processed together. . Begin: determine all existing allocations; process each ATTACH, DETACH, DROP, and INCLUDE statement found in the command stack; . ATTACH: the dsname specified is first removed (if it exists in the allocation for the filename) and then inserted either at the head of the sequence or at the tail; . DETACH: the dsname specified is removed (if it exists in the allocation for the filename) . DROP: the file specified is FREEd. . INCLUDE: the dsname specified is presumed to contain ATTACH, DETACH, DROP, TSO, REXX, and INCLUDE commands; it is read into the command stack where found. Because of the possibility of nested INCLUDEs, the presence of an INCLUDE requires the stack to be reprocessed. . TSO/ indicates a command to be stored for execution after . REXX: all the allocations are finalized. The command must be executable as written. TSO statements are executed in-line after all allocations complete; REXX statements are queued for execution by the system after ATTACH ends. Modification History 19990922 fxc added call to EXECUTIL and NOOP to force SYSEXEC closed so that ATTACH may be re-run; RXSKLY2K; 19991021 fxc added FIRST=AHEAD, ONLY=UNIQUE, LAST=BEHIND 19991122 fxc upgrade from v.19980225 to v.19991109; 20010327 fxc add external logging 20230414 fxc adjust HELP; shift input to uppercase; 20230723 fxc modernize logging; 20230806 fxc chg SYSPROC to SYSEXEC in Impact Analysis; 20230908 fxc set log lrecl to 255; 20240308 fxc chg dollar-sign to @ everywhere; 20240414 fxc DUMP_QUEUE quiet; */ arg argline address TSO /* REXXSKEL ver.19991109 */ arg parms "((" opts signal on syntax signal on novalue call TOOLKIT_INIT /* conventional start-up -*/ rc = trace(tv) info = parms /* to enable parsing */ call A_INIT /* -*/ call B_EXISTING_ALLOCS /* -*/ "NEWSTACK" call C_LOAD_CMD_STACK /* -*/ call D_BUILD_LISTS /* -*/ "DELSTACK" call E_REALLOC /* -*/ if sw.0DoLog then, /* */ call ZB_SAVELOG /* -*/ return /*@ ATTACH */ /* . ----------------------------------------------------------------- */ A_INIT: /*@ */ if branch then call BRANCH address TSO call A0_SETUP_LOG /* -*/ localvars = "dsn." parse value "0 0 0 0 0 0 0 0 0 0 0" with, REXX_cmds. stored_cmds. . parse value "" with, dsn. ddn sw.0DoLog = SWITCH("NOLOG") = '0' return /*@ A_INIT */ /* . ----------------------------------------------------------------- */ A0_SETUP_LOG: /*@ */ if branch then call BRANCH address TSO parse value "0" with, log# log. tk_globalvars = tk_globalvars "log. log#" parse value Date("S") Time("S") Time("N") with, yyyymmdd sssss hhmmss . hhmmss = Space( Translate( hhmmss,' ',':' ) ,0 ) parse var yyyymmdd 4 yrdigit 5 mm 7 dd /* 9 12 14 maybe */ if Pos(yrdigit,"13579") > 0 then mm = mm + 12 /* mm=24 */ logtag = Substr("ABCDEFGHIJKLMNOPQRSTUVWX",mm,1) /* logtag=X */ subid = logtag""dd""Left( hhmmss,4 ) /* X141743 ? */ logdsn = "@LOG."exec_name"."subid".LIST" call ZL_LOGMSG("Log started by" Userid() yyyymmdd hhmmss) return /*@ A0_SETUP_LOG */ /* Determine all the existing allocations. . ----------------------------------------------------------------- */ B_EXISTING_ALLOCS: /*@ */ if branch then call BRANCH address TSO "NEWSTACK" "LA ((STACK LIST" do queued() pull line parse var line ddn ":" dsn.ddn end /* queued */ "DELSTACK" return /*@ B_EXISTING_ALLOCS */ /* . Read the base command file and examine for the presence of INCLUDE commands. For any INCLUDE, read the file specified and insert the contents directly to the bottom of the queue. . ATTACH, DETACH, and DROP commands can be re-written at the bottom of the original queue. . REXX and TSO commands are to be stored for later use. Notes on the use of the QUEUE: - a 'do queued()' is evaluated once at the start of the loop and is not re-evaluated if lines are later added to the queue. - sw.0continue is set ON by a call to CA_; this causes a later re-evaluation of the 'do queued()' if lines are added. - result: if an INCLUDE is found, the text of the referenced dataset replaces the INCLUDE and the stack is flagged for reprocessing; thus, if an INCLUDE points to a nested INCLUDE, the nested include is loaded and processed as if its text were coded as part of the base command file. . ----------------------------------------------------------------- */ C_LOAD_CMD_STACK: /*@ */ if branch then call BRANCH address TSO call CA_EAT_CMDFILE basefile /* sets sw.0continue -*/ do while sw.0continue sw.0continue = "0" /* automatic shut-off */ do queued() pull verb linedata /* shift upper */ if Wordpos(verb,"DROP REXX TSO ATTACH DETACH") > 0 then, queue verb linedata; else, if verb = "INCLUDE" then, call CA_EAT_CMDFILE linedata /* sets sw.0continue -*/ end /* queued */ end /* while */ "FREE FI(CMD)" /* the queue contains only REXX, TSO, ATTACH, and DETACH commands */ return /*@ C_LOAD_CMD_STACK */ /* BASEFILE is always presented fully-qualified and unquoted. . ----------------------------------------------------------------- */ CA_EAT_CMDFILE: Procedure expose, /*@ */ (tk_globalvars) if branch then call BRANCH address TSO arg basefile . if Sysdsn("'"basefile"'") <> "OK" then return sw.0continue = "1" "ALLOC FI(CMD) DA('"basefile"') SHR REU" "EXECIO * DISKR CMD (FINIS" logpref = "("Branch("ID")")" call ZL_LOGMSG( logpref "Added '"basefile"' to the queue.") return /*@ CA_EAT_CMDFILE */ /* . Input: array DSN.ddname (all the DSNames by DDName) the queue containing all the TSO, ATTACH, and DETACH commands Any named DSN is first excised from the current allocation if it exists (this is ALL of the processing for DETACH), after which it may be ATTACHed either AHEAD of the first dataset or BEHIND the last. . ----------------------------------------------------------------- */ D_BUILD_LISTS: /*@ */ if branch then call BRANCH address TSO parse value "" with, ddnlist . do queued() pull verb linedata logpref = "("Branch("ID")")" call ZL_LOGMSG( logpref verb linedata) select when verb = "TSO" then do parse value stored_cmds.0+1 linedata with, @z@ stored_cmds.@z@ 1 stored_cmds.0 . iterate end /* TSO */ when verb = "REXX" then do parse value REXX_cmds.0+1 linedata with, @z@ REXX_cmds.@z@ 1 REXX_cmds.0 . iterate end /* REXX */ when verb = "DROP" then do parse var linedata ddn . if ddn = "" then iterate /* too few tokens */ if dsn.ddn = "" then iterate /* nothing to drop */ dsn.ddn = "" /* just in case */ call DA_MARK ddn /* -*/ end /* DROP */ when verb = "DETACH" then do parse var linedata ddn dsn . if dsn = "" then iterate /* too few tokens */ wrdpos = Wordpos(dsn,dsn.ddn) if wrdpos > 0 then do dsn.ddn = Delword(dsn.ddn,wrdpos,1) call DA_MARK ddn /* -*/ end end /* DETACH */ when verb = "ATTACH" then do parse var linedata ddn dsn option . if dsn = "" then iterate /* too few tokens */ wrdpos = Wordpos(dsn,dsn.ddn) if wrdpos > 0 then, dsn.ddn = Delword(dsn.ddn,wrdpos,1) if WordPos(option,"AHEAD FIRST") > 0 then, dsn.ddn = dsn dsn.ddn ; else, if WordPos(option,"UNIQUE ONLY") > 0 then, dsn.ddn = dsn ; else, dsn.ddn = dsn.ddn dsn call DA_MARK ddn /* -*/ end /* ATTACH */ otherwise nop end /* select */ end /* queued */ return /*@ D_BUILD_LISTS */ /* Add this DDN to DDNLIST if it doesn't already exist there. This is the list of DDNames which need to be re-allocated. . ----------------------------------------------------------------- */ DA_MARK: Procedure expose, /*@ */ (tk_globalvars), ddnlist if branch then call BRANCH arg ddn . if Wordpos(ddn,ddnlist) = 0 then, ddnlist = ddnlist ddn return /*@ DA_MARK */ /* Reallocate any DDName which has been changed. . ----------------------------------------------------------------- */ E_REALLOC: /*@ */ e_tv = trace() /* what setting at entry ? */ if branch then call BRANCH address TSO if WordPos("SYSEXEC",ddnlist) > 0 then do "EXECUTIL EXECDD(CLOSE)" "NOOP" /* this MUST be in SYSEXEC This must NOT BE in any ALTLIBed dataset ahead of SYSEXEC */ sw.0turn_on_SYSEXEC = "1" logpref = "("Branch("ID")")" call ZL_LOGMSG( logpref "EXECUTIL issued to close SYSEXEC") end do while ddnlist <> "" parse var ddnlist ddn ddnlist call EA_ADD_QUOTES /* -*/ call EB_ALLOC /* -*/ end if sw.0turn_on_SYSEXEC then do "EXECUTIL EXECDD(NOCLOSE) SEARCHDD(YES)" logpref = "("Branch("ID")")" call ZL_LOGMSG( logpref "EXECUTIL issued to set SYSEXEC NOCLOSE") end rc = Trace("O"); rc = trace(e_tv) signal off novalue /* */ do ex = 1 to stored_cmds.0 call ZL_LOGMSG( logpref stored_cmds.ex) if \noupdt then, (stored_cmds.ex) end /* ex */ rc = Trace("O"); rc = trace(e_tv) do ex = 1 to REXX_cmds.0 call ZL_LOGMSG( logpref REXX_cmds.ex) if \noupdt then, interpret REXX_cmds.ex end /* ex */ return /*@ E_REALLOC */ /* DSN.DDN has all DSNames fully-qualified and unquoted. Make it suitable for use in an ALLOC command. . ----------------------------------------------------------------- */ EA_ADD_QUOTES: /*@ */ if branch then call BRANCH address TSO do Words(dsn.ddn) parse var dsn.ddn dsn dsn.ddn dsn.ddn = dsn.ddn "'"dsn"'" end /* each word of dsn.ddn */ return /*@ EA_ADD_QUOTES */ /* . ----------------------------------------------------------------- */ EB_ALLOC: /*@ */ if branch then call BRANCH address TSO if dsn.ddn = "" then, /* empty dataset list */ alloccmd = "FREE FI("ddn")" else, /* reallocate */ alloccmd = "ALLOC FI("ddn") DA("dsn.ddn") SHR REU" logpref = "("Branch("ID")")" call ZL_LOGMSG( logpref alloccmd) if \noupdt then do (alloccmd) call ZL_LOGMSG( logpref "ALLOC rc="rc) end return /*@ EB_ALLOC */ /* . ----------------------------------------------------------------- */ LOCAL_PREINIT: /*@ customize opts */ if branch then call BRANCH address TSO "CLEAR" say exec_name "started" Time() parse value KEYWD("BASEFILE") "ISPF.PROFILE(START)" with, basefile . if Sysdsn(basefile) <> "OK" then do say basefile Sysdsn(basefile) exit end /* basefile not found ? */ if Left(basefile,1) = "'" then, /* quoted */ basefile = Strip(basefile,,"'") /* unquoted */ else, /* originally unquoted */ basefile = Userid()"."basefile /* fully-qualified */ return /*@ LOCAL_PREINIT */ /* ---- subroutines below LOCAL_PREINIT are not selected by SHOWFLOW */ /* . ----------------------------------------------------------------- */ ZB_SAVELOG: /*@ */ if branch then call BRANCH address TSO if Symbol("LOG#") = "LIT" then return /* not yet set */ vb4k.0 = "NEW CATALOG UNIT(SYSDA) SPACE(1 5) TRACKS", "RECFM( V B ) LRECL( 255 ) BLKSIZE( 0 )" "ALLOC FI(@LOG) DA("logdsn") REU" vb4k.0 "EXECIO" log# "DISKW @LOG (STEM LOG. FINIS" "FREE FI(@LOG)" return /*@ ZB_SAVELOG */ /* . ----------------------------------------------------------------- */ ZL_LOGMSG: Procedure expose, /*@ */ (tk_globalvars) rc = Trace("O") address TSO parse arg msgtext parse value log#+1 msgtext with, zz log.zz 1 log# . if monitor then say, msgtext return /*@ ZL_LOGMSG */ /* . ----------------------------------------------------------------- */ HELP: /*@ */ address TSO;"CLEAR" if helpmsg <> "" then say helpmsg; say "" ex_nam = Left(exec_name,8) /* predictable size */ say " "ex_nam" Environment customizer " say " " say " Syntax: "ex_nam" NOLOG " say " (( BASEFILE dsn " say " " say " NOLOG if specified suppresses production of the logfile, a " say " diagnostic tool. " say " " say " dsn is a file of input statements to be processed. If not " say " specified, it defaults to .ISPF.PROFILE(START). " say " Six verbs are currently supported: ATTACH, DETACH, " say " DROP, INCLUDE, TSO, and REXX. " say " " say " NOTE all DSNs are presented fully-qualified and UNquoted. " say " " say " more..... " "NEWSTACK"; pull; "DELSTACK"; "CLEAR" say " " say " ATTACH ddname dsname AHEAD or BEHIND or UNIQUE " say " or FIRST or LAST or ONLY " say " the specified dsname will be added to the allocation " say " list for the ddname either at the head AHEAD or FIRST, " say " at the tail BEHIND or LAST, or as the ONLY dataset for " say " this file UNIQUE or ONLY. If the dsname already " say " appears in the list, it will first be expunged. " say " " say " DETACH ddname dsname " say " the specified dsname will be removed from the " say " allocation list for the ddname. " say " " say " DROP DDname " say " the named FILE will be FREEd. " say " more..... " "NEWSTACK"; pull; "DELSTACK"; "CLEAR" say " " say " INCLUDE dsn " say " the text of 'dsn' will be inserted at the point the " say " INCLUDE is discovered and will be reprocessed as " say " command-data. " say " " say " TSO executable-command " say " names a CLIST or REXX EXEC to be executed as part of " say " the customization process. " say " " say " REXX executable-command " say " the command must be executable as written. REXX " say " commands will be interpreted after all TSO commands " say " have been executed. This is a good place to 'queue " say " ispf', for example, in order to cause ISPF to start " say " automatically. " say " more..... " "NEWSTACK"; pull; "DELSTACK"; "CLEAR" say " Debugging tools provided include: " say " " say " MONITOR: displays key information throughout processing. " say " Displays most paragraph names upon entry. " say " " say " NOUPDT: by-pass all update logic. " say " " say " BRANCH: show all paragraph entries. " say " " say " TRACE tv: will use value following TRACE to place the execution " say " 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 sysvar("SYSISPF") = "ACTIVE" 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 arg mode . "QSTACK" /* how many stacks? */ stk2dump = rc - tk_init_stacks /* remaining stacks */ if stk2dump = 0 & queued() = 0 then return if mode <> "QUIET" then, 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. */ if mode <> "QUIET" then, say "Processing Stack #" dd " Total Lines:" queued() do queued();parse 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 'quiet' /* 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 */ 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 . sw.nested = sysvar("SYSNEST") = "YES" sw.batch = sysvar("SYSENV") = "BACK" sw.inispf = sysvar("SYSISPF") = "ACTIVE" 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 */