/* REXX */
/*--------------------------------------------------------------------*/
/* ZDIAG - ISPF batch launcher for z/OS diagnostic utilities          */
/*                                                                    */
/* Author : SARATH S                                                  */
/* Build  : Stable 3.2 - self-contained package                     */
/*                                                                    */
/* Permanent placement: one normal SYSPROC/SYSEXEC library.           */
/* Runtime utility execs are NOT allocated in the foreground session. */
/*--------------------------------------------------------------------*/

signal on syntax name Fatal

parse arg zdArg
zdArg = strip(zdArg)

zdSiteHlq = 'OEMDS.RUN'
zdDefExec = zdSiteHlq'.EXEC'
zdDefPanel = zdSiteHlq'.PANEL'
zdVersion = '3.2'
zdLibdef = 0

if sysvar('SYSISPF') <> 'ACTIVE' then do
  zdStart = '%ZDIAG'
  if zdArg <> '' then zdStart = zdStart' 'zdArg
  address TSO 'ISPSTART CMD('zdStart')'
  exit rc
end

address ISPEXEC 'CONTROL ERRORS RETURN'

/* ISPF profile variables. Names are kept at eight characters or less. */
ZDVER = ''
ZDEXEC = ''
ZDPANEL = ''
ZDJC1 = ''
ZDJC2 = ''
ZDJC3 = ''
ZDJC4 = ''

address ISPEXEC ,
  'VGET (ZDVER ZDEXEC ZDPANEL ZDJC1 ZDJC2 ZDJC3 ZDJC4) PROFILE'

if strip(ZDEXEC) = '' then ZDEXEC = zdDefExec
if strip(ZDPANEL) = '' then ZDPANEL = zdDefPanel

call SetPanelLib ZDPANEL
zdRc = result
if zdRc = 0 then do
  call CheckPanelLib ZDPANEL
  zdRc = result
end

if zdRc <> 0 then do
  if translate(strip(ZDPANEL)) <> translate(zdDefPanel) then do
    ZDPANEL = zdDefPanel
    call SetPanelLib ZDPANEL
    zdRc = result
    if zdRc = 0 then do
      call CheckPanelLib ZDPANEL
      zdRc = result
    end
  end
end

if zdRc <> 0 then do
  say 'ZDIAG: Unable to use the panel library:'
  say '  'ZDPANEL
  say 'Default panel library:'
  say '  'zdDefPanel
  exit 20
end

ZCMD = ''
ZPARM = ''
ZMSG = ''
ZSTATUS = ''
ZUTIL = ''
ZDESC = ''
ZSETMSG = ''

/* First use opens setup. A JOB card is not required just to enter. */
if ZDVER <> zdVersion then do
  ZSETMSG = 'First use: review settings. JOB card may be left blank.'
  call SetupPanel
end

if translate(zdArg) = 'HELP' | zdArg = '?' then do
  call ShowHelp
  call Cleanup
  exit 0
end

if translate(zdArg) = 'JOBCARD' then do
  ZSETMSG = 'Update JOB card and library settings.'
  call SetupPanel
  zdArg = ''
end

/* Direct arguments remain available, but normal use is the menu. */
if strip(zdArg) <> '' then do
  parse var zdArg zdKey zdRest
  ZUTIL = Resolve(translate(strip(zdKey)))
  if ZUTIL <> '' then do
    ZPARM = strip(zdRest)
    ZDESC = Description(ZUTIL)
    call EnsureReady
    if result = 0 then do
      call SubmitDiag
      zdSub = result
      if zdSub = 0 then do
        ZSTATUS = 'Job submitted'
        ZMSG = ZUTIL' submitted as 'ZJOBNM'.'
        ZPARM = ''
      end
      else do
        ZSTATUS = 'Submit failed'
        ZMSG = 'Submission failed RC='zdSub'. 'ZSUBMSG
      end
    end
  end
end

do forever
  call ClearSelections

  /* Status/message from a completed submission is displayed once. */
  zdOneShot = strip(ZSTATUS) <> ''

  address ISPEXEC 'DISPLAY PANEL(ZDIAGP)'
  zdRc = rc

  if zdOneShot then do
    ZSTATUS = ''
    ZMSG = ''
  end

  if zdRc = 8 then leave
  if zdRc <> 0 then do
    say 'ZDIAG: DISPLAY ZDIAGP failed RC='zdRc
    leave
  end

  zdChoice = strip(ZCMD)
  ZCMD = ''

  if zdChoice = '' then do
    zdSel = 0
    zdBad = 0

    do zdI = 1 to 10
      zdV = strip(value('S'zdI))

      if zdV <> '' then do
        if translate(zdV) <> 'S' then zdBad = 1
        else do
          zdSel = zdSel + 1
          zdNo = zdI
        end
      end
    end

    if zdBad then do
      ZMSG = 'Use S in one selection field.'
      iterate
    end

    if zdSel > 1 then do
      ZMSG = 'Select only one utility.'
      iterate
    end

    if zdSel = 1 then zdChoice = zdNo
  end

  if strip(zdChoice) = '' then iterate

  parse var zdChoice zdKey zdRest
  zdKey = translate(strip(zdKey))

  if zdKey = 'HELP' | zdKey = '?' then do
    call ShowHelp
    iterate
  end

  if zdKey = 'JOBCARD' then do
    ZSETMSG = 'Update JOB card and library settings.'
    call SetupPanel
    iterate
  end

  ZUTIL = Resolve(zdKey)
  if ZUTIL = '' then do
    ZMSG = 'Unknown selection: 'zdKey
    iterate
  end

  if strip(zdRest) <> '' then ZPARM = strip(zdRest)
  ZDESC = Description(ZUTIL)

  zdSsin = '%ZDBATCH 'ZUTIL
  if strip(ZPARM) <> '' then zdSsin = zdSsin' 'ZPARM

  if length(zdSsin) > 80 then do
    ZMSG = 'Utility and parameters exceed one 80-byte SYSTSIN record.'
    iterate
  end

  call EnsureReady
  if result <> 0 then iterate

  call SubmitDiag
  zdSub = result

  if zdSub = 0 then do
    ZSTATUS = 'Job submitted'
    ZMSG = ZUTIL' submitted as 'ZJOBNM'.'
    ZPARM = ''
  end
  else do
    ZSTATUS = 'Submit failed'
    ZMSG = 'Submission failed RC='zdSub'. 'ZSUBMSG
  end
end

call Cleanup
exit 0


EnsureReady:
if strip(ZDEXEC) = '' then ZDEXEC = zdDefExec
if strip(ZDPANEL) = '' then ZDPANEL = zdDefPanel

call CheckExecLib ZDEXEC,ZUTIL
if result <> 0 then do
  ZSETMSG = 'Runtime EXEC setup is incomplete. Review settings.'
  call SetupPanel
  if result = 8 then return 8
end

call ValidateJobcard
if result <> 0 then do
  ZSETMSG = 'Enter a valid JOB statement before submitting.'
  call SetupPanel
  if result = 8 then return 8
end

call ValidateJobcard
if result <> 0 then do
  ZMSG = 'JOB card is still missing or invalid.'
  return 12
end

call CheckExecLib ZDEXEC,ZUTIL
if result <> 0 then do
  ZMSG = 'Runtime EXEC library or selected utility is unavailable.'
  return 12
end
return 0


SetupPanel:
spOldPanel = ZDPANEL

address ISPEXEC 'DISPLAY PANEL(ZDIAGSET)'
spRc = rc

if spRc = 8 then return 8
if spRc <> 0 then do
  ZMSG = 'Setup panel failed RC='spRc
  return spRc
end

if strip(ZDEXEC) = '' then ZDEXEC = zdDefExec
if strip(ZDPANEL) = '' then ZDPANEL = zdDefPanel

ZDEXEC = translate(strip(ZDEXEC))
ZDPANEL = translate(strip(ZDPANEL))

call HasJobcard
if result then do
  call ValidateJobcard
  if result <> 0 then do
    ZSETMSG = 'First nonblank JOB line must be a //... JOB statement.'
    call SetupPanel
    return result
  end
end

call CheckPanelLib ZDPANEL
if result <> 0 then do
  ZDPANEL = spOldPanel
  ZSETMSG = 'Requested panel library is not usable; prior value kept.'
  ZMSG = ZSETMSG
  return 12
end

if translate(spOldPanel) <> translate(ZDPANEL) then do
  call SetPanelLib ZDPANEL
  if result <> 0 then do
    ZDPANEL = spOldPanel
    call SetPanelLib ZDPANEL
    ZMSG = 'Unable to activate requested panel library.'
    return 12
  end
end

ZDVER = zdVersion
call SaveProfile
ZSETMSG = ''
ZMSG = 'Setup saved.'
return 0


SaveProfile:
address ISPEXEC ,
  'VPUT (ZDVER ZDEXEC ZDPANEL ZDJC1 ZDJC2 ZDJC3 ZDJC4) PROFILE'
return rc


SetPanelLib:
parse arg splDsn

if zdLibdef then do
  address ISPEXEC 'LIBDEF ISPPLIB'
  zdLibdef = 0
end

address ISPEXEC ,
  "LIBDEF ISPPLIB DATASET ID('"strip(splDsn)"') STACK"
splRc = rc

if splRc = 0 then zdLibdef = 1
return splRc


HasJobcard:
do hj = 1 to 4
  if strip(value('ZDJC'hj)) <> '' then return 1
end
return 0


ValidateJobcard:
vjFound = 0

do vj = 1 to 4
  vjLine = strip(value('ZDJC'vj))

  if vjLine = '' then iterate
  if length(vjLine) > 80 then return 12

  if vjFound = 0 then do
    vjFound = 1
    if left(vjLine,2) <> '//' then return 12
    if pos(' JOB ',translate(' 'vjLine' ')) = 0 then return 12
  end
end

if vjFound = 0 then return 12
return 0


CheckExecLib:
parse arg ceLib, ceMember
ceLib = translate(strip(ceLib))
if ceLib = '' then return 12

if SYSDSN("'" || ceLib || "'") <> 'OK' then return 12

ceSpec = "'" || ceLib || "(ZDBATCH)'"
if SYSDSN(ceSpec) <> 'OK' then return 12

if strip(ceMember) <> '' then ceList = translate(strip(ceMember))
else do
  ceList = 'JOBDIAG JES2DIAG CPUDIAG LONGDIAG STORDIAG ENQDIAG'
  ceList = ceList' ASIDDIAG XCFDIAG ZFSDIAG LOGRDIAG'
end

do ceI = 1 to words(ceList)
  ceSpec = "'" || ceLib || "(" || word(ceList,ceI) || ")'"
  if SYSDSN(ceSpec) <> 'OK' then return 12
end
return 0


CheckPanelLib:
parse arg cpLib
cpLib = translate(strip(cpLib))
if cpLib = '' then return 12
if SYSDSN("'" || cpLib || "'") <> 'OK' then return 12

cpList = 'ZDIAGP ZDIAGSET ZDIAGH ZDIAGC'
do cpI = 1 to words(cpList)
  cpSpec = "'" || cpLib || "(" || word(cpList,cpI) || ")'"
  if SYSDSN(cpSpec) <> 'OK' then return 12
end
return 0


SubmitDiag:
sj. = ''
sj.0 = 0
sjTooLong = 0
ZSUBMSG = ''
ZJOBNM = 'UNKNOWN'

/* Preserve only the user-supplied nonblank JOB/JES records. */
do sjI = 1 to 4
  sjV = strip(value('ZDJC'sjI))

  if sjV <> '' then call AddJ sjV
end

sjCard = ''
do sjI = 1 to 4
  sjV = strip(value('ZDJC'sjI))
  if sjV <> '' then do
    sjCard = sjV
    leave
  end
end

if left(sjCard,2) = '//' then do
  sjRest = strip(substr(sjCard,3))
  ZJOBNM = translate(word(sjRest,1))
end

call AddJ '//ZDIAG   EXEC PGM=IKJEFT01,DYNAMNBR=50,REGION=0M'
call AddJ '//SYSEXEC  DD DISP=SHR,DSN='ZDEXEC
call AddJ '//ZREPORT  DD SYSOUT=*,DCB=(RECFM=FB,LRECL=133,BLKSIZE=0)'
call AddJ '//ZLOG     DD SYSOUT=*,DCB=(RECFM=FB,LRECL=133,BLKSIZE=0)'
call AddJ '//SYSTSPRT DD SYSOUT=*'
call AddJ '//SYSTSIN  DD *'

sjCmd = '%ZDBATCH 'ZUTIL
if strip(ZPARM) <> '' then sjCmd = sjCmd' 'ZPARM
call AddJ sjCmd
call AddJ '/*'

if sjTooLong then do
  ZSUBMSG = 'A generated JCL/SYSTSIN record exceeds 80 bytes.'
  return 12
end

sjTrap = outtrap('sjAlloc.',,'NOCONCAT')
sjCmd = 'ALLOC FI(ZDINTR) SYSOUT(A) WRITER(INTRDR)'
sjCmd = sjCmd' RECFM(F) LRECL(80) REUSE'
address TSO sjCmd
sjArc = rc
sjTrap = outtrap('OFF')

if sjArc <> 0 then do
  ZSUBMSG = 'JES internal-reader allocation failed.'
  return sjArc
end

sjTrap = outtrap('sjWrite.',,'NOCONCAT')
address TSO 'EXECIO 'sj.0' DISKW ZDINTR (STEM sj. FINIS)'
sjWrc = rc
sjTrap = outtrap('OFF')

sjTrap = outtrap('sjFree.',,'NOCONCAT')
address TSO 'FREE FI(ZDINTR)'
sjFrc = rc
sjTrap = outtrap('OFF')

if sjWrc <> 0 then do
  ZSUBMSG = 'Write to JES internal reader failed.'
  return sjWrc
end

if sjFrc <> 0 then
  ZSUBMSG = 'Submitted; INTRDR FREE returned RC='sjFrc'.'

return 0


AddJ:
parse arg aj
if length(aj) > 80 then do
  sjTooLong = 1
  return
end
sj.0 = sj.0 + 1
ajN = sj.0
sj.ajN = left(aj,80)
return


Resolve:
parse arg rr

select
  when rr = '1' | rr = 'JOB' | rr = 'JOBDIAG' then return 'JOBDIAG'
  when rr = '2' | rr = 'JES2' | rr = 'JES2DIAG' then return 'JES2DIAG'
  when rr = '3' | rr = 'CPU' | rr = 'CPUDIAG' then return 'CPUDIAG'
  when rr = '4' | rr = 'LONG' | rr = 'LONGDIAG' then return 'LONGDIAG'
  when rr = '5' | rr = 'STOR' | rr = 'STORDIAG' then return 'STORDIAG'
  when rr = '6' | rr = 'ENQ' | rr = 'ENQDIAG' then return 'ENQDIAG'
  when rr = '7' | rr = 'ASID' | rr = 'ASIDDIAG' then return 'ASIDDIAG'
  when rr = '8' | rr = 'XCF' | rr = 'XCFDIAG' then return 'XCFDIAG'
  when rr = '9' | rr = 'ZFS' | rr = 'ZFSDIAG' then return 'ZFSDIAG'
  when rr = '10' | rr = 'LOGR' | rr = 'LOGRDIAG' then
    return 'LOGRDIAG'
  otherwise return ''
end


Description:
parse arg dd

select
  when dd = 'JOBDIAG' then return 'JES2 resource / spool diagnostic'
  when dd = 'JES2DIAG' then return 'JES2 internal health diagnostic'
  when dd = 'CPUDIAG' then return 'CPU and workload diagnostic'
  when dd = 'LONGDIAG' then return 'Long-running job diagnostic'
  when dd = 'STORDIAG' then return 'Storage and paging diagnostic'
  when dd = 'ENQDIAG' then return 'ENQ / GRS dependency diagnostic'
  when dd = 'ASIDDIAG' then return 'ASID shortage diagnostic'
  when dd = 'XCFDIAG' then return 'XCF / sysplex diagnostic'
  when dd = 'ZFSDIAG' then return 'zFS space / allocation diagnostic'
  when dd = 'LOGRDIAG' then return 'System Logger diagnostic'
  otherwise return ''
end


ClearSelections:
do cs = 1 to 10
  zz = value('S'cs,'')
end
return


ShowHelp:
address ISPEXEC 'SELECT PGM(ISPTUTOR) PARM(ZDIAGH)'
return


Cleanup:
if zdLibdef then do
  address ISPEXEC 'LIBDEF ISPPLIB'
  zdLibdef = 0
end
return


Fatal:
say
say 'ZDIAG: REXX syntax/runtime error.'
say 'Condition:' condition('C')
say 'Description:' condition('D')
say 'Source line:' sigl
if datatype(sigl,'W') then say 'Statement:' sourceline(sigl)
call Cleanup
exit 20
