/* REXX */
/*                                       */
/* AUTHOR: CHARLES FENTON                */
/*                                       */
/*********************************************************************/
/* DISPLAY SYSTEM INFORMATION ON TERMINAL                            */
/*********************************************************************/
/*********************************************************************/
/* THIS SCRIPT OBTAINS RACF GROUP RESOURCE CLASSES                   */
/*********************************************************************/
/* CHANGE SUMMARY:                                                   */
/*   2009/02/28 - CLF, INITIAL CREATION OF SCRIPT OBTAIN RACF        */
/*                GROUP RESOURCE CLASSES.                            */
/*   2010/07/23 - CLF, chgd to add space to end of GROUP var.        */
/*   2013/05/30 - CLF, Added eval of CNSTFLG1 setting to check       */
/*                resource class for bit setting that SETR GENERIC   */
/*                is not allowed for class, STS-002636.              */
/*   2015/04/10 - CLF, Added eval of PASSWORD settings for RACF0462. */
/*                Evaluation includes ensuring RACF security exit    */
/*                (ICHPWX01) is available, RACF System REXX          */
/*                (IRRPWREX) is used, as well as settings for        */
/*                variables that are set in the RACF System REXX,    */
/*                STS-009990.                                        */
/*                                                                   */
/*                                                                   */
/*********************************************************************/
ADDRESS ISPEXEC 'VGET (CONSLIST COMLIST SYMLIST TERMPRO TERMMSGS TRACE)'
IF CONSLIST = ON | COMLIST = ON | SYMLIST = ON | TRACE = ON ,
  THEN TRACE R?
/*trace r?*/
PGMNAME = 'CARC1000 04/10/15'
arg option
NUMERIC DIGITS 20
if option = 'PASSWORD' then do
  say "Start of Data"
  table.0 = 0
  cvt = c2d(storage(10,4))
  rcvt = C2d(Storage(D2x(CVT + 992),4))
  pwx01hex = Storage(D2x(RCVT + 236),4)
  RCVTPWDX = C2d(BITAND(pwx01hex,'7FFFFFFF'x))
  If RCVTPWDX = 0 Then
    ich = 'NO'
  else
    ich = 'YES'
  X = OUTTRAP("line.")
  address ISPEXEC
  address ISPEXEC 'VGET (DISATXT)'
  test = cacc1010('F AXR,IRRPWREX LISTC')
  ind="NO"
  str="The following IRRPWREX configuration",
      "variables are defined:"
  tab = 0
  ft = 0
  disatext = DISATXT
  do until disatext = ""
    parse var disatext fld . . "#" disatext
    ft = ft + 1
    flds.ft = fld
    end
  do A = 1 to line.0
    line.A = strip(line.A)
    if index(line.A,str) = 1 then ,
      ind="YES"
    if index(line.A,"CACC") <> 1 & ,
      right(line.A,1) <> ":" & ,
      line.A <> "" then ,
      if index(line.A,":") = 0 then do
        say line.A
        end
      else do
        parse var line.A fld ":" vl .
        do y = 1 to ft
          if fld = flds.y then do
            flds.y = ""
            leave
            end
          end
        if index(DISATXT,fld) = 0 then ,
          iterate
        parse var DISATXT (fld) oper val "#" .
        val = strip(val,,"'")
        if val = "null" then val = ""
/*      say "Field:"fld "Operator:"oper "Value:"val*/
        if oper = "=" & vl = val then iterate
        if oper = ">" & vl > val then iterate
        if oper = ">=" & vl >= val then iterate
        if index(line.A,".") = 0 | ,
           index(line.A,"SPECIAL") = 1 then do
          tab = tab + 1
          table.tab = line.A
          end
        else if index(line.A,".0:") > 0 then do
          tab = tab + 1
          table.tab = line.A
          end
        end
    end
  say "ICHPWX01:"ich
  say "IRRPWREX:"ind
  do a = 1 to tab
    say table.a
    end
  do a = 1 to ft
    if flds.a <> "" then do
      if index(flds.a,".") = 0 then ,
        say flds.a "is not defined."
      else do
        parse var flds.a fld "." .
        say fld "variables are not defined."
        end
      end
    end
  say "End of Data"
  exit
  end
OFFSET  = 0                      /* USED AS OFFSET TO NEXT CNST ENTRY */
CVTP  = C2D(STORAGE('0010',4))      /* CVTP:       CVT ADDRESS        */
RCVT  = $ADDC(CVTP,'3E0')           /* X'3EO' = ADDRESS OF RCVT       */
RCVTFLG3 = STORAGE(D2X(RCVT + 633),1)  /*TEST IF DYNAMIC CDT ENABLED  */
CNT = 0
GROUP =
CNDT  = $ADDC(RCVT,'0BC')           /* X'3EO' = ADDRESS OF 1ST CNST   */
DO FOREVER
  CNST  = STORAGE(D2X(CNDT+OFFSET),28)
  CNSTLGT = C2D(STORAGE(D2X(CNDT+OFFSET),2))
  /*LENGTH OF THIS CNST ENTRY   */
  IF CNSTLGT = 0 THEN LEAVE         /*IF 0 THEN NO MORE CNST ENTRIES  */
  CNSTNAME =    SUBSTR(CNST,4,8)    /* CNSTNAME NAME OF RESOURCE CLASS*/
  CNSTMFLG =    SUBSTR(CNST,24,1)   /* CNSTMFLG NAME OF RESOURCE CLASS*/
  IF BITAND(CNSTMFLG,'80'X) = '80'X & ,
     WORDPOS(CNSTNAME,GROUP) = 0 THEN DO
    GROUP = GROUP CNSTNAME
    CNT = CNT + 1                     /* GET ONE 28 BYTE CNST ENTRY     */
    END
  CNDTCNSX  = $ADDC(CNDT+OFFSET,'018')    /* X'018' = ADDRESS OF CNSX */
/*CNSTCNSX = C2D(STORAGE(D2X(CNDT+OFFSET+24),4))*/
  CNSX  = STORAGE(D2X(CNDTCNSX),152)
  CNSTFLG1 =    SUBSTR(CNSX,141,1)
  IF BITAND(CNSTFLG1,'10'X) = '10'X & , /* chk for SETR GENERIC not allowed */
     WORDPOS(CNSTNAME,GROUP) = 0 THEN DO
    GROUP = GROUP CNSTNAME
    CNT = CNT + 1                     /* GET ONE 28 BYTE CNST ENTRY     */
    END
  OFFSET = OFFSET + 28              /* POINT TO NEXT CNST ENTRY       */
END                                        /* END OF "DO FOREVER LOOP */
 
/*                TEST TO SEE IF DYNAMIC CDT ENABLED                  */
IF BITAND(RCVTFLG3,'80'X) = '80'X THEN DO
  X = OUTTRAP("LINE.")
  "RL CDT * NOR CDTINFO"
  DO A = 1 TO LINE.0
    LINE.A = LINE.A
    IF POS("CDT     ",LINE.A) <> 0 THEN,
      CNSTNAME = WORD(LINE.A,2)
    PARSE VAR LINE.A "MEMBER = " TEXT
    TEXTA = C2X(SUBSTR(TEXT,1,8,'00'X))
    IF X2C(TEXTA) > '00'X & X2C(TEXTA) <> '40'X THEN DO
      GROUP = GROUP LEFT(CNSTNAME,8)
      CNT = CNT + 1
      END
    END
  END
GROUP = GROUP" "
ADDRESS ISPEXEC "VPUT (GROUP) ASIS"
IF TERMMSGS = ON THEN,
  SAY PGMNAME 'Process collected' CNT 'group resource classes.'
EXIT
/**********************************************************************/
$ADDC:ARG AD1,AD2
RETURN C2D(STORAGE(D2X(AD1+X2D(AD2)),4))
/**********************************************************************/