ACCESS

* Callable z/OS TSO SAF effective-access checker
CHKACCSS TITLE 'Checks Effective SAF Access'
         PRINT ON,DATA,GEN
CLEAR    CSECT
         YREGS
MAIN     BAKR  R14,0
         LR    R8,R15
         USING MAIN,R8
         DS    0H
* Clear all input fields.
         MVI   GETDSN,C' '
         MVC   GETDSN+1(L'GETDSN-1),GETDSN
         MVI   GETVOL,C' '
         MVC   GETVOL+1(L'GETVOL-1),GETVOL
         MVI   CLASSNAM,C' '
         MVC   CLASSNAM+1(L'CLASSNAM-1),CLASSNAM
         MVI   ACCESSNM,C' '
         MVC   ACCESSNM+1(L'ACCESSNM-1),ACCESSNM
         MVI   RESNAME,C' '
         MVC   RESNAME+1(L'RESNAME-1),RESNAME
* Parse the standard TSO CALL parameter.
         L     R9,0(,R1)
         LH    R10,0(,R9)
         LA    R9,2(,R9)
         LTR   R10,R10
         BNP   BADPARM
* RESOURCE class access entity invokes the generic SAF form.
         CHI   R10,9
         BL    CHKDATA
         CLC   0(9,R9),=CL9'RESOURCE '
         BNE   CHKDATA
         LA    R9,9(,R9)
         AHI   R10,-9
         B     PARSRES
* DATASET dataset-name volume invokes the explicit dataset form.
CHKDATA  CHI   R10,8
         BL    SKIPDS
         CLC   0(8,R9),=CL8'DATASET '
         BNE   SKIPDS
         LA    R9,8(,R9)
         AHI   R10,-8
* A legacy "dataset-name volume" parameter remains supported.
SKIPDS   CLI   0(R9),C' '
         BNE   COPYDS
         LA    R9,1(,R9)
         BCT   R10,SKIPDS
         B     BADPARM
COPYDS   LA    R6,GETDSN
         LA    R7,L'GETDSN
DSLOOP   CLI   0(R9),C' '
         BE    SKIPVOL
         MVC   0(1,R6),0(R9)
         LA    R6,1(,R6)
         LA    R9,1(,R9)
         BCT   R7,DSROOM
         B     SKIPVOL
DSROOM   BCT   R10,DSLOOP
         B     DSAUTH
SKIPVOL  CLI   0(R9),C' '
         BNE   COPYVOL
         LA    R9,1(,R9)
         BCT   R10,SKIPVOL
         B     DSAUTH
COPYVOL  LA    R6,GETVOL
         LA    R7,L'GETVOL
VOLLOOP  MVC   0(1,R6),0(R9)
         LA    R6,1(,R6)
         LA    R9,1(,R9)
         BCT   R7,VOLROOM
         B     DSAUTH
VOLROOM  BCT   R10,VOLLOOP
* Ask SAF for the caller's highest effective DATASET access.
DSAUTH   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,DSAUTH+4
         C     R15,=F'0'
         BE    DSHASACS
         C     R15,=F'4'
         BNE   ERROR
         C     R3,=F'4'
         BNE   ERROR
         LA    R6,20
         B     RETURNRC
DSHASACS C     R3,=F'20'
         BNE   ERROR
         LR    R6,R4
         B     VALIDACS
* Parse RESOURCE class access entity.
PARSRES  LA    R6,CLASSNAM
         LA    R7,L'CLASSNAM
         XR    R5,R5
CLSLP    CLI   0(R9),C' '
         BE    SETCLEN
         MVC   0(1,R6),0(R9)
         LA    R6,1(,R6)
         LA    R9,1(,R9)
         LA    R5,1(,R5)
         BCT   R7,CLSROOM
         B     SETCLEN
CLSROOM  BCT   R10,CLSLP
         B     BADPARM
SETCLEN  STC   R5,CLASSLEN
SKIPACC  CLI   0(R9),C' '
         BNE   ACCSTART
         LA    R9,1(,R9)
         BCT   R10,SKIPACC
         B     BADPARM
ACCSTART LA    R6,ACCESSNM
         LA    R7,L'ACCESSNM
ACCLP    CLI   0(R9),C' '
         BE    SKIPENT
         MVC   0(1,R6),0(R9)
         LA    R6,1(,R6)
         LA    R9,1(,R9)
         BCT   R7,ACCROOM
         B     SKIPENT
ACCROOM  BCT   R10,ACCLP
         B     BADPARM
SKIPENT  CLI   0(R9),C' '
         BNE   ENTSTART
         LA    R9,1(,R9)
         BCT   R10,SKIPENT
         B     BADPARM
ENTSTART LA    R6,RESNAME
         LA    R7,L'RESNAME
         XR    R5,R5
ENTLP    MVC   0(1,R6),0(R9)
         LA    R6,1(,R6)
         LA    R9,1(,R9)
         LA    R5,1(,R5)
         BCT   R7,ENTROOM
         B     SETLEN
ENTROOM  BCT   R10,ENTLP
SETLEN   STH   R5,RESLEN
* Validate the requested threshold; REXX performs the comparison.
         CLC   ACCESSNM,=CL7'READ'
         BE    RESAUTH
         CLC   ACCESSNM,=CL7'UPDATE'
         BE    RESAUTH
         CLC   ACCESSNM,=CL7'CONTROL'
         BE    RESAUTH
         CLC   ACCESSNM,=CL7'ALTER'
         BE    RESAUTH
         B     BADPARM
* Ask SAF for highest effective access to the supplied resource.
RESAUTH  RACROUTE REQUEST=AUTH,                                        X
               RELEASE=1.9,                                            X
               CLASS=CLASSX,                                           X
               STATUS=ACCESS,                                          X
               ENTITY=RESNAME,                                         X
               WORKA=SAFWORKA
         LM    R3,R4,RESAUTH+4
         C     R15,=F'0'
         BE    RESHASAC
         C     R15,=F'4'
         BNE   ERROR
         C     R3,=F'4'
         BNE   ERROR
         LA    R6,20
         B     RETURNRC
RESHASAC C     R3,=F'20'
         BNE   ERROR
         LR    R6,R4
* Effective access: 0 NONE, 4 READ, 8 UPDATE, 12 CONTROL, 16 ALTER.
VALIDACS C     R6,=F'0'
         BNE   READ
         B     RETURNRC
READ     C     R6,=F'4'
         BNE   UPDATE
         B     RETURNRC
UPDATE   C     R6,=F'8'
         BNE   CONTROL
         B     RETURNRC
CONTROL  C     R6,=F'12'
         BNE   ALTER
         B     RETURNRC
ALTER    C     R6,=F'16'
         BNE   WHATTHE
         B     RETURNRC
WHATTHE  LA    R6,64
RETURNRC DS    0H
         LR    R15,R6
         B     EXITP
BADPARM  DS    0H
ERROR    DS    0H
         LA    R15,64
EXITP    PR    ,
GETDSN   DS    CL44
GETVOL   DS    CL6
CLASSX   DS    0H
CLASSLEN DS    X
CLASSNAM DS    CL8
ACCESSNM DS    CL7
RESLEN   DS    H
RESNAME  DS    CL246
SAFWORKA DS    CL512
         LTORG ,
         DROP  R8
         END   MAIN