Trailing-Edge
-
PDP-10 Archives
-
decuslib10-08
-
43,50512/access.b36
There are no other files named access.b36 in the archive.
MODULE ACCESS=
!Access control routine for NETSPL
BEGIN
FORWARD ROUTINE
ACCESS,
CKACCESS, !Get & return the access bits
CKACCHANDLE; !Condition handler for ACCESS
REQUIRE 'INTR.REQ';
LIBRARY 'DAPLIB'; !Dap declarations & macros
THIS_IS [ACCE] VERSION [2] EDIT[16] DATE [25,SEP,79]
%( R E V I S I O N H I S T O R Y
[16] Don't say "ACCESS REFUSED" if disk isn't mounted, etc.
[15] Fix [14] so not to lose buffers & thus grow
[14] Look in ACCESS.FTS first
[13] Fix granting /ALL if any switches set but /NONE
[12] Make /RENAME check both new & old file
make CHECK_ACCESS block into a routine
[11] Fix /NONE not working on left of "=" sign
Fix error msgs so not always ... for read
[10] Change BIND FB=N[FB]: REF FILE_BLOCK to BIND FB=.N[FB]: FILE_BLOCK
[7] Fix /NONE, make everything conform to documentation
[6] Make LSWITCHES (& GSWITCHES) use bits from right to left
[5] Remove [4], NDB$REQUESTOR is once again ASCIZ
[4] Make NDB$REQUESTOR ASCIC string
END R E V I S I O N H I S T O R Y )%
!
!Literals
!
LITERAL !Bit definitions for LSWITCHES
AS_NOACCESS=0, !/NONE was found (don't allow any access at all)
AS_READ=1,
AS_CREATE=2,
AS_RENAME=3,
AS_ERASE=4,
AS_LIST=6,
AS_BATCH=7,
AS_COMMAND=8, !1 to 8 must correspond to DAP ACCFUNC codes
AS_WRITE=12, !Reserved for future use
AS_SUPERCEDE=13,!Allow superceding of existing file
AS_ALL=15; !/ALL
LITERAL LF=%O'12', CR=%O'10';
LITERAL LINE_LEN=131;
%IF NOT %DECLARED(PATMIN) %THEN LITERAL PATMIN=4; %FI
!
! Externals
!
EXTERNAL ROUTINE READ,FPARSE,RDDIR,COPY,CKWLD6,CKWLD,DOSWITCHES,CKWLDD,
BUFFREE,ZERO,CKWLDP,RDSIXA,CKWLDA,CHACAZ;
EXTERNAL ACSTBL; !Switch table
!
! Routines
!
GLOBAL ROUTINE ACCESS(NB)=
!Access control routine
!Argument:
!NB: Node data block. File being accessed has file block
! pointed to by NB[NDB$FB]
BEGIN
MAP NB: REF NDB;
BIND FB=.NB[NDB$FB]: FILE_BLOCK;
LOCAL LSWITCHES: BITVECTOR[16]; !Access bits from CKACCESS
FB[FILE$GODLY]=1; !Make sure we get as much access as we can
LSWITCHES=CKACCESS(NB[FILE$START],FB[FILE$START]); !Check access bits
!Now check our access bits against what we need
IF .LSWITCHES[.NB[NDB$ACCFUNC]] EQL 0 THEN ERROR(FILPRT,FB[FILE$START]);
!Now clear the blocks read&written count
FB[FILE$READS]=(FB[FILE$WRITES]=0);
!Now open the file
BEGIN
BIND FOP=NB[NDB$FOP]: EX[6];
BIND FAC=NB[NDB$FAC]: EX[6]; !FAC field
SELECT .NB[NDB$ACCFUNC] OF SET
[ACC$OPEN]:
BEGIN
!Does he want to delete?
IF .FOP[FB$DLC] AND (NOT .LSWITCHES[AS_ERASE])
THEN ERROR(FILPRT,FB[FILE$START]);
IF .FAC[FB$UPD] THEN
BEGIN
OPEN_U(FB);
RETURN WIN;
END
ELSE BEGIN
OPEN_R(FB);
RETURN WIN;
END;
END;
[ACC$CREATE]:
BEGIN
IF .FAC[FB$PUT] THEN
BEGIN
IF .FOP[FB$SUP]
THEN BEGIN
IF .LSWITCHES[AS_SUPERCEDE]
THEN OPEN_W(FB)
ELSE OPEN_CRE(FB);
!We will return ER$FEX to remote system
!either if he did not ask for supercede
!or couldn't get it
RETURN WIN;
END
ELSE BEGIN
OPEN_CRE(FB);
RETURN WIN;
END;
END
END;
[ACC$RENAME]:
BEGIN
LOCAL RSWITCHES: BITVECTOR[16]; !Access switches for rename
BIND RENAME_FB=.NB[NDB$RENAME_FB]: FILE_BLOCK;
IF .RENAME_FB[FILE$DEVICE] EQL 0 !Default new device to old
THEN RENAME_FB[FILE$DEVICE]=.FB[FILE$DEVICE];
RSWITCHES=CKACCESS(NB[FILE$START],.NB[NDB$RENAME_FB]);
FB[FILE$RENAME]=RENAME_FB[FILE$ELK]; !What to rename it to
IF .RSWITCHES[AS_CREATE]
THEN RENAME(FB)
ELSE ERROR(FILPRT,.NB[NDB$RENAME_FB]);
!no access to new name
RETURN WIN;
END;
[ACC$ERASE]:
BEGIN
DELETE(FB);
RETURN WIN;
END;
TES;
END;
RETURN 0;
END;
ROUTINE CKACCESS(NB,FB)=
!Local routine to get the access bits for the file.
!Reads ACCESS.USR in the specified directory.
!
! Formal Parameters
!
!NB: address of NDB
!FB: address of FILE_BLOCK of file being checked
!
! Returned value
!
!Access bits as defined above
BEGIN
MAP NB: REF NDB, !NDB for transfer
FB: REF FILE_BLOCK; !File being checked
!STRUCTURE BITV[BT;BLEN]=[1] BITV<BT,1>;
LOCAL LINE: VECTOR[CH$ALLOCATION(LINE_LEN+1)], !Line we just read from ACCESS.USR
REQUESTOR: VECTOR[CH$ALLOCATION(40)], !Requestor from ACCESS.USR
NODEID, !Nodeid we just read from ACCESS.USR
FILE: NDB, !Fileblock to scan ACCESS.USR
FILE_SAVE: FILE_BLOCK, !Save name of file we-re trying to open
GSWITCHES: BITVECTOR[16], !Global switches
LSWITCHES: BITVECTOR[16], !Local switches
! Bit position corresponds to ACCESS msg function code
PTR; !Pointer to the above line
REGISTER C; !Save last character read
LABEL CHECK_ACCESS, !Block to get appropriate bits
DOLINE; !Block that process a line in ACCESS.USR
!Establish handler to catch errors on ACCESS.USR
ESTABLISH(CKACCHANDLE,NB[FILE$START],FB[FILE$START],FILE_SAVE);
CHECK_ACCESS:
BEGIN
COPY(FB[FILE$START],FILE_SAVE[FILE$START],FB_LEN); !Save the file block
FB[FILE$GODLY]=1; !Enable full file access
FB[FILE$NAME]=%SIXBIT'ACCESS'; !Set to ACCESS.USR
FB[FILE$EXTENSION]=%SIXBIT' FTS';
!Note that ACCESS.FTS will be opened on the same channel
!as the real file will be (but not at the same time).
FB[FILE$MODE]=_IOASC; !Read this in ASCII mode always
OPEN_R(FB[FILE$START]); !Open ACCESS.FTS
COPY(FILE_SAVE[FILE$COUNT],FB[FILE$COUNT],.FILE_SAVE[FILE$COUNT]+1);
!Restore lookup block
!FB[FILE$GODLY]=.FILE_SAVE[FILE$GODLY]; !Restore godly bit
FB[FILE$MODE]=.FILE_SAVE[FILE$MODE]; !Restore data mode
FILE[FILE$DEVICE]=.FB[FILE$DEVICE]; !Device & directory
IF .FB[FILE$LPPN] LEQ %O'777777'
THEN BEGIN
FILE[FILE$LPPN]=FILE[FILE$PATH_FUN]; !Point to path block
COPY(FB[FILE$PATH_FUN],FILE[FILE$PATH_FUN],SFDMAX+PATMIN);
END
ELSE FILE[FILE$LPPN]=.FB[FILE$LPPN];
WHILE 1 DO
DOLINE: BEGIN !Read through ACCESS.USR
FILE[NDB$NODEID]=(FILE[FILE$NAME]=(FILE[FILE$EXTENSION]=0));
READ(FB[FILE$START],%REF(CH$PTR(LINE)),LINE_LEN,LF);
!Read in a line
PTR=CH$PTR(LINE);
FILE[FILE$PF_NOSIG]= !Don't signal FPARSE errors
(FILE[FILE$PF_WILD_A]=(FILE[FILE$PF_WILDN_A]=1));
!Remember that wildcards are allowed here
IF FPARSE(FILE,PTR) NEQ WIN THEN LEAVE DOLINE;
!Get nodeid & filename
IF CKWLD(FILE,FB[FILE$START]) THEN
BEGIN !This line matches our file
GSWITCHES=DOSWITCHES(ACSTBL,PTR,%REF(0));!Parse switches
SELECT .GSWITCHES OF SET !Check for errors
[ILLSWI,AMBSWI]: LEAVE DOLINE; !Bad switch
TES;
IF CH$RCHAR_A(PTR) NEQ %C'='
THEN LEAVE DOLINE; !Syntax error
NODEID=.FILE[NDB$NODEID]; !Default, if any
DO BEGIN
SELECT CH$RCHAR(.PTR) OF SET
[%C'A' TO %C'Z',%C'a' TO %C'z',%C'0' TO %C'9',
%C'%',%C'?',%C'*']:
BEGIN !Nodeid (we hope)
LOCAL RDSARG;
RDSARG=PTR; RDSARG<35,1>=1; !Allow wilds
NODEID=RDSIXA(.RDSARG);
IF (CH$RCHAR_A(PTR) NEQ %C':') OR
(CH$RCHAR_A(PTR) NEQ %C':')
THEN LEAVE DOLINE; !Not a nodeid
END; !Getting nodeid
[OTHERWISE]:;
TES;
IF .NODEID EQL 0 THEN LEAVE DOLINE;
!If we didn't get it by now we never will
SELECT (CH$RCHAR(.PTR)) OF SET
[%C'[',%C'<']: !Directory specifier
BEGIN
LOCAL REQPTR,
ACCESSOR: VECTOR[CH$ALLOCATION(40)];
REQPTR=CH$PTR(ACCESSOR);
DO CH$WCHAR_A(C=CH$RCHAR_A(PTR),REQPTR)
UNTIL (.C EQL %C'>') OR (.C EQL %C']');
!Copy this requestor string
CH$WCHAR_A(0,REQPTR); !Make ASCIZ
!Get switches if any
LSWITCHES=
DOSWITCHES(ACSTBL,PTR,%REF(0));
SELECT .LSWITCHES OF SET
[0]: LSWITCHES=.GSWITCHES;
!No switches on this side
! use ones from left side
[ILLSWI,AMBSWI]: LEAVE DOLINE;
TES;
IF CKWLDA(CH$PTR(ACCESSOR),
CH$PTR(N[REQUESTOR]))
AND
CKWLD6(.NODEID,.NB[NDB$NODEID])
THEN BEGIN
LEAVE CHECK_ACCESS
WITH .LSWITCHES;
END;!A match
END; !Process dir & switches
[%C',']: CH$RCHAR_A(PTR);
[OTHERWISE]: LEAVE DOLINE; !Syntax error
TES;
END WHILE 1;
!A comma heralds the arrival of another PPN
END;
END; !DOLINE loop
END; !CHECK_ACCESS block
BUFFREE(.FB[FILE$I_BRH]); !Free the buffers
BUFFREE(.FB[FILE$O_BRH]); !
IF .LSWITCHES[AS_SUPERCEDE] THEN LSWITCHES[AS_CREATE]=1;
!/SUPERCEDE implies /CREATE
IF .LSWITCHES[AS_NOACCESS] THEN ERROR(FILPRT,FB[FILE$START]); !/NONE found
IF .LSWITCHES[AS_ALL] THEN LSWITCHES=-2; !Set everyting if /ALL
.LSWITCHES !Returned value
END; !CKACCESS
ROUTINE CKACCHANDLE(SIGNAL_ARGS,MECH_ARGS,ENABLE_ARGS)=
!Condition handler for ACCESS. Any kind of condition causes access failure
!ENABLE_ARGS[1]= addr of NDB,
!ENABLE_ARGS[2]= the file block for the file being access-checked
!ENABLE_ARGS[3]= addr of FILE_SAVE
BEGIN
MAP SIGNAL_ARGS: REF BLOCK FIELD(SA_FIELDS),
MECH_ARGS: REF VECTOR,
ENABLE_ARGS: REF VECTOR;
BIND NB=ENABLE_ARGS[1]: REF NDB,
FB=.ENABLE_ARGS[2]: FILE_BLOCK,
FILE_SAVE=.ENABLE_ARGS[3]: FILE_BLOCK;
!First fix up function field so we get the right error message
FB[FILE$FUNCTION]= (SELECT .N[ACCFUNC] OF SET
[ACC$OPEN]: (IF .EX[N[FAC],FB$UPD]
THEN _FOSAU
ELSE _FORED);
[ACC$CREATE]: _FOCRE;
[ACC$RENAME]: _FORNM;
[ACC$ERASE]: _FODLT;
TES
);
!Now check the error code. EOF or file-not-found on ACCESS.USR
!counts as a protection failure.
SELECT .SIGNAL_ARGS[SA$STSCODE] OF SET
[FILFNF]: IF .FB[FILE$EXTENSION] EQL %SIXBIT ' FTS'
THEN BEGIN
LOCAL T;
BUFFREE(.FB[FILE$I_BRH]); ![15]
BUFFREE(.FB[FILE$O_BRH]); ![15]
FB[FILE$EXTENSION]=%SIXBIT ' USR';
!Try ACCESS.USR if no ACCESS.FTS
FB[FILE$PF_NOSIG]=1; !Do not SIGNAL errors
T=OPEN_R(FB[FILE$START]);
FB[FILE$PF_NOSIG]=0;
IF .T
THEN RETURN SS$_CONTINUE
END;
[FILERR TO FILOPN]: BEGIN !Put file block back the way we found it
COPY(FILE_SAVE[FILE$COUNT],FB[FILE$COUNT],
.FILE_SAVE[FILE$COUNT]+1);
!Restore lookup block
FB[FILE$MODE]=.FILE_SAVE[FILE$MODE]; !Restore data mode
END;
[ENDFILE]: BEGIN
BUFFREE(.FB[FILE$I_BRH]); !Free the I/O buffers
BUFFREE(.FB[FILE$O_BRH]); !
END;
[FILPRT]: RETURN SS$_RESIGNAL; !Don't call ourself forever
[FILFNF,ENDFILE]: !Can't open ACCESS.USR, or read all of it already
BEGIN
SIGNALE(FILPRT,FB[FILE$START]);
RETURN SS$_CONTINUE; !No entry in ACCESS.USR fits
END;
[OTHERWISE]: RETURN SS$_RESIGNAL; !Pass the buck
TES;
END;
END ELUDOM