//CACPSTC0 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     SYSLMOD=SYS2.SRRAUDIT.V521.LOADLIB
// SET     PGMNAME=CACPSTC0
//*
//* 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 *
         TITLE 'BATCH PROGRAM TO list stc/jobs on system ' JLN 09/15/04
**********************************************************************
*   copied from X6H0003.ESYS98.CICS.V410.PROGESYS.SRCLIB   jln 03/16/04
*                                                                    *
* CACPSTC0 - This program lists all started tasks and jobs running   *
*             on this system for security auditing                   *
*                                                                    *
*   Author ......... Jim L. Nelson                                   *
*   Date ........... 09/08/2004                                      *
*   Program ........ CACPSTC0                                        *
*   Input .......... None                                            *
*   Output ......... RC=0 - JOB/STC list successful                  *
*                    RC=8 - no PARM supplied.                        *
*                    RC=16  - NO SYSPRINT DD SUPPLIED.               *
*                                                                    *
* Found some blank jobnames for started tasks - match      jln 03/04/97
* Job being swapped out, time counter not working          jln 03/04/97
* End of ASVT table not always zero's               1a879  jln 03/13/97
* CALCULATE TIME ZONE OFFSET FOR SYSPLEX TIMER      1B252  JLN 06/25/98
* Modified to list all started tasks and batch jobs        jln 09/15/04
**********************************************************************
         PRINT NOGEN               DON'T PRINT THOSE MACRO EXPANSIONS
CACPSTC0 CSECT                     THIS HERE'S THE BEGINNING
CACPSTC0 AMODE 31                  31-BIT ADDRESSING       JLN 02/12/97
CACPSTC0 RMODE 24      OPEN DCB    24-BIT RESIDENCY        JLN 02/12/97
         YREGS
         USING *,15
         B     START
ASMPGM   DC    C' CACPSTC0'
         LCLC  &MM,&DD,&YYYY                               JLN 06/25/98
&MM      SETC  '&SYSDATC'(5,2)                             JLN 06/25/98
&DD      SETC  '&SYSDATC'(7,2)                             JLN 06/25/98
&YYYY    SETC  '&SYSDATC'(1,4)                             JLN 06/25/98
ASMDATE  DC    C' &MM./&DD./&YYYY'                         JLN 06/25/98
ASMTIME  DC    C' &SYSTIME'
         DC    C' LAST CHANGED'
*        DC    C' 02/14/97'  CREATED PROGRAM TO TEST JOBS
*        DC    C' 02/25/97'  ADDED CODE FOR PARM LIST
*        DC    C' 03/04/97'  skip blank jobname in stc     jln 03/04/97
*        DC    C' 03/13/97'  TEST ENTRIES IN ASVT TABLE    JLN 03/13/97
*        DC    C' 06/30/1998'  CHANGED TO LOCAL FROM GMT   JLN 06/25/98
*        DC    C' 07/09/1998'  COUNT DOWN OS/390 ??        JLN 07/09/98
*        DC    C' 09/15/2004'  FIND ALL STARTED TASKS, JOBS
         DC    C' 01/09/2006'  Add userid to list          jln 01/09/06
START    DS    0H
         ST    R13,SAVEAREA+4
         SAVE  (14,12)
         LR    R11,R13              RETAIN PTR TO CALLER'S REGSAVE
         LA    R13,SAVEAREA
         ST    R13,8(R11)           SAVE OUR PTR IN CALLER'S REGSAVE
         LR    R12,R15
         DROP  15
         USING CACPSTC0,R12
         LR    R11,R1               SAVE PARM ADDRESS
*
* *  MAIN LINE - ROUTINE DRIVER.
*
         BAL   R14,INITPARM
         LTR   R15,R15
         BNZ   EXIT
MAINTEST DS    0H
         BAL   R14,TESTJOBS
         LTR   R15,R15
         BZ    MAINEND
*        CLC   TIMELIMIT(4),TIMETOD      ELAPSED TIME      JLN 07/09/98
*        BL    MAINEND                                     JLN 03/04/97
*        BCT   R11,MAINLOOP
MAINEND  DS    0H                  JOBS NOT RUNNING
         LR    R11,R15
         BAL   R14,TERMNATE
         LR    R15,R11
EXIT     DS    0H                  RETRIEVE PTR TO CALLER'S REGSAVE
         L     R13,SAVEAREA+4
         RETURN (14,12),RC=(15)
*
*        WORKIN' STORAGE - not reentrant
*
         DC    C'WORKING STORAGE STARTS HERE'
SAVEAREA DC    18F'0'              REGISTER SAVE AREA
RC       DC    F'0'                RETURN CODE
         DS    0D        IEV033  ** WARNING **  ALIGNMENT ERROR
PACK8    DC    PL8'0'
CHAR4    DC    C'0000'
WAIT_LIMIT DC  F'1717'    30 MIN * 60 SEC / 1.048576 MICRO JLN 03/04/97
* IT_LIMIT DC  F'286'      5 MIN TESTING ONLY              JLN 06/26/98
ONE_DAY  DC    F'82397'   MICROSECONDS IN 24 HOURS         JLN 06/29/98
TIMEZONE DC    F'0'              TIME ZONE OFF SET         JLN 06/26/98
TIMELIMIT DC   XL16'00'          ELAPSED TIME LIMIT        JLN 03/04/97
TIMETOD  DC    XL16'00'          CURRENT TOD CLOCK         JLN 03/04/97
TIMEGMT  DC    XL16'00'          GREENWICH MEAN TIME (GMT) JLN 06/25/98
DATEGMT  EQU   TIMEGMT+8,4       DATE YYYYMMDD             JLN 06/29/98
TIMELT   DC    XL16'00'          LOCAL TIME AND DATE (LT)  JLN 06/25/98
DATELT   EQU   TIMELT+8,4        DATE YYYYMMDD             JLN 06/29/98
TIMEDATE DC    XL16'00'
SYSTIME  EQU   TIMEDATE,8
SYSDATE  EQU   TIMEDATE+8,5
ED_TIME  DS   0CL16
         DC    C'0'
HOUR     DC    C'00'
MINS     DC    C'00'
SECS     DC    C'00'
SECT     DC    CL9'0'
*
ED_DATE  DS   0CL9
MONTH    DC    C'00'
DAY      DC    C'00'
YEAR     DC    C'0000'
         DC    C'0'
*
ERRMSG   DS    0CL133
ERRPGM   DC    CL10' '
DATEMO   DC    C'00'
         DC    C'/'
DATEDA   DC    C'00'
         DC    C'/'
DATEYR   DC    C'0000'
         DC    C' '
TIMEHH   DC    C'HH'
         DC    C':'
TIMEMM   DC    C'MM'
         DC    C':'
TIMESS   DC    C'SS',C' '
ERRMSGO  DC    C' '
ERRMSGD  DC    CL80' '
         ORG   ERRMSG+133
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'PARM WAIT =    JOBLIST = 12345678,12345678,12345678,12*
               345678,12345678 '
MSG01_WAIT EQU   ERRMSGD+12,2
MSG01_JOB  EQU   ERRMSGD+25,45
JPTR     DC    CL4' '
TYPE     DC    CL4' '
JOBNAME  DC    CL8' '              JOB/STC NAME FROM EXEC PARM
PROCNAME DC    CL8' '              JOB/STC NAME FROM EXEC PARM
USERID   DC    CL8' '              JOB/STC USERID          JLN 01/09/06
MSG02    DC    C'JOBNAME= ........  TYPE= ....  PTR= ....              *
               USERID= ........  '                         JLN 01/09/06
MSG02JOB EQU   ERRMSGD+9,8
MSG02TYP EQU   ERRMSGD+25,4
MSG02PTR EQU   ERRMSGD+36,4
MSG02PRC EQU   ERRMSGD+43,8
MSG02USR EQU   ERRMSGD+62,8                                JLN 01/09/06
MSG03    DC    C'ASVT END OF LIST - COUNT DOWN ...                '
MSG03_COUNT  EQU   ERRMSGD+30,3                            JLN 03/04/97
MSG04    DC    C'NO PARM SUPPLIED, MUST HAVE MM,JJJJJJJJ          '
MSG05    DC    C'INVALID PARM SUPPLIED, MUST HAVE MM,JJJJJJJJ     '
MSG06A   DC    C'  MM - wait time in minutes from 00 to 29 minutes'
MSG06B   DC    C'  JJJJJJJJ - job/stc name list from 1 to 10 names'
MSG07    DC    C'ELAPSED TIME EXPIRES AT HH:MM:SS ON MM/DD/YYYY   '
MSG07_TIMEHH EQU   ERRMSGD+24,2                            JLN 03/04/97
MSG07_TIMEMM EQU   ERRMSGD+27,2                            JLN 03/04/97
MSG07_TIMESS EQU   ERRMSGD+30,2                            JLN 03/04/97
MSG07_DATEMO EQU   ERRMSGD+36,2                            JLN 03/04/97
MSG07_DATEDA EQU   ERRMSGD+39,2                            JLN 03/04/97
MSG07_DATEYR EQU   ERRMSGD+42,4                            JLN 03/04/97
MSG08    DC    C'INVALID POINTER TO ASVT CONTROL BLOCK            '
         DC    C'WORKING STORAGE ENDS HERE'
*
*        ACQUIRE EXEC STATEMENT PARAMETERS
*
INITPARM DS    0H
         ST    R14,INITRTN
         OPEN  (ERRORS,(OUTPUT))    OPEN OUTPUT ERROR FILE
         LA    R1,ERRORS            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     INITEXIT             ABEND IF OPEN FAILS
OPENOK   DS    0H
*        BAL   R14,GETDATE
*        LTR   R15,R15
*        BNZ   INITEXIT
*        MVC   ERRMSGD(L'MSG00),MSG00
*        MVC   ERRPGM,ASMPGM
*        MVC   MSG00_DATE,ASMDATE
*        MVC   MSG00_TIME,ASMTIME
*        PUT   ERRORS,ERRMSG
* ANALYSE THE PARAMETER DATA
*        XR    R10,R10
*        L     R11,0(R11)           POINT TO THE PARAMETER LIST ADDRESS
*        LH    R10,0(R11)           FIRST HALFWORD SHOULD BE A LENGTH
*        CH    R10,=H'0'            ANYTHING OUT THERE ?
*        BH    GOTPARM              N: GO ROLL OVER AND DIE
*        MVC   ERRMSGD(L'MSG04),MSG04
* PARM_ERROR DS    0H
*        PUT   ERRORS,ERRMSG
*        MVC   ERRMSGD(L'MSG06A),MSG06A                    JLN 03/04/97
*        PUT   ERRORS,ERRMSG                               JLN 03/04/97
*        MVC   ERRMSGD(L'MSG06B),MSG06B                    JLN 03/04/97
*        PUT   ERRORS,ERRMSG                               JLN 03/04/97
*        L     R15,=F'8'            RC=8 NO PARM PASSED
*        B     INITEXIT
* GOTPARM  DS    0H
         XR    R15,R15             SET RETURN CODE
INITEXIT DS    0H
         L     R14,INITRTN
         BR    R14                 GET BACK TO WHERE YOU ONCE BELONGED
INITRTN  DS    F
*
*        SEARCH FOR JOB/STC NAME IN THE SYSTEM
*
TESTJOBS DS    0H
         ST    R14,TESTRTN
         L     5,=F'0'             POINT TO PSA TO GET TO CVT
         USING PSA,5
         L     6,FLCCVT            POINT TO CVT TO GET TO ASVT
         DROP  5
         USING CVTMAP,6
         L     7,CVTASVT           POINT TO ASVT TO GET TO ASCB
         DROP  6
         USING ASVT,7
         CLC   =C'ASVT',ASVTASVT  TEST FOR VALID BLOCK     JLN 03/13/97
         BNE   INVLASVT                                    JLN 03/13/97
         L     R6,ASVTMAXU       NUMBER OF ENTRIES         JLN 03/13/97
         LA    R8,ASVTENTY          POINT TO FIRST ASCB SLOT IN ASVT
         DROP  7
ASVTLOOP DS    0H
         TM    0(8),ASVTAVAL       ACTIVE ASCB ADDRESS ?
         BO    ASVTNEXT             NO: SKIP
         ICM   R3,B'1111',0(R8)
         BNZ   GOODASCB             Y: JOB/STC NOT ACTIVE IN SYSTEM
ASVTNEXT DS    0H
         LA    R8,4(,R8)           INCREMENT TO THE NEXT ASVT SLOT
         BCT   R6,ASVTLOOP           AND TRY IT ALL AGAIN  JLN 03/13/97
*        MVC   ERRMSGD(L'MSG03),MSG03
*        MVC   MSG03_COUNT(L'MSG03_COUNT),=X'202120'       JLN 07/09/98
*        CVD   R11,PACK8                                   JLN 07/09/98
*        ED    MSG03_COUNT(L'MSG03_COUNT),PACK8+6          JLN 07/09/98
*        PUT   ERRORS,ERRMSG
         B     TESTEXIT             END OF ASVT LIST
GOODASCB DS    0H
         USING ASCB,R3
         CLC   =C'ASCB',ASCBASCB  TEST FOR VALID BLOCK     JLN 03/13/97
         BNE   ASVTNEXT                                    JLN 03/13/97
         MVC   JPTR,=CL(L'JPTR)' '
         MVC   TYPE,=CL(L'TYPE)' '
         MVC   JOBNAME,=CL(L'JOBNAME)' '
         MVC   PROCNAME,=CL(L'PROCNAME)' '
         MVC   USERID,=CL(L'USERID)' '                     JLN 01/09/06
*
*        ICM   R14,B'1111',ASCBASXB-ASCB(R3)      -> ASXB  JLN 01/09/06
*        BZ    GAI$JI0                            NONE...  JLN 01/09/06
*        CLC   =C'ASXB',ASXBASXB-ASXB(R14) VALID BLOCK     JLN 01/09/06
*        BNE   GAI$JI0                                     JLN 01/09/06
*        MVC   USERID,ASXBUSR8-ASXB(R14)                   JLN 01/09/06
* GAI$JI0  DS  0H
***********************************************************************
**  NAME: DA$DA   CODE USED TO FIND BATCH JOBNAMES                   **
**  AUTHOR: DAVID ALCOCK                                             **
***********************************************************************
*
** PROCESS THE OUCB FOR JOB TYPE AND ADDRESS SPACE STATUS
*
         ICM   R14,B'1111',ASCBOUCB-ASCB(R3)      -> OUCB
         BZ    GAI$JIU                            NONE...
         CLC   =C'OUCB',0(R14)    TEST FOR VALID BLOCK     JLN 03/13/97
         BNE   GAI$JIU                                     JLN 03/13/97
         MVC   USERID,OUCBUSRD-OUCB(R14)                   JLN 01/09/06
*
** PROCESS ACCORDING TO JOB TYPE
*
         MVC   TYPE,OUCBSUBN-OUCB(R14)  SAVE SUBSYSTEM NAME
         CLI   TYPE,C'T'                  TSU  ?
         BE    ASVTNEXT
         CLI   TYPE,C'S'                  STC  ?
         BE    GAI$JIS
         CLI   TYPE,C'O'                  OMVS ?
         BE    GAI$JIJ
         CLI   TYPE,C'J'                  JES  ?
         BNE   GAI$JIU
*
** JOB
*
GAI$JIJ EQU *
         ICM   R14,B'1111',ASCBJBNI-ASCB(R3)
         BZ    GAI$JIS                    NONE...
*
         MVC   JPTR,=C'JBNI'
         MVC   JOBNAME,0(R14)
         CLC   JOBNAME,=CL(L'JOBNAME)' '                   jln 03/04/97
         BE    GAI$JIS
         ICM   R14,B'1111',ASCBCSCB-ASCB(R3)
         BZ    GAI$JIX
         MVC   PROCNAME,CHPROCSN-CHAIN(R14)   PROC STEP
         B     GAI$JIX                    LEAVE
*
** STC
*
GAI$JIS EQU *
         ICM   R14,B'1111',ASCBCSCB-ASCB(R3)
         BZ    GAI$JIU
*
*        TM    CHTRKID-CHAIN(R14),CHSASID SYSTEM ADDRESS SPACE?
*        BNO   GAI$JIS1                   NO, CONTINUE
*        MVC   TYPE(3),=C'SAS'            SET TYPE
*
GAI$JIS1 EQU   *
         MVC   JPTR,=C'CSCB'
         MVC   JOBNAME,CHCLS-CHAIN(R14)       PROC OR JOB NAME
*        MVC   JOBNAME,CHKEY-CHAIN(R14)       JOB NAME ONLY
*        MVC   STEPNAME(8),CHSTEP-CHAIN(R14)
*        MVC   PROCNAME,CHCLS-CHAIN(R14)
*        MVC   PROCNAME,CHSTEP-CHAIN(R14)    - NOT VALID
         MVC   PROCNAME,CHPROCSN-CHAIN(R14)   PROC STEP
*
         TM    CHTRKID-CHAIN(R14),CHINITID INITIATOR?
         BNO   GAI$JISIX                  NO, CONTINUE
*        ICM   R1,B'1111',ASCBJBNI-ASCB(R3) EXECUTING A JOB?
*        BZ    GAI$JISIX                  NO, CONTINUE
*        MVC   PROCNAME,0(R1)          YES, SAVE THE JOB NAME
         B     GAI$JIX                    CAN'T BE MOUNT IF INIT...
GAI$JISIX EQU *
         ICM   R14,B'1111',ASCBOUCB-ASCB(R3) -> OUCB
         BZ    GAI$JIX                    NONE, LEAVE
*        TM    OUCBYFL-OUCB(R14),OUCBMNT  MOUNT?
*        BNO   GAI$JISS                   NO, LEAVE
*        MVC   TYPE(3),=C'MNT'
         B     GAI$JIX                    LEAVE
*
GAI$JISS EQU *
         B     GAI$JIX                    LEAVE
*
** UNKNOWN: USUALLY ONLY "*MASTER*"
*
GAI$JIU EQU *
         ICM   R14,B'1111',ASCBJBNS-ASCB(R3) JOBNAME FOR STARTED TASKS
         BZ    GAI$JIX                    NONE, LEAVE
         MVC   JPTR,=C'JBNS'
         MVC   JOBNAME,0(R14)          GET JOBNAME
*        MVC   TYPE(3),=C'SAS'            SET AS SYSTEM ADDRESS SPACE
GAI$JIX EQU *
         CLC   JOBNAME,=C'INIT    '    JES initiator
         BE    ASVTNEXT
*        CLC   JOBNAME,=CL(L'JOBNAME)' '                   jln 03/04/97
*        BE    ASVTNEXT                                    jln 03/04/97
         MVC   ERRMSGD(L'MSG02),MSG02
         MVC   MSG02JOB,JOBNAME
         MVC   MSG02TYP,TYPE
         MVC   MSG02PTR,JPTR
         MVC   MSG02PRC,PROCNAME
         MVC   MSG02USR,USERID                             JLN 01/09/06
         PUT   ERRORS,ERRMSGD                              jln 09/15/04
         MVC   ERRMSGD(L'MSG02+4),ERRMSGO
         B     ASVTNEXT
*
INVLASVT DS    0H                                          JLN 03/13/97
         MVC   ERRMSGD(L'MSG08),MSG08                      JLN 03/13/97
         PUT   ERRORS,ERRMSG                               JLN 03/13/97
         L     R15,=F'8'           RC=8 ERROR              JLN 03/13/97
         B     TESTRTN8                                    JLN 03/13/97
*
*        SET RETURN CODE
*
TESTEXIT DS    0H
         XR    R15,R15             RC=0
TESTRTN8 DS    0H
         L     R14,TESTRTN
         BR    R14
TESTRTN  DS    F
*
* wait for regions to terminate
*
WAIT     DS    0H
         ST    R14,WAITRTN
*
*        STIMER WAIT,DINTVL=WAITTIME
*
*        BAL   R14,GETDATE
*        LTR   R15,R15
*        BNZ   WAITEXIT
         XR    R15,R15             SET RETURN CODE
WAITEXIT DS    0H
         L     R14,WAITRTN
         BR    R14
WAITRTN  DS    F
WAITTIME DS    0D                  WAIT INTERVAL
WAITHH   DC    C'00'                 - HOURS
WAITMM   DC    C'01'                 - MINUTES
WAITSS   DC    C'00'                 - SECONDS
WAITTH   DC    C'00'                 - TENTHS/HUNDREDTHS (SECOND)
*
         TITLE 'END OF JOB TERMINATION'
* *  PERFORM END OF JOB FUNCTIONS
TERMNATE DS    0H                           INIT ALLOCATE ZONES
         ST    R14,TERMRTN
         CLOSE ERRORS
         L     R15,=F'0'
         L     R14,TERMRTN
         BR    R14
TERMRTN  DC    F'0'
*
ERRORS   DCB   DDNAME=SYSPRINT,DSORG=PS,MACRF=(PM),                    X
               BLKSIZE=27920,LRECL=80
*
*        LITERAL POOL
*
         LTORG
*
*        DSECTS TO MAP MVS CONTROL BLOCKS
*
         PRINT NOGEN
         DCBD  DSORG=BS,DEVD=DA                            JLN 06/28/94
         CVT   DSECT=YES,LIST=NO          Communications Vector Table
         IHAPSA DSECT=YES,LIST=NO         PREFIXED SAVE AREA
         IHAASVT ,                        ADDRESS SPACE VECTOR TABLE
         IHAASCB ,                        Address Space Control Block
         IHAASSB ,                        Address Space Sec. Block
*        IHAASXB ,                        Address Space Ext. Block
         IAZJSAB ,                        Job Scheduler ASCB
         IRAOUCB ,                        Resource Manager User C.B.
         IEECHAIN ,                       Command Scheduling C.B.
         IEESMCA ,                        SMF Control Area
         IEFJESCT                         JES Communications Table
         IEFJSCVT ,                       Subsystem Comm. Vector table
         IEFJSSIB ,                       SubSystem Identification Blk
         END   CACPSTC0          DEFINE ENTRY POINT        JLN 02/12/97
//*
//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=*
//  ENDIF
//
