//CACPGRS0 JOB (ACCOUNT),'FSO / SRR MVS AUDIT',
//         CLASS=A,MSGCLASS=X ,USER=SRRAUDT
//*
//SYSOUT OUTPUT DEFAULT=YES,CLASS=*,OUTDISP=(HOLD,HOLD),JESDS=ALL
//*
//*       ASSEMBLE BATCH PROGRAMS
//*
//* PROCLIB JCLLIB ORDER=
//*
// SET     SYSLMOD=SYS4.SRRAUDIT.TEST.LOADLIB
// SET     PGMNAME=CACPGRS0
//*
//* JSTEP010 EXEC ASMHCLG
//JSTEP010 EXEC ASMACL
//C.SYSLIB DD
//         DD DISP=SHR,DSN=SYS1.MODGEN
//*        ASMPARM='XREF(SHORT),NORENT',
//*        LNKPARM='MAP,NORENT,NOREUS,RMODE=24',
//*        SRCLIB2=CICS.V410.PROGRAMS.SRCLIB,
//*        SYSLMOD=SYS1.ESYSLINK,
//SYSIN   DD *
         PRINT ON,NOGEN
         TITLE  'CACPGRS0-Program to list all allocated datasets'
CACPGRS0 CSECT
CACPGRS0 AMODE  31
CACPGRS0 RMODE  24
*
* copied from SYS1.SAMPLIB(ISGECMON)                     jln 09/10/2004
*             OS/390 02.10.00 HBB7703                    jln 09/10/2004
*
*/* START OF SPECIFICATIONS *******************************************
*
*
*01* MODULE-NAME = CACPGRS0
*
*02*   DESCRIPTIVE-NAME = Program to list all datasets allocated
*                         on this system for security auditing
*
***********************************************************************
*
*02*   RECOVERY-OPERATION = This program functions without recovery.
*
***********************************************************************
*
*01* NOTES =
*
*      (3) Sample install JCL:
*
*           //LINK      EXEC PGM=IEWL,
*           //    PARM='RENT,REFR,XREF,LET,LIST,NCAL,SIZE=(750K,200K)'
*           //SYSUT1   DD UNIT=SYSDA,SPACE=(1024,(200,20))
*           //OBJLIB   DD DSN=USERID.MY.OBJ,DISP=SHR
*           //SYSLMOD  DD DSN=LNKLST.LIB,DISP=OLD
*           //SYSPRINT DD SYSOUT=*
*           //SYSLIN DD *
*               INCLUDE OBJLIB(ISGECMON)
*               ENTRY ISGECMON
*               NAME ISGECMON(R)
*
*02*   DEPENDENCIES = None
*
*02*   RESTRICTIONS = None
*
*02*   REGISTER-CONVENTIONS =
*
*03*     REGISTER-USAGE = See register declarations in code
*
*02*   PATCH-LABEL = None
*
*01* MODULE-TYPE = CSECT
*
*02*   PROCESSOR = Assembler-H
*
*02*   MODULE-SIZE = See assembler External Symbol Dictionary
*
*02*   ATTRIBUTES =
*
*03*     LOCATION = User private
*
*03*     RMODE =    24 - DCB dataset
*
*03*     TYPE  =    Reentrant
*
**********************************************************************
*
*01* ENTRY-POINT =  ISGECMON
*
*02*   PURPOSE =  See FUNCTION section for this module.
*
*03*     OPERATION =  See OPERATION section for this module.
*
*02*   LINKAGE = BALR
*
*03*     CALLERS = Any
*
*02*   ATTRIBUTES =
*
*03*     ENTRY
*
*04*       ENABLED
*04*       STATE = Problem program
*04*       KEY = User key
*04*       AMODE = 31
*04*       LOCKS HELD = None
*04*       ASC MODE = Primary
*04*       MEMORY MODE = Primary equal to Secondary equal to Home
*04*       DISPATCH MODE = Task
*
*03*     EXECUTION
*
*04*       ENABLED
*04*       STATE = Problem program
*04*       KEY = User key
*04*       AMODE = 31
*04*       LOCKS OBTAINED = None
*04*       ASC MODE = Primary
*04*       MEMORY MODE = Primary equal to Secondary equal to Home
*02*   SERIALIZATION = None
*
*02*   INPUT = None
*
*03*     ENTRY-REGISTERS =
*
*           R0       = Irrelevant
*           R1       = Points to the address of a parameter list
*           R2 - R12 = Irrelevant
*           R13      = Address of a standard save area
*           R14      = Return address
*           R15      = Entry point address
*
*03*     PARAMETER-LIST =  Halfword value followed by a byte string
*                          whose length is in the halfword value.
*
*
*02*   OUTPUT = None
*
*02*   EXIT-NORMAL = None, task runs until cancelled.
*
*03*     CONDITIONS = N/A
*
*03*     EXIT-REGISTERS = N/A
*
*03*     RETURN-CODES =  N/A
*
*02*   EXIT-ERROR =  Program ends at end of GRS list.
*                    All the resources that it uses (such as
*                    virtual storage) are task-related, and
*                    will be cleaned up by task-termination.
*
***********************************************************************
*
*01* EXTERNAL-REFERENCES  =
*
*
*02*   ROUTINES = None
*
*02*   DATA-AREAS = None
*
*02*   CONTROL-BLOCKS =
*
*   Common  Mapping
*    Name    Macro        Usage               Full Name
*   ------  --------  -------------  ----------------------------------
*    ASCB   IHAASCB   Read           Address Space Control Block
*    CVT    CVT       Read           Communication Vector Table
*    OUCB   IRAOUCB   Read           SRM User Control Block
*    RIB    ISGRIB    Read           Resource Information Block
*
*
*01* TABLES =
*
*01* MACROS-EXECUTABLE =
*                        FREEMAIN
*                        GETMAIN
*                        GQSCAN
*                        LOCASCB
*                        MODID
*
*01* SERIALIZATION = None.
*
*01* MESSAGES =
*
*01* ABEND-CODES =  None
*
*01* WAIT-STATE-CODES = None
*
*01* CHANGE-ACTIVITY =
*       $L0=ENQCM   ,HBB4430,920709,PDDX:Sample program to monitor
*                                        dataset contention.
*
**** END OF SPECIFICATIONS *******************************************/
         SPACE 2
***********************************************************************
*                                                                     *
*                  Outline of mainline logic                          *
*                                                                     *
***********************************************************************
*++Obtain dynamic storage                                             *
*++Do Forever                                                         *
*++ If GQSCAN was successful (RC=0|4|8)                               *
*++   Do for each RIB returned (possibly none)                        *
*++    If dataset is not a system temporary then                      *
*++      Add DSName and JOBname to output list                        *
*++    EndIf                                                          *
*++   EndDo                                                           *
*++ Else GQSCAN was not successful (RC>8)                             *
*++   Exit program                                                    *
*++ EndIf                                                             *
*++EndDo                                                              *
***********************************************************************
         SPACE 2
***********************************************************************
*                                                                     *
*   Constants for installation tweaking                               *
*                                                                     *
***********************************************************************
AREASIZE EQU    10000                  Size of area for RIBs and RIBEs
*                                      returned by GQSCAN
         EJECT
***********************************************************************
*                                                                     *
*   Standard entry linkage                                            *
*                                                                     *
***********************************************************************
         STM    R14,R12,12(R13)
         BALR   BASEPTR,0
         USING  *,BASEPTR
         B     START
*        MODID  BR=NO
ASMPGM   DC    C' CACPGRS0'            CSECT NAME &SYSECT ??
         LCLC  &MM,&DD,&YYYY
&MM      SETC  '&SYSDATC'(5,2)
&DD      SETC  '&SYSDATC'(7,2)
&YYYY    SETC  '&SYSDATC'(1,4)
ASMDATE  DC    C' &MM./&DD./&YYYY'
ASMTIME  DC    C' &SYSTIME'
         DC    C' LAST CHANGED'
         DC    C' 09/15/2004'  changed to list all datasets
START    DS    0H
         LR     R2,R1                  Save input parameter
         LR     R3,R13                 Save callers savearea address
         L      R0,DYNASIZE            Get amount of storage needed
         GETMAIN RU,LV=(R0),LOC=(BELOW,ANY) Obtain dynamic storage
         LR     DATAPTR,R1
         LA     DATAPTR2,4095(,R1)
         USING  DYNA,DATAPTR
         USING  DYNA+4095,DATAPTR2
         ST     R3,SAVEAREA+4          Save @ of callers savearea
         ST     R1,8(,R3)              Chain our savearea to callers
*
*        LTR    R2,R2                  Test for parameters
*        BE     DEFAULT                None, take the default
*        L      R1,0(,R2)              Address parameter area
*        USING  PARMAREA,R1
*        LH     R3,PARMLEN             Get length of parameters
*        LTR    R3,R3                  Test for parameters
*        BNE    GETPARM
* DEFAULT  MVC    INTERVAL,=F'6000'      No parameter was specified,
*                                      default to 60 seconds.
*        B      INIT
***********************************************************************
*                                                                     *
*   Convert input parameter into .01 second units for STIMER          *
*                                                                     *
***********************************************************************
* GETPARM  EQU    *                      Parameter was specified
*        MVC    PARMBUF,=C'0000'
*        LA     R2,L'PARMBUF
*        SLR    R2,R3
*        LA     R2,PARMBUF(R2)
*        EX     R3,COPYPARM            Right justify parameter
*        PACK   PACKAREA,PARMBUF       EBCDIC -> Decimal
*        CVB    R4,PACKAREA            Decimal -> Binary
*        MH     R4,=H'100'             Convert to .01 second units
*        ST     R4,INTERVAL            Save for STIMER
*        DROP   R1
***********************************************************************
*                                                                     *
*   Initialize the Current list to empty                              *
*                                                                     *
***********************************************************************
INIT     EQU    *
         OPEN  (GRSLIST,(OUTPUT))   OPEN OUTPUT report FILE
         LA    R1,GRSLIST           AFTER OPEN ATTEMPT,
         USING IHADCB,R1            GET ADDRESSABLE TO DCB.
         TM    DCBOFLGS,X'10'
         BO    OPENOK
         DROP  R1
         L     R15,=F'16'           RC=16 NO SYSPRINT DD
         B     ERROR                ABEND IF OPEN FAILS
OPENOK   DS    0H
*        MVC   ERRPGM,ASMPGM
*        MVC   ERRMSGD(L'MSG00),MSG00
*        MVC   MSG00_DATE,ASMDATE
*        MVC   MSG00_TIME,ASMTIME
*        PUT   GRSLIST,ERRMSG
         SR     R1,R1
         ST     R1,TOKENF        Token starts empty
         EJECT
NEXTSCAN EQU    *
***********************************************************************
*                                                                     *
*   Check for dataset contention via GQSCAN                           *
*   Limit scan to                                                     *
*         RESNAME=SYSDSN      to get only dataset ENQs.               *
*         WAITCNT=1           to get only resources with contention.  *
*         REQLIM=2            to get information on only the first    *
*                               two requestors for a dataset, since   *
*                               this program does not worry about     *
*                               other waiting jobs.                   *
*                                                                     *
*   When GQSCAN returns:                                              *
*         R0 contains size values for the RIB and RIBE                *
*         R1 contains the number of RIBs returned in SCANAREA         *
*         R15 contains a return code.                                 *
*                                                                     *
***********************************************************************
*       GQSCAN AREA=(SCANAREA,AREASIZE),SCOPE=ALL,RESNAME=QNAME,      X
*              WAITCNT=1,REQLIM=2,MF=(E,SCANLIST)
         GQSCAN AREA=(SCANAREA,AREASIZE),SCOPE=ALL,RESNAME=QNAME,      X
               OWNERCT=1,REQLIM=99,TOKEN=TOKENF,MF=(E,SCANLIST)
         ST     R15,GQSCANRC           Save return code
         C      R15,=F'8'              Good return code (<=8)
         BH     ERROR                  No, some unexpected error, do
*                                      not process any data.
         C      R15,=F'4'              No matches found, RIB empty
         BE     COMPLETE               nothing to process
***********************************************************************
*                                                                     *
*   Scan through the RIBs (possibly none) that were returned.         *
*                                                                     *
***********************************************************************
         LTR    R1,R1                  Test number of RIBs returned
*                                      by GQSCAN
         BZ     COMPLETE               If none were returned, then done
         ST     R0,SIZES               Save size of RIB and RIBEs
         LA     RIBPTR,SCANAREA        Get address of first RIB
         USING  RIB,RIBPTR
***********************************************************************
*                                                                     *
*   Check RIB to see if it matches the search criteria.               *
*                                                                     *
***********************************************************************
CHECKRIB EQU    *
         ST     R1,RIBSLEFT            Save remaining number of RIBs
         LR     RIBVPTR,RIBPTR
         AH     RIBVPTR,LENRIB         Compute address of RIBVAR
         USING  RIBVAR,RIBVPTR
         LR     RIBEPTR,RIBVPTR
         AH     RIBEPTR,RIBVLEN        Get address of first RIBE
         USING  RIBE,RIBEPTR
*
*        LR     R2,RIBEPTR             Get address of first RIBE
**       AH     R2,LENRIBE             Compute address of second RIBE
**       TM     RIBESFLG-RIBE(R2),RIBESTAT  Is the second requestor
*                                      waiting for the dataset?
**       BNZ    NEXTRIB                No, there are multiple owners
*                                      sharing the dataset, skip this
*                                      RIB
*        L      R2,CVTPTR              Find the CVT
*        CLC    CVTSNAME-CVTMAP(L'RIBESYSN,R2),RIBESYSN Is the dataset
*                                      owner from this system ?
*        BNE    NEXTRIB                No, unable to notify users
*                                      on other systems, skip this RIB
         SPACE 2
***********************************************************************
*                                                                     *
*   Resource & job were found that match the criteria. Add to the     *
*   Current list.                                                     *
*                                                                     *
***********************************************************************
*        XC     DSNAME,DSNAME          Sets to low values
         MVI    DSNAME,C' '            Set to blanks
         MVC    DSNAME+1(L'DSNAME-1),DSNAME
         MVC    JOBNAME,RIBQNAME
         SR     R4,R4
         IC     R4,RIBRNMLN            Get length of dataset name
         LA     R0,L'DSNAME            Get maximum length in output
         CR     R4,R0                  Name exceeds output length?
         BL     NOTRIM
         LR     R4,R0                  Yes, trim length for output
NOTRIM   STH    R4,LENDSN              Save length of dataset name
         BCTR   R4,0                   Adjust length -1 for MVC
         EX     R4,MOVEDSN             Store datset name
         CLC    =C'SYS0',DSNAME        Is this a temporary dataset?
         BNE    GET_JOB
         CLC    =C'.T',DSNAME+8        SYSyyjjj.Thhmmss.
         BE     TEMP_DSN
GET_JOB  EQU    *
         LR     R2,RIBEPTR             Get address of first RIBE
         L      R3,RIBNRIBE            Get number of RIBEs
         LTR    R3,R3
         BZ     NORIBE                 None returned
NEXTRIBE EQU    *
         MVC    JOBNAME,RIBEJBNM-RIBE(R2)   Store name of dataset owner
         MVC    JOBASID,RIBEASID-RIBE(R2)   Store ASID of dataset owner
NORIBE   EQU    *
         MVC    ERRMSGD(L'MSG01),MSG01
         MVC    MSG01_JOBN,JOBNAME
         MVC    MSG01_DSN,DSNAME
         PUT    GRSLIST,ERRMSG
         AH     R2,LENRIBE             Compute address of next RIBE
         BCT    R3,NEXTRIBE
TEMP_DSN EQU    *
         SPACE 2
***********************************************************************
*                                                                     *
*   Finished processing this RIB, go on to the next one.              *
*                                                                     *
***********************************************************************
NEXTRIB  EQU    *
         L      R2,RIBNRIBE            Get number of RIBEs for this RIB
         MH     R2,LENRIBE             Compute total size of the RIBEs
         ALR    RIBEPTR,R2             Compute address of next RIB
         LR     RIBPTR,RIBEPTR         Save address of next RIB
         L      R1,RIBSLEFT            Get number of RIBs left
         BCT    R1,CHECKRIB            Process next RIB, if any
         EJECT
***********************************************************************
*                                                                     *
*   Finished processing all RIBS returned by GQSCAN.                  *
*                                                                     *
***********************************************************************
         CLC    =F'8',GQSCANRC         Check return code
         BE     NEXTSCAN               Last request filled working stg.
*        SR     R15,R15                Set completion code to zero
         L      R15,GQSCANRC           Display return code
         B      COMPLETE
***********************************************************************
*                                                                     *
*   Error, GQSCAN was unsuccessful.                                   *
*                                                                     *
***********************************************************************
ERROR    EQU    *
***********************************************************************
*                                                                     *
*   Return to the caller with return code set R15                     *
*                                                                     *
***********************************************************************
COMPLETE EQU    *
         CLOSE  GRSLIST
         LR     R2,R13
         L      R13,SAVEAREA+4
         L      R0,DYNASIZE
         FREEMAIN RU,A=(R2),LV=(R0)
*        LM     R14,R12,12(R13)
*        SR     R15,R15
*        BR     R14
         RETURN (14,12),RC=(15)
         EJECT
***********************************************************************
*                                                                     *
*   Targets of EX instructions                                        *
*                                                                     *
***********************************************************************
         USING  PARMAREA,R1
COPYPARM MVC    0(0,R2),PARM           Used for right-justifying input
         DROP   R1
         SPACE
MOVEDSN  MVC    DSNAME(0),RIBRNAME     Used to copy dataset name into
*                                      entry in Current list
         SPACE
***********************************************************************
*                                                                     *
*   Register declares                                                 *
*                                                                     *
***********************************************************************
R0       EQU    0
R1       EQU    1
R2       EQU    2
R3       EQU    3
R4       EQU    4
R5       EQU    5
RIBVPTR  EQU    5                      Address of RIBVAR section
RIBPTR   EQU    6                      Address of RIB
RIBEPTR  EQU    7                      Address of RIBE
R8       EQU    8
R9       EQU    9
R10      EQU    10                     Reserved for future expansion
*                                      of the code or the dynamic area
DATAPTR2 EQU    11                     Second data register
BASEPTR  EQU    12                     Code register
R12      EQU    12
DATAPTR  EQU    13                     First data register
R13      EQU    13
R14      EQU    14
R15      EQU    15
***********************************************************************
*                                                                     *
*   Static data                                                       *
*                                                                     *
***********************************************************************
         DS     0F
DYNASIZE DC     AL4(LENDYNA)           Amount of dynamic storage needed
QNAME    DC     CL8'SYSDSN  '          Major name for dataset ENQs
*
ERRMSG   DS    0CL133
ERRMSGD  DC    CL80' '
         ORG   ERRMSG+L'ERRMSG
MSG00    DC    C'ASSEMBLED ON MM/DD/YYYY AT HH.MM                     '
MSG00_DATE EQU   ERRMSGD+12,11
MSG00_TIME EQU   ERRMSGD+26,6
MSG01    DC    C'Jobname ........  DSName .........                   '
MSG01_JOBN EQU   ERRMSGD+8,8
MSG01_DSN  EQU   ERRMSGD+25,44
*
GRSLIST  DCB   DDNAME=SYSPRINT,DSORG=PS,MACRF=(PM),                    X
               BLKSIZE=27920,LRECL=80
         EJECT
***********************************************************************
*                                                                     *
*   Dynamic data                                                      *
*                                                                     *
***********************************************************************
DYNA     DSECT
SAVEAREA DS     18F                    Standard savearea
SAVE1    DS     15F                    First level subroutine savearea
SAVE2    DS     15F                    Second level subroutine savearea
INTERVAL DS     F                      Time to pause between scans
TOKENF   DS     F                      Token for multiple scans
GQSCANRC DS     F                      Return code from scan
PACKAREA DS     D                      Interval in packed decimal form
PARMBUF  DS     CL4                    Right-justified parameter
SIZES    DS     F
         ORG    SIZES
LENRIB   DS     H                      Returned size of RIB
LENRIBE  DS     H                      Returned size of RIBE
RIBSLEFT DS     F                      Number of RIBs left to process
MSGBUF   DS     CL120                  Buffer to build message in
JOBNAME  DS     CL8                    User owning dataset resource
JOBASID  DS     H                      Address space of user
LENDSN   DS     H                      True length of dataset name
DSNAME   DS     CL44                   Buffer for dataset name
SCANLIST GQSCAN MF=L
*
*
*  Area for resource data returned by GQSCAN.
*
SCANAREA DS     0F                     Area for GQSCAN data
         ORG    SCANAREA+AREASIZE
SCANEND  DS     0F                     End of GQSCAN data
LENDYNA  EQU    *-DYNA                 Total size of dynamic storage
         EJECT
***********************************************************************
*                                                                     *
*   Input parameter mapping                                           *
*                                                                     *
***********************************************************************
PARMAREA DSECT
PARMLEN  DS     H
PARM     DS     CL3                    Interval in seconds
         EJECT
***********************************************************************
*                                                                     *
*   Mapping macros                                                    *
*                                                                     *
***********************************************************************
         PRINT NOGEN
         DCBD  DSORG=BS,DEVD=DA                            JLN 09/13/04
         IHAASCB
         CVT    DSECT=YES
         IRAOUCB
         ISGRIB
         END   CACPGRS0
//*
//L.SYSLMOD DD DISP=OLD,DSN=&SYSLMOD(&PGMNAME)
//*
//  IF (RC=0) THEN
//GO     EXEC PGM=&PGMNAME  ,PARM='00,TCPIP   '
//STEPLIB  DD DISP=SHR,DSN=&SYSLMOD
//SYSPRINT DD SYSOUT=*
//SYSABEND DD SYSOUT=*
//  ENDIF
//
