ACCESS

* For use on z/OS TSO only
CHKACCSS TITLE 'Checks Access to a Dataset'
         PRINT ON,DATA,GEN
CLEAR    CSECT
         YREGS                 # Register readability macro
*         SETUP registers and save areas thanks @bigendiansmalls      *
MAIN     BAKR  R14,0           # Save regs linkage stack
         LR    R8,R15          # R15 Program base into R8 for Adrsblty
         USING MAIN,R8         # R8 for addressability
         DS    0H              # Halfword boundaries
* Get the Dataset we're going to check
* CASE is ImPoRtAnT
         TPUT  MESSAGE1,L'MESSAGE1,EDIT   # Get Dataset Name
         TGET  GETDSN,130                 # Case sensitive
         TPUT  MESSAGE2,L'MESSAGE2,EDIT   # Get Dataset Volume
         TGET  GETVOL,6                   # Case sensitive
*        TPUT  GETDSN,L'GETDSN,EDIT # For some reason I need this
*                                   # or this abends *shrugs*
* Now we need to check access
SAFCHK   RACROUTE REQUEST=AUTH,                                        x
               RELEASE=1.9,                                            x
               STATUS=ACCESS,                                          x
               CLASS='DATASET',                                        x
               ATTR=UPDATE,                                            x
               ENTITY=GETDSN,VOLSER=GETVOL,                            x
               WORKA=SAFWORKA
         LM    R3,R4,SAFCHK+4 # Save Return Code, Rsn Code in R3/R4
CHECKRTN DS    0H           # Check SAF Return Code in R15
         C     R15,=F'0'    # If its zero check RACF RC
         BE    CHECKACS
         C     R15,=F'4'    # Otherwise is the SAF RC 4?
         BNE   ERROR        # Its not? Then its 8/64 and thats bad
         C     R3,=F'4'     # The specified resource is not protected
         BNE   NOACCESS     # We get no access (if rc is 8)
         MVC   OUTPUTA,NOTPROTA
         B     PRINTMSG     # Print not protected message
CHECKACS DS    0H
         C     R3,=F'20'    # Is the SAF return code 0x14?
         BNE   ERROR        # No? Then we dont care
*
* SAF Return Codes (when R15 is 0 and R3 is  x14)
* R4 is one of the following:
* x0   = No Access
* x4   = READ
* x8   = UPDATE
* xC   = CONTROL
* x10  = ALTER
*
NOACCESS C     R4,=F'0'
         BNE   READ
         MVC   OUTPUTA,NONEA
         B     PRINTMSG
READ     C     R4,=F'4'
         BNE   UPDATE
         MVC   OUTPUTA,READA
         B     PRINTMSG
UPDATE   C     R4,=F'8'
         BNE   CONTROL
         MVC   OUTPUTA,UPDATEA
         B     PRINTMSG
CONTROL  C     R4,=F'12'
         BNE   ALTER
         MVC   OUTPUTA,CONTROLA
         B     PRINTMSG
ALTER    C     R4,=F'16'
         BNE   WHATTHE
         MVC   OUTPUTA,ALTERA
         B     PRINTMSG
WHATTHE  MVC   OUTPUTA,WHATA
PRINTMSG TPUT  OUTPUTA,L'OUTPUTA,EDIT
         B     EXITP
ERROR    TPUT  ERRORMSG,L'ERRORMSG,EDIT
* Now we're done lets exit
EXITP    DS    0H
         XR    R15,R15         # zero return code
*        LR    R15,R4          # Return the results
         PR    ,               # Return to caller
*
* FILE AND WORK AREA DEFINITIONS
*
MESSAGE1 DC    C'** ENTER DATASET:'
MESSAGE2 DC    C'** ENTER VOLUME SERIAL:'
ERRORMSG DC    C'** ERROR: SAF RC NOT 00 - Dataset/Volume incorrect'
GETDSN   DS    CL44  # Max length for dataset
GETVOL   DS    CL6   # Max length for volume
NONEA    DC    C'RC 00 - No Access     '
READA    DC    C'RC 04 - READ Access   '
UPDATEA  DC    C'RC 08 - UPDATE Access '
CONTROLA DC    C'RC 0C - CONTROL Access'
ALTERA   DC    C'RC 10 - ALTER Access  '
WHATA    DC    C'RC Not documented     '
NOTPROTA DC    C'Not Protected by RACF '
OUTPUTA  DS    CL(L'CONTROLA)
SAFWORKA DS    CL512
         LTORG ,     # Literal pool here
         DROP  R8    # Drop R8 Addressability
         END   MAIN  # Peace owt