IDMS ZBIND Exit (MVS Only)

You can write a program named ZBIND that uses standard IBM calling conventions and link-edit it with the Data Adapter IDMSR module (member IDMSR in the 'prefix.IDMS.LOAD' data set). When a user executes a FOCUS TABLE request against an IDMS database, the IDMS Data Adapter calls the ZBIND exit before issuing the IDMS BIND RUN UNIT command.

A sample COBOL program, located in member ZBINDPGM in the 'prefix.IDMS.DATA' PDS can be used to check if a user has authorization to access the subschema that is associated with the FOCUS request. There are six parameters passed to the program from the IDMS Data Adapter:

USER        PIC X(08)
SUBSCHEMA   PIC X(08)
DBNAME      PIC X(08)
NODE        PIC X(08)
DICTNAME    PIC X(08)
DICTNODE    PIC X(08)
STATUS      PIC X(04)

On return of a non-zero status code, the user receives the following error message:

(FOC4405)  BIND RUN-UNIT  DENIED BY  USER EXIT  ZBIND FOR  SUBSCHEMA: subschema

The following is a listing of the ZBINDPGM program provided on the tape:

*RETRIEVAL
*NO-ACTIVITY-LOG
 IDENTIFICATION DIVISION.
 PROGRAM-ID.  ZBIND.
***********************************************************
* PROGRAM: ZBIND
* PURPOSE: CHECK TO SEE IF A USER ISSUING A FOCUS REQUEST
*  HAS ACCESS TO THE SUBSCHEMA REQUESTED.
* THIS PROGRAM MAY BE USED FREELY BY THOSE
* WHO NEED AN EXAMPLE TO CODE THEIR OWN EXIT.
***********************************************************
 DATE-WRITTEN.  AUG  1992.
 DATE-COMPILED. DATE COMPILED
 ENVIRONMENT DIVISION.
 CONFIGURATION SECTION.
 SOURCE-COMPUTER.  IBM-370.
 SPECIAL-NAMES.
 INPUT-OUTPUT SECTION.
 FILE-CONTROL.
 IDMS-CONTROL SECTION.
 PROTOCOL.  MODE IS BATCH DEBUG IDMS-RECORDS MANUAL.
 SCHEMA SECTION.
 DB IDMSNWKA WITHIN IDMSNTWK.
 DATA DIVISION.
 EJECT
 FILE SECTION.
 EJECT
 WORKING-STORAGE SECTION.
 01  WS-START.
     02 FILLER               PIC X(33) VALUE
                  'ZBIND WORKING STG STARTS HERE==>'.
 01  COPY IDMS SUBSCHEMA-CONTROL.
 01  COPY IDMS RECORD USER-047.
 01  COPY IDMS RECORD ACCESS-045.
 01  COPY IDMS RECORD SS-026.
 LINKAGE SECTION.
 01  PUSER           PIC X(8).
 01  PSS             PIC X(8).
 01  PDBNAME         PIC X(8).
 01  PNODE           PIC X(8).
 01  PDICT           PIC X(8).
 01  PDICTNODE       PIC X(8).
 01  PSTAT           PIC X(4).

**********************************************************
*
* RETURN CODE - 0000 - USER HAS ACCESS TO SUBSCHEMA
*             - 0016 - USER NOT IN DICTIONARY
*             - 0032 - USER DOES NOT HAVE ACCESS TO SUBSCHEMA
*             - 9999 - PASSED PARMS USER AND/OR SS INVALID
*             - NNNN - ERROR DURING IDMS-STATS PROCESSING.
*                      WHERE NNNN = ERROR-STATUS
*
***********************************************************
 PROCEDURE DIVISION  USING PUSER,
                           PSS,
                           PDBNAME,
                           PNODE,
                           PDICT,
                           PDICTNODE,
                           PSTAT.
 0000-MAINLINE.
***  DISPLAY '"'  PUSER '"'
***          '"'  PSS   '"'.
*** RESET ERROR-STATUS TO ENSURE REENTRANCY
     MOVE '1400'  TO ERROR-STATUS.
     MOVE 'ZBIND' TO PROGRAM-NAME.
*** CHECK FOR INVALID PASSED PARMS
     IF PUSER = SPACE OR
        PSS   = SPACE
         MOVE '9999' TO PSTAT
         GOBACK.
*** CHECK FOR PRESENCE OF DBNAME PARM - DETERMINE WHICH BIND
     NOTE: THIS PROGRAM ASSUMES THE DBNAME PASSED IS THE DBNAME
                WHICH MAPS THE IDMSNWKA SUBSCHEMA TO THE REQUESTED
                DICTIONARY.
                IT DOES ==> NOT <== LOOK AT THE DICTNAME PARAMETER
                PASSED
                TO THE EXIT.
     IF PDBNAME = SPACE
         BIND RUN-UNIT
       ELSE
         BIND RUN-UNIT  DBNAME PDBNAME.
     IF ANY-ERROR-STATUS
         MOVE ERROR-STATUS TO PSTAT
         GOBACK.
     *** BIND AND READY
     BIND USER-047.
     IF ANY-ERROR-STATUS
         MOVE ERROR-STATUS TO PSTAT
         GO TO 9999-WRAP-UP.
     BIND ACCESS-045.
     IF ANY-ERROR-STATUS
         MOVE ERROR-STATUS TO PSTAT
         GO TO 9999-WRAP-UP.
     BIND SS-026.
     IF ANY-ERROR-STATUS
         MOVE ERROR-STATUS TO PSTAT
         GO TO 9999-WRAP-UP.
     READY  USAGE-MODE IS RETRIEVAL.
     IF ANY-ERROR-STATUS
         MOVE ERROR-STATUS TO PSTAT
         GO TO 9999-WRAP-UP.
*** SEE IF USER IS IN THE DICTIONARY
     MOVE PUSER TO USER-NAME-047.
     FIND CALC USER-047.
     IF DB-REC-NOT-FOUND
         MOVE '0016' TO PSTAT
         GO TO 9999-WRAP-UP.
     IF ANY-ERROR-STATUS
         MOVE ERROR-STATUS TO PSTAT
         GO TO 9999-WRAP-UP.
*** LOOP THRU USER-ACCESS-SS RECS TO SEE IF RELATIONSHIP EXISTS
 1200-NEXT-ACCESS.
     FIND NEXT ACCESS-045 WITHIN USER-ACCESS.
     IF DB-END-OF-SET
         MOVE '0032' TO PSTAT
         GO TO 9999-WRAP-UP.
     IF ANY-ERROR-STATUS
         MOVE ERROR-STATUS TO PSTAT
         GO TO 9999-WRAP-UP.
     IF NOT SS-ACCESS MEMBER
         GO TO 1200-NEXT-ACCESS.
     OBTAIN OWNER WITHIN SS-ACCESS.
     IF ANY-ERROR-STATUS
         MOVE ERROR-STATUS TO PSTAT
         GO TO 9999-WRAP-UP.
     IF SS-NAM-026 = PSS
         MOVE '0000' TO PSTAT
         GO TO 9999-WRAP-UP.
     GO TO 1200-NEXT-ACCESS.
 9999-WRAP-UP.
     FINISH.
     GOBACK.
     EJECT
*COPY IDMS IDMS-STATUS.
*IDMS-ABORT SECTION.
*I-A-EXIT.  EXIT.

The following JCL, member ZBIND in the 'prefix.IDMS.DATA' PDS can be used to link edit the ZBIND user written program.

//LINK     EXEC PGM=IEWL,
//         PARM='LET,NCAL,SIZE=(1024K),LIST'
//OBJLIB   DD DSN=prefix.ZBIND.OBJLIB,DISP=SHR
//MAINTAIN DD DSN=prefix.IDMS.DATA,DISP=SHR
//LOAD     DD DSN=prefix.IDMS.LOAD,DISP=SHR
//SYSLMOD  DD DSN=prefix.OUTPUT.LOADLIB,DISP=SHR
//SYSUT1   DD UNIT=SYSDA,SPACE=(CYL,(10,1))
//SYSPRINT DD SYSOUT=*
//SYSLIN   DD  *
INCLUDE OBJLIB(ZBIND)
INCLUDE MAINTAIN(IDMSR)
INCLUDE LOAD(IDMSR)
ENTRY IDMSR
NAME IDMSR(R)
/*
//

where:

prefix.ZBIND.OBJLIB

Is the PDS containing ZBIND object code.

prefix.IDMS.DATA

Is the PDS containing the Data Adapter source library.

prefix.IDMS.LOAD

Is the PDS containing the IDMSR load module.

prefix.OUTPUT.LOADLIB

Is the PDS to contain the new IDMSR load module.