/* REXX */
/* CLS2REXXed by FSOX001 on 28 Aug 2018 at 14:51:34  */
Signal On NoValue
Call On Error
Signal On Failure
Signal On Syntax
Parse source opsys . exec_name .
 
/*********************************************************************/
/* 11/02/2005 JL.NELSON Created front end from SY$ACTON.             */
/* 10/12/2005 JL.NELSON Pick up DATASET NAMES from JCL               */
/* 10/17/2005 JL.NELSON Fixed ACF2 ALLOC/OPEN ERROR with no member.  */
/* 11/02/2005 JL.NELSON Split out RACF and Top Secret.               */
/* 11/02/2005 JL.NELSON Moved ACF2 code from dialog to batch.        */
/* 11/04/2005 JL.NELSON Test for End-Of-File condition code.         */
/* 11/18/2005 JL.NELSON Added tests for File condition codes.        */
/* 12/16/2005 JL.NELSON Modified to allow variable ACP commands.     */
/* 01/26/2006 JL.NELSON Removed ALLOC, use JCL DDname.               */
/* 01/26/2006 JL.NELSON Changed from TSO to ISPF commands.           */
/* 01/26/2006 JL.NELSON Made intermediate file a seq. was PDS.       */
/* 07/13/2006 JL.NELSON Set RC > 16 for errors in JCL.               */
/* 08/28/2018 CL.FENTON Converted script from CLIST to REXX.         */
/*                                                                   */
/*                                                                   */
/*                                                                   */
/*********************************************************************/
conslist = "OFF"               /* DEFAULT IS OFF                     */
comlist  = "OFF"               /* DEFAULT IS OFF                     */
symlist  = "OFF"               /* DEFAULT IS OFF                     */
termmsgs = "ON"                /* DEFAULT IS ON                      */
cacc1000 = "CACC1000"          /* Security check program             */
caac0501 = "CAAC0501"          /* ACF2 list format program           */
carc0501 = "CARC0501"          /* RACF list format program           */
catc0501 = "CATC0501"          /* Top Secret list format program     */
listcddn = "LISTCMDS"          /* ACP list output file DDname        */
listuddn = "LISTUSER"          /* CLIST output file without & DDname */
dataddn  = "DATA"              /* Authorized user list DATA DDname   */
listfmsg = "LISTUSER START OF DATA" /* Default message               */
trace    = "OFF"               /* TRACE ACTIONS AND ERRORS           */
pgmname = "CACC0501 08/28/18"
 
sysprompt = "OFF"                 /* CONTROL NOPROMPT                */
sysflush = "OFF"                  /* CONTROL NOFLUSH                 */
sysasis = "ON"                    /* CONTROL ASIS - caps off         */
Numeric digits 10                 /* default of 9 not enough         */
maxcc = 0
listc   = ""
 
Arg OPTION
if OPTION <> "" then,
  do until OPTION = ""
    parse var OPTION key"("val")" OPTION
    val = strip(val,"b","'")
    val = strip(val,"b",'"')
    optcmd = key '= "'val'"'
    interpret optcmd
    end
 
return_code = 0
If trace = "ON" then do            /* TURN messages on          */
  termmsgs = "ON"                  /* CONTROL MSG               */
  comlist = "ON"                   /* CONTROL LIST              */
  conslist = "ON"                  /* CONTROL CONLIST           */
  symlist = "ON"                   /* CONTROL SYMLIST           */
  end
 
If CONSLIST = "ON" | COMLIST = "ON" | SYMLIST = "ON" | TRACE = "ON",
  then Trace ?r
 
syssymlist = symlist          /* CONTROL SYMLIST/NOSYMLIST */
sysconlist = conslist         /* CONTROL CONLIST/NOCONLIST */
syslist = comlist             /* CONTROL LIST/NOLIST       */
sysmsg = termmsgs             /* CONTROL MSG/NOMSG         */
Address ISPEXEC
"CONTROL NONDISPL ENTER"
"CONTROL ERRORS RETURN"
zispfrc = 0
"VPUT (ZISPFRC) SHARED"
return_code = 0
"VPUT (CONSLIST COMLIST SYMLIST TERMMSGS) ASIS"
If return_code > 4 then do
  Say pgmname "VPUT RC =" return_code zerrsm
  return_code = return_code + 16
  SIGNAL ERR_EXIT
  end
 
/* Determine which security system is running */
"SELECT CMD("cacc1000 "ACP)"
return_code = 0
"VGET (ACPNAME ACPVERS) ASIS"
If return_code > 4 then do
  Say pgmname "VGET RC =" return_code zerrsm
  Say pgmname "Unable to determine security system."
  return_code = return_code + 16
  SIGNAL ERR_EXIT
  end
return_code = listdsi(listcddn "FILE")
listdsi_cmds_rcode = return_code
listdsi_cmds_reason = sysreason
If return_code = 0 then do
  listcdsn = sysdsname
  listdsi_cmds_msglvl2 = sysmsglvl2
  end
Else do
  Say pgmname "UNABLE TO DETERMINE" listcddn "DSNAME SYSREASON",
    sysreason
  Say pgmname sysmsglvl1
  Say pgmname sysmsglvl2
  return_code = 18
  SIGNAL ERR_EXIT
  end
Say pgmname "Input  DDname" left(listcddn,8) "DSName" listcdsn
 
return_code = listdsi(listuddn "FILE")
listdsi_user_rcode = return_code
listdsi_user_reason = sysreason
If return_code = 0 then do
  listudsn = sysdsname
  listdsi_user_msglvl2 = sysmsglvl2
  end
Else do
  Say pgmname "UNABLE TO DETERMINE" listuddn "DSNAME SYSREASON",
    sysreason
  Say pgmname sysmsglvl1
  Say pgmname sysmsglvl2
  return_code = 18
  SIGNAL ERR_EXIT
  end
Say pgmname "Interm DDname" left(listuddn,8) "DSName" listudsn
 
return_code = listdsi(dataddn "FILE")
listdsi_data_rcode = return_code
listdsi_data_reason = sysreason
If return_code = 0 then do
  datadsn = sysdsname
  listdsi_data_msglvl2 = sysmsglvl2
  end
Else do
  Say pgmname "UNABLE TO DETERMINE" listuddn "DSNAME SYSREASON",
    sysreason
  Say pgmname sysmsglvl1
  Say pgmname sysmsglvl2
  return_code = 18
  SIGNAL ERR_EXIT
  end
Say pgmname "Output DDname" left(dataddn,8) "DSName" datadsn
 
return_code = 0
"LMINIT DATAID(LISTCID) DDNAME("listcddn")"
If return_code <> 0 then do
  Say pgmname "LMINIT_LISTCID_RC =" return_code zerrsm
  return_code = return_code + 16
  SIGNAL ERR_EXIT
  end
 
"LMOPEN DATAID("listcid") OPTION(INPUT)"
If return_code <> 0 then do
  Say pgmname "LMOPEN_LISTCID_RC =" return_code zerrsm
  return_code = return_code + 16
  SIGNAL ERR_EXIT
  end
 
/* READ LISTCMDS FILE TO BYPASS STARTING INFORMATION. */
Do until listc = listfmsg
  return_code = 0
  "LMGET DATAID("listcid") MODE(INVAR) DATALOC(LISTC)",
    "DATALEN(LRECL) MAXLEN(255)"
  If return_code <> 0 then do
    Say pgmname "LMGET_LISTCID_RC =" return_code zerrsm
    return_code = return_code + 16
    SIGNAL ERR_EXIT
    end
  end
 
/* READ FIRST VALID RECORD */
return_code = 0
"LMGET DATAID("listcid") MODE(INVAR) DATALOC(LISTC) DATALEN(LRECL)",
  "MAXLEN(255)"
If return_code <> 0 then do
  Say pgmname "LMGET_LISTCID_RC =" return_code zerrsm
  return_code = return_code + 16
  SIGNAL ERR_EXIT
  end
 
return_code = 0
"LMINIT DATAID(LISTUID) DDNAME("listuddn")"
If return_code <> 0 then do
  Say pgmname "LMINIT_LISTUID_RC =" return_code zerrsm
  return_code = return_code + 16
  SIGNAL ERR_EXIT
  end
 
"LMOPEN DATAID("listuid") OPTION(OUTPUT)"
If return_code <> 0 then do
  Say pgmname "LMOPEN_LISTUID_RC =" return_code zerrsm
  return_code = return_code + 16
  SIGNAL ERR_EXIT
  end
 
return_code = 0
cnt = 0
Do until listc = "END"
  do until pos("&",listc) = 0
    parse var listc strt "&" lst
    listc = strt""lst
    end
 
/*If pos("&",listc) > 0 then do
NEXT_AMPERSAND:
    xa = pos("&",listc)
    If xa > 0 then do
      nl = length(listc)
      If xa = 1 then do
        listc = substrc(2,nl,listc)
        SIGNAL  NEXT_AMPERSAND
        End
      If xa = nl then do
        listc = substrc(1,nl-1,listc)
        SIGNAL  NEXT_AMPERSAND
        End
      listc = substrc(1,xa-1,listc)substrc(xa+1,nl,listc)
      SIGNAL  NEXT_AMPERSAND
      End
    End*/
 
  return_code = 0
  "LMPUT DATAID("listuid") MODE(INVAR) DATALOC(LISTC)",
    "DATALEN("lrecl")"
  If return_code <> 0 then do
    Say pgmname "LMPUT_LISTUID_RC =" return_code zerrsm
    return_code = return_code + 16
    SIGNAL ERR_EXIT
    end
  cnt = cnt +1
  "LMGET DATAID("listcid") MODE(INVAR) DATALOC(LISTC)",
    "DATALEN(LRECL) MAXLEN(255)"
  If return_code = 8 then leave
  If return_code <> 0 then do
    Say pgmname "LMGET_LISTCID_RC =" return_code zerrsm
    return_code = return_code + 16
    SIGNAL ERR_EXIT
    end
  end
 
return_code = 0
Say pgmname "Output record count =" cnt
"LMCLOSE DATAID("listcid")"
lmclose_listcid_rc = return_code
return_code = 0
"LMFREE DATAID("listcid")"
lmfree_listcid_rc = return_code
"LMCLOSE DATAID("listuid")"
lmclose_listuid_rc = return_code
return_code = 0
"LMFREE DATAID("listuid")"
lmfree_listuid_rc = return_code
 
If acpname = "RACF" then,
  "SELECT CMD("carc0501 "LISTUDDN("listuddn") DATADDN("dataddn"))"
 
If left(acpname,3) = "TSS" then,
  "SELECT CMD("catc0501 "LISTUDDN("listuddn") DATADDN("dataddn"))"
 
If acpname = "ACF2" then,
  "SELECT CMD("caac0501 "LISTUDDN("listuddn") DATADDN("dataddn"))"
 
Say pgmname "Processing completed for" acpname
 
 
END_EXIT:
return_code = 0
/*******************************************/
/* ERROR EXIT                              */
/*******************************************/
 
 
ERR_EXIT:
If maxcc >= 16 | return_code > 0 then do
  "VGET (ZISPFRC) SHARED"
  If maxcc > zispfrc then,
    zispfrc = maxcc
  Else,
    zispfrc = return_code
  "VPUT (ZISPFRC) SHARED"
  Say pgmname "ZISPFRC =" zispfrc
  end
Exit
 
 
NoValue:
Failure:
Syntax:
say pgmname 'REXX error' rc 'in line' sigl':' strip(ERRORTEXT(rc))
say SOURCELINE(sigl)
SIGNAL ERR_EXIT
 
 
Error:
return_code = RC
if RC > 4 & RC <> 8 then do
  say pgmname "LASTCC =" RC strip(zerrlm)
  say pgmname 'REXX error' rc 'in line' sigl':' ERRORTEXT(rc)
  say SOURCELINE(sigl)
  end
if return_code > maxcc then
  maxcc = return_code
return
 
 
substrc: Procedure
If arg(3) = '' then do
  s = Arg(1)
  l = 1
  v = arg(2)
  end
Else do
  s = arg(1)
  l = arg(2)-arg(1)+1
  v = arg(3)
  end
Return substr(v,s,l)