*DECK DB$PVCA 
USETEXT CDCSCTX 
USETEXT JLPCMTX 
  PROC DB$PVCA; 
  BEGIN 
 #
* *   DB$PVCA                                    PAGE  1
* *   PERFORM AREA PRIVACY CHECK
* *   W P CEAGLIO                                DATE  2/25/76
* 
* DC  PURPOSE 
* 
*     VERIFY THAT A RUN-UNIT HAS ACCESS RIGHTS FOR A SPECIFIED AREA 
* 
* DC  ENTRY CONDITIONS
* 
*     CDCS COMMON 
*           RCB - AREA ORDINAL
*           RCB - "PD" FIELD IN USER FIT
*           RSB - POINTER SET 
*           RSARBLK - POINTER SET 
*           CSFIXED - POINTER SET 
* 
* DC  EXIT CONDITIONS 
* 
*     NORMAL -- CURRENT REQUEST FOR RUN-UNIT ALLOWED TO CONTINUE
* 
*     ABNORMAL -- PRIVACY BREACH ATTEMPT MESSAGE GENERATED AND RUN-UNIT 
*                 PROCESSING IS TERMINATED
* 
* DC  CALLING ROUTINES
* 
*     CONTROL SYMBIONTS 
* 
* DC  CALLED ROUTINES 
* 
*     DB$ERR     GENERATE USER ERROR MESSAGE
*     DB$FLOP    GENERATE FLOW POINT
*     DB$JLH     INITIALIZE JOURNAL LOG RECORD HEADER 
*     DB$JLO     OUTPUT A JOURNAL LOG RECORD
*     DB$PUNT    INTERNAL CDCS ERROR PROCESSOR
* 
* DC  NON-LOCAL VARIABLES MODIFIED
* 
*     JOURNAL LOG COMMON
* 
* DC  DESCRIPTION 
* 
*     1. EXTRACT THE PROCESSING DIRECTION VALUE FROM THE USER FIT.
*     2. USING THE PD VALUE, DETERMINE THE PROPER MASK TO COMPARE 
*        WITH THE RSB AREA CONTROL BLOCK PRIVACY LOCK OPTIONS FIELD.
* 
*           PD = 0,1    INPUT (RETRIEVAL) 
*           PD = 2      OUTPUT (UPDATE) 
*           PD = 3      INPUT/OUTPUT (RETRIEVAL/UPDATE) 
* 
*     3. COMPARE THE MASK WITH THE RSB AREA PRIVACY LOCK OPTIONS. 
*        IF ALL NEEDED OPTIONS ARE OK, ACCESS IS PERMITTED, SO RETURN.
*        OTHERWISE, INDICATE THAT A PRIVACY BREACH WAS ATTEMPTED AND
*        TERMINATE PROCESSING FOR THE RUN-UNIT.  CONTROL IS NOT 
*        RETURNED TO THE CALLING SYMBIONT.
* 
 #
      CONTROL NOLIST; 
*CALL CSTARDCLS 
      CONTROL LIST; 
  
# DEFS                                                                 #
  
      DEF DFPDIP #1#;                   # OPEN/INPUT                   #
      DEF DFPDOP #2#;                   # OPEN/OUTPUT                  #
      DEF DFPDIO #3#;                   # OPEN/INPUT-OUTPUT            #
  
# LOCAL ITEMS AND ARRAYS                                               #
  
      ITEM J U;                         # SCRATCH ITEM USED FOR PD #
      ITEM PMASK U;                     # PRIVACY LOCK CHECK MASK # 
  
# EXTERNAL REFERENCES                                                  #
  
      XREF PROC DB$ERR;                 # GENERATE ERROR MESSAGE       #
      XREF PROC DB$FLOP;                # GENERATE FLOW POINT          #
      XREF PROC DB$JLH;                 # INITIALIZE LOG RECORD HEADER #
      XREF PROC DB$JLO;                 # OUTPUT A JOURNAL LOG RECORD  #
      XREF PROC DB$PUNT;                # INTERNAL CDCS ERROR PROCESSOR#
      CONTROL EJECT;
  
  
# S T A R T  D B $ P V C A  E X E C U T A B L E  C O D E               #
  
  
# EXTRACT PROCESSING DIRECTION FROM USER-SUPPLIED FIT                  #
  
      CONTROL IFGR DFFLOP,0;
        DB$FLOP("PVCA   "); 
      CONTROL ENDIF;
  
  
      J = RCPFITPD [0]; 
  
# USING THE PD VALUE, DETERMINE THE PROPER MASK TO COMPARE WITH THE # 
# PRIVACY LOCK OPTIONS FIELD IN THE CURRENT RSB AREA CONTROL BLOCK. # 
  
      IF J LQ DFPDIP                             # IF OPEN FOR INPUT #
        THEN PMASK = DFPVARRT;                   # THEN RETRIEVE MASK#
        ELSE                                     # ELSE NOT FOR INPUT#
          IF J EQ DFPDOP                         # IF OPEN FOR OUTPUT#
            THEN PMASK = DFPVARUP;               # THEN UPDATE MASK # 
            ELSE                                 # ELSE NOT OUTPUT #
              IF J EQ DFPDIO                     # IF OPEN INPT/OUTPT#
                THEN PMASK = DFPVARRU;           # THEN RETRIEVE/UPDT#
                ELSE DB$PUNT ("DB$PVCA  1");     # ELSE INTERNAL ERR #
  
# COMPARE THE MASK WITH THE AREA CONTROL BLOCK PRIVACY LOCK OPTIONS. #
  
      IF PMASK LAN RSARPRIV [0] EQ PMASK         # COMPARE MASK, RSB #
        THEN                                     # NEEDED OPTIONS OK #
  
# CHECK PASSED--RETURN TO CALLER                                       #
  
        BEGIN 
        RETURN; 
        END 
  
# CHECK FAILED -- GENERATE "BREACH ATTEMPT" LOG RECORD AND             #
# DISASSOCIATE CALLER FROM CDCS.                                       #
  
      IF SASCJAFG[SALX] THEN
        BEGIN 
        PARLEN = DFJLSZPA;   # SIZE OF PRIVACY LOG RECORD              #
        DB$JLH;              # INITIALIZE JOURNAL LOG RECORD HEADER    #
  
        JLHDWDA[0] = DFJLWDAPA; 
        JLPVFLLR[0] = " ";   # RESERVED                                #
        JLPVSCIT[0] = "    ";  # RESERVED                              #
        JLPVSSIT[0] = "    ";  # RESERVED                              #
        JLPVSCNM[0] = CSFSCNAM[0];  # SCHEMA NAME                      #
        JLPVSBNM[0] = CSFSBNAM[0];  # SUBSCHEMA NAME                   #
        P<CSAREBLK> = P<CSFIXED> + RSARCSTP[0];  # CST AREA WORK BLOCK #
        JLPVARNM[0] = C<0,CSANAMLW[0]*10> CSANAME[0];  # AREA NAME     #
        TRLRLEN = 0;
        DB$JLO;              # OUTPUT A JOURNAL LOG RECORD             #
  
        END 
  
      DB$ERR (23);
  
  END 
      TERM
