Google
 

Trailing-Edge - PDP-10 Archives - tops20_v6_1_tcpip_distribution_tp_ft6 - 6-1-documentation/acj.mem
There are 18 other files named acj.mem in the archive. Click here to see a list.
; UPD ID= 2012, SNARK:<5.UTILITIES>ACJ.MAC.6,  18-May-81 14:53:35 by LYONS
;add lots of neet new code for special tests, and the command file processor
; UPD ID= 801, SNARK:<5.UTILITIES>ACJ.MAC.4,  25-Jul-80 13:28:31 by LYONS
;FIX BUG IN REPORTING TTY NUMBERS, TO PREVENT GETTING TTY777777
; UPD ID= 450, SNARK:<5.UTILITIES>ACJ.MAC.3,  21-Apr-80 16:25:53 by LYONS
;FIX BUG INTRODUCED IN LAST EDIT
; UPD ID= 411, SNARK:<5.UTILITIES>ACJ.MAC.2,   4-Apr-80 11:07:56 by LYONS
;ADD CORE FOR .GOANA AND .GODNA
;<4.UTILITIES>ACJ.MAC.45,  2-Oct-79 14:36:10, EDIT BY MILLER
;FIX TYPEO
;<4.UTILITIES>ACJ.MAC.44, 26-Sep-79 15:28:06, EDIT BY BLOUNT
;CHANGE EDIT BELOW TO NOT PRINT OUT USER # IN RCVOK
;<4.UTILITIES>ACJ.MAC.43, 25-Sep-79 17:58:57, EDIT BY HALL
;ADD CODE TO HANDLE .GOOAD FUNCTION
;<4.UTILITIES>ACJ.MAC.42, 15-Sep-79 13:37:58, EDIT BY MILLER
;ADD .GOACC LOGGING
;<4.UTILITIES>ACJ.MAC.41, 29-Jun-79 14:20:15, EDIT BY R.ACE
;EDIT ON BEHALF OF BLOUNT:
;PRINT OUT EITHER JOB # OR USER # IN RCVOK

;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
;  OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (C) 1976,1977,1978,1979 BY DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.

	TITLE ACJ - ACCESS CONTROL JOB
	SUBTTL SAMPLE GETOK/GIVOK PROGRAM - PETER M. HURLEY, DEC 14,78

	SALL
	SEARCH MONSYM,MACSYM
	.REQUIRE SYS:MACREL

	VMAJOR==5		;MAJOR VERSION NUMBER
	VMINOR==0		;MINOR VERSION NUMBER
	VEDIT==7		;EDIT NUMBER
	VCUST==0		;CUSTOMER EDIT NUMBER

	VACJ==<VCUST>B2+<VMAJOR>B11+<VMINOR>B17+VEDIT

	T1=1
	T2=2
	T3=3
	T4=4
	Q1=5
	Q2=6
	Q3=7
	P1=10
	P2=11
	P3=12
	P4=13
	P5=14
	P6=15
	CX=16
	P=17

;ERROR CODE DEFINITIONS

	ERRILR==400001		;ILLEGAL GETOK REQUEST, ACCESS DENIED
	ERRAEC==400002		;INVALID ERROR CODE RETURNED FROM ACJ ROUTINE
				;  (THIS INDICATES A BUG IN ACJ)
;MACRO DEFINITIONS

DEFINE WARN (A) <
	CALL [	IFNB <A>,<HRROI T1,[ASCIZ/A/]>
		IFB <A>,<SETZ T1,>
		CALL WRNMES
		RET]>

DEFINE ERRMES (A) <
	JRST [	HRROI T1,[ASCIZ/
? ACCESS CONTROL JOB: A
/]
		PSOUT
		JRST DIE]>

;ENTRY VECTOR

ENTVEC:	JRST START		;START ADR
	JRST START		;REENTER ADR
	VACJ			;VERSION NUMBER


;ARGUMENT BLOCK

;ARGBLK:	+----------------------+
;	    	! FUNCTION !           !
;	    0	!   CODE   !   JOB #   !
;		+----------+-----------+
;		!		       !
;	    1   !  USER NUMBER         !
;		!		       !
;		+----------------------+
;	   	!		       !
;	    2	!  CONNECTED DIRECTORY !
;		+----------------------+
;	   	!		       !
;	    3	!    REQUEST NUMBER    !
;		+----------------------+
;	   	!      # OF USER       !
;	    4	!      ARGUMENTS       !
;		+----------------------+
;	   	!    POINTER TO THE    !
;	    5	!     ARGUMENT LIST    !
;		+----------------------+
;	   	!       CURRENT        !
;	    6	!     CAPABILITIES     !
;		+----------------------+
;		!       TERMINAL       !
;	    7	!      DESIGNATOR      !
;		+----------------------+
;		!      REQUESTED       !
;	    10	!        JOB #         !
;		+----------------------+
;MAIN PROGRAM

START:	RESET			;INIT THE WORLD
	MOVE P,[IOWD PDLEN,PDL]	;SET UP A STACK
	SETZM VARBEG		;INIT THE VARIABLES
	MOVE T1,[VARBEG,,VARBEG+1]
	BLT T1,VAREND-1
	CALL SETCAP		;SET UP THE PROPER CAPABILITIES
	 ERRMES (<WHEEL OR OPERATOR CAPABILITY REQUIRED TO PERFORM ACCESS CONTROL>)
	CALL INIPI		;TURN ON THE PI SYSTEM
	CALL INILOG		;GET A JFN ON THE LOG FILE
	 JRST DIE		;FAILED, GO NO FURTHER
	CALL INICMD		;READ THE COMMAND FILE, AND SET PARAMETERS
	CALL ENAFNC		;ENABLE THE ACCESS CONTROL FUNCTIONS

;MAIN LOOP

LOOP:	MOVEI T1,ARGBLK		;GET ADR OF ANSWER BLOCK
	MOVEI T2,ARGLEN		;AND LENGTH OF BLOCK
	RCVOK%			;GET NEXT FUNCTION TO CHECK/LOG
	 ERJMP [WARN <COULD NOT RECEIVE ACCESS REQUESTS >
		JRST DIE]
	HLRZ T1,ARGBLK+.RCFCJ	;GET FUNCTION CODE
	DMOVE T2,[DSPTAB	;SET UP FOR DISPATCH
		  DSPTLN]
	TRNE T1,400000		;USER REQUEST?
	DMOVE T2,[USRDSP	;YES, GET ADR OF USER TABLE
		  USRDLN]
	CALL TSEARCH		;SEE IF WE CAN FIND IT
	 JRST ILLREQ		;NOT THERE, IT APPEARS
	HRRZ T1,(T2)		;GET THE DISPATCH ADDRESS
	CALL (T1)		;BUILD STRING FOR FUNCTION LOG
	CALL LOGCHK		;SEE IF WE SHOULD LOG, AND IF SO, DO IT
	CALL ACJCHK		;CHECK TO SEE IF WE ARE ALLOWING THE FUNCTION
	 JRST [	CALL DENY	;ACCESS IS DENIED
		JRST LOOP]	;LOOP BACK FOR NEXT REQUEST
	CALL ALLOW		;ACCESS IS ALLOWED
	JRST LOOP		;LOOP BACK FOR NEXT REQUEST

ILLREQ:	MOVEI T1,ERRILR		;ILLEGAL REQUEST
	HRROI T2,[ASCIZ/UNEXPECTED REQUEST FOR ACCESS - DENIED/]
	CALL DENY		;DENY THIS REQUEST
	JRST LOOP		;LOOP BACK FOR THE NEXT REQUEST
;ROUTINE TO DENY ACCESS
;ACCEPTS IN T1/	ERROR #
;	    T2/	STRING POINTER TO ERROR MESSAGE
;	CALL DENY
;RETURNS +1:	ALWAYS

DENY:	TRNE T1,400000		;IS THIS A LEGAL ERROR CODE?
	TLNE T1,-1		;CANNOT HAVE BITS IN LEFT HALF
	MOVEI T1,ERRAEC		;ILLEGAL ACCESS ERROR CODE
	TLC T2,-1		;CHECK FOR A LEGAL STRING POINTER
	TLCN T2,-1
	HRLI T2,(POINT 7,0)	;GET STRING POINTER
	LDB T3,[POINT 6,T2,11]	;GET BYTE SIZE
	CAIE T3,7		;MUST BE AN ASCII BYTE POINTER
	HRROI T2,[ASCIZ/UNEXPLAINED DENIAL FROM ACCESS CONTROL JOB/]
	MOVE T3,T2		;SET UP FOR GIVOK
	MOVE T2,T1		;ERROR NUMBER
	MOVE T1,ARGBLK+3	;GET THE REQUEST NUMBER
	GIVOK%			;DENY REQUEST
	 ERCAL WRN
	RET


;ROUTINE TO ALLOW ACCESS
;	CALL ALLOW
;RETURNS +1:	ALWAYS

ALLOW:	MOVE T1,ARGBLK+3	;GET THE REQUEST NUMBER
	SETZB T2,T3		;GIVE THE OK
	GIVOK%
	 ERCAL WRN
	RET			;DONE
;ROUTINE TO LOG A REQUEST
;ACCEPTS IN T1/	STRING POINTER TO TYPE OF REQUEST
;	CALL LOGREQ
;RETURNS +1:	ALWAYS

LOGREQ:	ASUBR <LOGRQS,LOGRQJ>
	MOVE T1,LOGJFN		;GET JFN OF LOG FILE
	MOVEM T1,LOGRQJ		;SAVE IT
	MOVE T2,[070000,,OF%APP]
	OPENF			;OPEN THE JFN FOR APPEND
	 JRST [	WARN <COULD NOT OPEN SYSTEM:ACCESS-CONTROL.LOG >
		MOVEI T1,.PRIOU	;DUMP THIS REQUEST TO THE TTY
		MOVEM T1,LOGRQJ
		JRST .+1]
	SETO T2,		;PUT OUT A TIME STAMP
	SETZ T3,
	ODTIM
	MOVEI T2," "
	BOUT
	MOVE T2,LOGRQS		;GET THE STRING POINTER
	SETZ T3,
	SOUT			;APPEND IT TO THE LOG
	HRROI T2,[ASCIZ/, JOB:/]
	SOUT
	MOVEI T3,^D10
OUTJOB:	HRRZ T2,ARGBLK+.RCFCJ	;GET THE JOB/USER #
	NOUT			;OUTPUT THE JOB #
	 MOVE T1,LOGRQJ
	HRROI T2,[ASCIZ/, /]
	SETZ T3,
	SOUT
	HRRZ T2,ARGBLK+.RCTER	;GET THE TTY DESIGNATOR
	CAIN T2,-1		;DETACHED?
	JRST [	HRROI T2,[ASCIZ/DET/]
		SETZ T3,
		SOUT
		JRST LOGRQ1]
	HRROI T2,[ASCIZ/TTY/]
	SOUT
	MOVE T2,ARGBLK+.RCTER	;GET THE TTY NUMBER AGAIN
	MOVEI T3,10
	NOUT			;OUTPUT THE TTY NUMBER
	 MOVE T1,LOGRQJ
LOGRQ1:	HRROI T2,[ASCIZ/, CAPABILITIES:/]
	SETZ T3,
	SOUT
	HRRZ T2,ARGBLK+.RCCAP	;GET THE RIGHT HALF CAPABILITIES
	MOVE T3,[NO%ZRO!NO%LFL!6B17!10]
	NOUT
	 MOVE T1,LOGRQJ
	HRRZ T1,ARGBLK+0	;GET THE JOB NUMBER
	MOVE T2,[-JILEN,,JIBLK]	;GET JOB INFO
	SETZ T3,
	GETJI
	 JRST LOGRQ2		;FAILED, SKIP THIS PART
	MOVE T1,LOGRQJ		;GET JFN
	HRROI T2,[ASCIZ/, USER:/]
	SETZ T3,
	SOUT
	MOVE T2,JIBLK+.JIUNO	;GET USER NUMBER
	DIRST			;OUTPUT USER NAME
	 MOVE T1,LOGRQJ
	HRROI T2,[ASCIZ/, PROGRAM:/]
	SETZ T3,
	SOUT
	MOVE T2,JIBLK+.JIPNM	;GET SIXBIT PROGRAM NAME
	CALL SIXTO7		;TRANSLATE IT TO ASCII
LOGRQ2:	MOVE T1,LOGRQJ		;GET JFN
	HRROI T2,[ASCIZ/
/]
	SETZ T3,
	SOUT
	HRLI T1,(CO%NRJ)	;KEEP THE JFN
	CLOSF			;CLOSE THE JFN TO UPDATE LOG FILE
	 JFCL
	RET			;DONE
;ROUTINE TO LOG A DEVICE ASSIGNMENT

GOASD:	HRROI T2,[ASCIZ/DEVICE ASSIGNMENT - /]
GOAS0:	HRROI T1,STRING		;GET POINTER TO STRING AREA
	SETZ T3,
	SOUT
	MOVE T3,ARGBLK+5	;GET THE POINTER TO THE ARG
	MOVE T2,.GEADD(T3)	;GET THE DEVICE DESIGNATOR
	DEVST			;OUTPUT IT TO THE STRING
	 ERCAL WRN
	HRROI T1,STRING		;SET UP TO LOG IT
	RET


;SPECIAL CODE TO CHECK FOR ALLOWING .GOASD

STASD:	RETSKP			;ALLOW IT
;ROUTINE TO LOG ASSIGN DUE TO OPENF

GOOAD:	HRROI T2,[ASCIZ /OPENF DEVICE ASSIGNMENT - /]
	JRST GOAS0		;AND PROCEED


;SPECIAL CODE TO CHECK FOR ALLOWING .GOOAD

STOAD:	RETSKP			;ALLOW IT


;ROUTINE TO LOG THE CHANGING OF CAPABILITIES

GOCAP:	HRROI T1,STRING		;BUILD THE STRING
	HRROI T2,[ASCIZ/SET CAPABILITIES - /]
	SETZ T3,
	SOUT
	HRRZ T2,ARGBLK+6	;GET THE CURRENT CAPABILITIES
	MOVE T3,[NO%ZRO!NO%LFL!6B17!10]
	MOVE T4,T1		;SAVE THE POINTER
	NOUT
	 MOVE T1,T4
	HRROI T2,[ASCIZ/=>/]
	SETZ T3,
	SOUT
	MOVE T3,ARGBLK+.RCARA	;GET POINTER TO ARG
	HRRZ T2,.GENCP(T3)	;GET THE DESIRED CAPABILITIES
	MOVE T3,[NO%ZRO!NO%LFL!6B17!10]
	NOUT
	 ERCAL WRN
	HRROI T1,STRING
	RET			;DENIED


;SPECIAL CODE TO CHECK FOR ALLOWING .GOCAP

STCAP:	RETSKP
;ROUTINE TO LOG LOGIN'S

GOLOG:	HRROI T1,STRING		;BUILD STRING
	HRROI T2,[ASCIZ/LOGIN - /]
	SETZ T3,
	SOUT
	MOVE T3,ARGBLK+.RCARA	;GET ARG
	MOVE T2,.GELUN(T3)	;GET USER NUMBER FOR LOGIN
	DIRST
	 ERCAL WRN
	HRROI T1,STRING
	RET


;SPECIAL CODE FOR ALLOWING .GOLOG

STLOG:	RETSKP
;ROUTINE TO LOG AN  LOGOUT

GOLGO:	HRROI T1,STRING		;BUILD THE STRING
	HRROI T2,[ASCIZ/LOGOUT  - PERMANENT QUOTA = /]
	SETZ T3,
	SOUT
	MOVE T2,ARGBLK+.RCARA	;GET ARG
	MOVE T2,.GEQUO(T2)	;GET THE PERMANENT QUOTA
	MOVEI T3,^D10		;DECIMAL
	MOVE T4,T1
	NOUT
	 MOVE T1,T4		;GET THE STRING POINTER BACK
	HRROI T2,[ASCIZ/, CURRENT ALLOCATION = /]
	SETZ T3,
	SOUT
	MOVE T2,ARGBLK+.RCARA
	MOVE T2,.GEUSD(T2)	;GET CURRENT # IN USE
	MOVEI T3,^D10		;DECIMAL
	MOVE T4,T1
	NOUT
	 MOVE T1,T4		;RESTORE POINTER
	HRROI T1,STRING
	RET


;SPECIAL ROUTINE TO ALLOW .GOLGO

STLGO:	RETSKP
;ROUTINE TO LOG THE CREATION OF A DIR

GOCRD:	HRROI T1,[ASCIZ/DIRECTORY CREATION/]
	RET


;SPECIAL ROUTINE TO ALLOW FOR .GOCRD

STCRD:	RETSKP
;ROUTINE TO LOG A JOB ENTERING MDDT

GOMDD:	HRROI T1,[ASCIZ/ENTER MDDT/]
	RET


;SPECIAL ROUTINE TO ALOOW FOR .GOMDD

STMDD:	SETZB T1,T3
	HRROI T2,[ASCIZ /OPERATOR/]
	RCDIR
	 ERJMP	R		;IF CONVERSION FAILS, CALL IT A LOSE
	CAME T3,ARGBLK+1	;SAVE AS THE USER NUMBER?
	RETSKP			;NO, HE DOES NOT GET MDDT
	RETSKP			;FINE BUY ME, IF HE HAS WHEEL
;ROUTINE TO LOG A USER GETOK FUNCTION

USRRQ0:	HRROI T1,[ASCIZ/USER REQUEST - 400000/]
	RET
USRRQ1:	HRROI T1,[ASCIZ/USER REQUEST - 400001/]
	RET
USRRQ2:	HRROI T1,[ASCIZ/USER REQUEST - 400002/]
	RET
USRRQ3:	HRROI T1,[ASCIZ/USER REQUEST - 400003/]
	RET
USRRQ4:	HRROI T1,[ASCIZ/USER REQUEST - 400004/]
	RET
USRRQ5:	HRROI T1,[ASCIZ/USER REQUEST - 400005/]
	RET
USRRQ6:	HRROI T1,[ASCIZ/USER REQUEST - 400006/]
	RET
USRRQ7:	HRROI T1,[ASCIZ/USER REQUEST - 400007/]
	RET

;SPECIAL TEST CODE FOR USER REQUESTS.

STUSR:
STUSR0:
STUSR1:
STUSR2:
STUSR3:
STUSR4:
STUSR5:
STUSR6:
STUSR7:	RETSKP
;ROUTINE TO LOG THE MOUNTING OF A STRUCTURE

GOSMT:	HRROI T1,STRING		;BUILD THE STRING
	HRROI T2,[ASCIZ/STRUCTURE MOUNT - /]
	SETZ T3,
	SOUT
	MOVE T3,ARGBLK+.RCARA	;GET THE STR NAME
	MOVE T2,.GESDE(T3)	;GET DEVICE NAME
	DEVST			;PUT THE NAME IN THE STRING
	 ERJMP [CALL WRN
		JRST GOSMT1]
	HRROI T2,[ASCIZ/:/]
	SETZ T3,
	SOUT
GOSMT1:	HRROI T1,STRING
	RET


;SPECIAL ROUTINE TO TEST FOR ALLOWING STRUCTURE MOUNT

STSMT:	RETSKP
	HRRZ T1,ARGBLK+.RCCAP	;GET THE PRIVS FOR THE USER
	TXNN T1,SC%OPR!SC%WHL
	 RETSKP			;HERE TO DENY, BUT LET IT HAPPEN
	RETSKP			;ALLOW ANYONE TO MOUNT THE STRUCTURE IN ANY
				;CASE.
;ROUTINE TO LOG A CRJOB

GOCJB:	HRROI T1,[ASCIZ/JOB CREATION VIA CRJOB/]
	RET


;SPECIAL ROUTINE TO TEST TO ALLOW CRJOB

STCJB:	RETSKP
;ROUTINE TO LOG FORK CREATIONS

GOCFK:	HRROI T2,[ASCIZ/JOB CREATING FORK NUMBER /]
	JRST LOGNUM		;LOG IT


;SPECIAL TEST CODE FOR FORK CREATION

STCFK:	HRRZ T1,ARGBLK+1	;GET THE USER NUMBER AS WE KNOW IT
	CAIN T1,5		;IS THIS FOR THE OPERATOR?
	RETSKP			; YES, ALLOW OPERATOR TO HAVE OVER 5 FORKS
	MOVSI T2,10		; THE SUB CODE IS NUMBER OF FORKS
	CALL MONCHK		;CHECK ON NUMBER IN USE
	 RET			; OVER 80% IN USE
	MOVSI T2,5		; THE SUB CODE IS NUMBER OF SPTS
	CALL MONCHK
	 RET
	MOVSI T2,6		; THE SUB CODE IS AMOUNT OF SWAP SPACE
	CALL MONCHK
	 RET
	RETSKP			;NO, LET HIM EAT UP ANOTHER FORK.

MONCHK:	MOVEI T1,14		;SET UP FOR THE "MONRD%" JSYS.
	JSYS 717		;THIS WILL LOSE IF NOT INSTALLED WITH SYSDPY
	 ERJMP RSKP		;RETURN A WIN, AS WE CAN MAKE NO REAL CHOICE
	MOVE T1,T3
	IMULI T1,100		;NUMBER OF WHATEVERS IN USE * 100
	IDIVI T1,(T2)		;NUMBER OF (IN USE) * 100 / (AVAILABLE)
	CAIL T1,^D80		;80 % OF THE WHATEVERS IN USE ?
	 RET			;YES, WE CANT ALLOW THIS USER TO HOG MORE
	RETSKP
;ROUTINE TO LOG ENQ QUOTA CHANGES

GOENQ:	HRROI T2,[ASCIZ/SET ENQ QUOTA TO /]
	JRST LOGNUM		;GO LOG THIS REQUEST


;SPECIAL ROUTINE FOR CHECKING ENQ QUOTA CHANGE

STENQ:	RETSKP
;ROUTINE TO LOG SETTING OF A CLASS

GOCLS:	HRROI T1,STRING		;BUILD THE ENTRY
	HRROI T2,[ASCIZ/SET SCHEDULER CLASS OF JOB /]
	SETZ T3,
	SOUT
	MOVE T4,ARGBLK+.RCARA	;GET THE POINTER TO THE ARGS
	HRRZ T2,.GEJOB(T4)	;GET THE JOB NUMBER
	MOVEI T3,^D10		;DECIMAL
	NOUT
	 ERCAL WRN
	HRROI T2,[ASCIZ/ TO CLASS /]
	SETZ T3,
	SOUT
	HRRZ T2,.GECLS(T4)	;GET THE NEW CLASS #
	MOVEI T3,^D10		;DECIMAL
	NOUT
	 ERCAL WRN
	HRROI T1,STRING		;LOG THE ENTRY
	RET


;SPECIAL CODE FOR CLASS SETTING

STCLS:	RETSKP
;ROUTINE TO LOG CLASS SET AT LOGIN

GOCL0:	HRROI T2,[ASCIZ/SET SCHEDULER CLASS AT LOGIN FOR JOB /]
	JRST LOGNUM		;LOG IT


LOGNUM:	HRROI T1,STRING		;GET PLACE TO STORE THE FIRST PART OF STRING
	SETZ T3,		;STRING POINTER IS ALREADY IN T2
	SOUT			;COPY STRING TO TEMP BUFFER
	MOVE T3,ARGBLK+.RCARA	;GET THE ARGUMENT
	HRRZ T2,.GEJOB(T3)		;FROM THE ARG BLOCK
	MOVEI T3,^D10		;DECIMAL
	NOUT			;OUTPUT THE DECIMAL NUMBER TO THE STRING
	 ERCAL WRN
	HRROI T1,STRING		;LOG THE EVENT
	RET


;SPECIAL ROUTINE FOR LOGIN CLASS SETTING

STCL0:	RETSKP
;ROUTINE TO LOG THE CHANGING OF A TERMINAL SPEED

GOTBR:	HRROI T2,[ASCIZ/SET TERMINAL BAUD RATE OF LINE /]
	HRROI T1,STRING		;GET PLACE TO STORE THE FIRST PART OF STRING
	SETZ T3,		;STRING POINTER IS ALREADY IN T2
	SOUT			;COPY STRING TO TEMP BUFFER
	MOVE T4,ARGBLK+.RCARA	;GET THE LINE #
	HRRZ T2,.GELIN(T4)	;FROM THE ARG BLOCK
	MOVEI T3,10		;OCTAL
	NOUT			;OUTPUT THE LINE NUMBER
	 ERCAL WRN
	HRROI T2,[ASCIZ/ TO IN=/]
	SETZ T3,
	SOUT			;OUTPUT "TO"
	HLRZ T2,.GESPD(T4)	;GET INPUT SPEED
	MOVEI T3,^D10		;DECIMAL
	NOUT
	 ERCAL WRN
	HRROI T2,[ASCIZ/, OUT=/]
	SETZ T3,
	SOUT
	HRRZ T2,.GESPD(T4)	;GET THE OUTPUT SPEED
	MOVEI T3,^D10		;DECIMAL
	NOUT
	 ERCAL WRN
	HRROI T1,STRING		;LOG THE EVENT
	RET


;SPECIAL ROUTINE TO DECIEDT TO DO .GOTBR

STTBR:	RETSKP
;ROUTINE TO LOG AN ACCESS REQUEST TO AN MT

GOMTA:	HRROI T1,STRING		;SET UP POINTER TO TEMP STRING
	HRROI T2,[ASCIZ/ACCESS TO MT/]
	SETZ T3,
	SOUT			;OUTPUT THE HEADER
	MOVE T4,ARGBLK+.RCARA	;GET POINTER TO ARGS
	HRRZ T2,.GEUNT(T4)	;GET MT UNIT NUMBER
	MOVEI T3,10		;OCTAL
	NOUT			;OUTPUT THE UNIT #
	 ERCAL WRN
	HRROI T2,[ASCIZ/: BY USER /]
	SETZ T3,
	SOUT
	MOVE T2,.GEUSN(T4)	;GET THE USER NUMBER
	DIRST			;OUTPUT THE USER NAME
	 ERCAL WRN
	HRROI T2,[ASCIZ/, ACCESS CODE = /]
	SOUT
	MOVE T2,.GEACC(T4)	;GET THE ACCESS CODE
	BOUT
	HRROI T2,[ASCIZ/, REQUESTED ACCESS = /]
	SOUT
	MOVE T2,.GEACD(T4)	;GET THE REQUESTED ACCESS
	MOVEI T3,10		;OCTAL
	NOUT
	 ERCAL WRN
	MOVE T3,.GELTP(T4)		;GET LABEL TYPE
	HRROI T2,[ASCIZ/, LABEL TYPE = UNKNOWN/]
	CAIN T3,.LTANS		;ANSI?
	HRROI T2,[ASCIZ/, LABEL TYPE = ANSI/]
	CAIN T3,.LTT20		;TOPS-20?
	HRROI T2,[ASCIZ/, LABEL TYPE = TOPS-20/]
	CAIN T3,.LTEBC		;EBCDIC?
	HRROI T2,[ASCIZ/, LABEL TYPE = EBCDIC/]
	SETZ T3,
	SOUT
	HRROI T1,STRING		;GET STRING TO LOG
	RET


;SPECIAL CODE FOR MAG TAPE ACCESS

STMTA:	RETSKP			;ALLOW IT
;LOG ACCESS OR CONNECT TO DIR. THIS FUNCTION IS ONLY EXECUTED
;WHEN THE REQUEST CANNOT BE HONORED DUE TO INCORRECT PASSWORD
;OR INSUFFICIENT PRIVILEGES.

GOACC:	HRROI T1,STRING		;SET UP STRING POINTER
	HRROI T2,[ASCIZ /ACCESS OR CONNECT TO DIRECTORY /]
	SETZM T3
	SOUT			;OUTPUT THE HEADER
	MOVE T4,ARGBLK+.RCARA	;POINT TO ARGS
	MOVE T2,.GOAC1(T4)	;GET DIR
	DIRST			;AND PUT IN DIRECTORY
	 JSERR			;REPORT ERROR
	HRROI T1,STRING
	RET


;SPECIAL CODE FOR DIRECTORY CONNECTS

STACC:	HRROI T2,[ASCIZ /GUEST/]
	SETZB T1,T3		;GET USER FOR GUEST
	RCUSR			;CONVERT TO USER NUMBER
	 ERJMP .+1		;IF IT FAILS, MUST BE NO GUEST ACCOUNT
	CAMN T3,ARGBLK+1	;WAS THE REQUEST FROM GUEST?
	JRST STACC1		;YES, DO MORE CHECKING
	RETSKP			;NO, ALLOW CONNECT FOR US

STACC1:	MOVE T2,ARGBLK+.RCARA	;POINTER TO ARGS
	MOVE T2,.GOAC1(T2)	;GET DIRECTORY/USER NUMBER
	SETZB T1,T3		;CLEAR OTHER FLAGS
	RCDIR			;CONVERT TO DIRECTORY NUMBER
	 ERJMP R		;FAILED, DENY IT
	PUSH P,T2		;SAVE DESTINATION
	SETZB T1,T3
	HRROI T2,[ASCIZ /PS:<GUEST>/]
	RCDIR
	 ERJMP [POP P,T3
		JRST R]		;LOSER, TOO, BUT SHOULD NEVER GET HERE
	POP P,T2		;GET NUMBER
	CAME T2,T3		;WAS IT A CONNECT BACK TO <GUEST>?
	 RET			;NO, LOSER
	RETSKP			;YES, ALLOW THAT, TOO
;ROUTINE TO ALLOW DENCET ACCESS

GODNA:	HRROI T1,[ASCIZ /ACCESS TO DECNET /]
	RET


;SPECIAL ROUTINE TO ALLOW DECNET ACCESS

STDNA:	HRRZ T2,ARGBLK+.RCCAP	;GET THIS USERS PRIVS
	TRNN T2,SC%WHL!SC%OPR!SC%DNA ;ALLOW ACCESS IF WHEEL, OPR, OR DNA SET
	 RETSKP			;NOT ALLOWED
	RETSKP			;LET IT HAPPEN
;ROUTINE TO ALLOW ACCESS TO ARPANET

GOANA:	HRROI T1,[ASCIZ /ACCESS TO ARPANET /]
	RET


STANA:	HRRZ T2,ARGBLK+.RCCAP	;GET THIS SET OF PRIVS
	TRNN T2,SC%WHL!SC%OPR!SC%ANA!SC%NWZ!SC%NAS
				;WHEEL, OPERATOR, ARPANET-ACCESS, 
				;ARPANET-WIZARD, ABSOLUTE-ARPANET-SOCKETS
	 RET			;DENY IT
	RETSKP			;ALLOW THE ACCESS
;ROUTINE TO DECEIDE IF WE NEED TO LOG THIS REQUEST, IF SO, DO IT

LOGCHK:	CALL LOGREQ
	RET
;ROUTINE TO SEE IF WE ARE GOING TO GRANT THIS ACCESS

;CALL ACJCHK
;	RETURN +1 IF ACCESS IS DENIED
;	RETURN +2 IF ACCESS IS ALLOWED

ACJCHK:	HLRZ T1,ARGBLK+.RCFCJ	;GET THE CODE
	DMOVE T2,[STCTAB
		  STCLEN]	;SPECIAL TEST CODE
	TRNE T1,400000		;USER REQUEST
	DMOVE T2,[USTCTB
		  USTCLN]	;USER TABLE..
	CALL TSEARCH		;SEARCH TO TABLE ENTRY
	 JRST ACJCH1		;NO SPECIAL CODE TO DECEIDE
	HRRZ T1,(T2)		;GET ADDR OF ROUTINE
	CALL (T1)		;LET IT DECEIDE
	 CAIA			;IF SPECIAL CODE SAID NO, TRY SOME OTHER FILTER
	RETSKP			;IT SAID ALLOW
		

;HERE IF NO SPECIAL ROUTINE TO DECEIDE TO ALLOW ACCESS

ACJCH1:	RET			;OTHER TESTS SAY NO, TOO
;ROUTINE TO SEARCH A FNC TABLE AND FIND A FUNCTION CODE MATCH

;CALL TSEARCH
;	(T2) ADDR OF TABLE
;	(T3) LENGTH OF TABLE
;RETURNS
;	+1	NO ENTRY FOUND OR 0 LENGTH TABLE PASSED
;	+2	ENTRY FOUND
;	(T2) POINTER TO ENTRY
TSEARC:	MOVNS T3		;CREATE POINTER TO TABLE
	JUMPE T3,R		;IF TABLE EMPTY, THEN ILLEGAL REQUEST
	HRL T2,T3		;SET UP AOBJN COUNTER
TSEAR1:	HLRZ T3,(T2)		;GET THE FUNCTION CODE
	CAMN T3,T1		;FOUND A MATCH?
	RETSKP			;YES, GO EXECUTE IT
	AOBJN T2,TSEAR1		;LOOK THRU THE WHOLE TABLE
	RET			;NOT FOUND IN THAT ONE
;ROUTINE TO CONVERT A SIXBIT WORD TO ASCII
;ACCEPTS IN T1/	STRING POINTER OR JFN FOR ASCII ANSWER
;	    T2/	SIXBIT WORD
;	CALL SIXTO7
;RETURNS +1:	T1/	UPDATED STRING POINTER

SIXTO7:	MOVE T4,T2		;SAVE SIXBIT WORD
	MOVE T3,[POINT 6,T4]	;GET POINTER TO SIXBIT WORD
SIX271:	ILDB T2,T3		;GET NEXT CHAR
	JUMPE T2,SIX272		;0 MEANS DONE
	ADDI T2,40		;CONVERT TO ASCII
	BOUT			;OUTPUT IT
	TLNE T3,770000		;DONE?
	JRST SIX271		;NO, LOOP BACK FOR OTHER CHARS
SIX272:	MOVE T3,T1		;GET A COPY OF STRING POINTER
	MOVEI T2,0		;PUT NULL AT THE END
	TLNE T1,-1		;IS THIS A JFN?
	IDPB T2,T3		;NO, THEN PUT NULL AT THE END
	RET			;DONE
;INITIALIZATION ROUTINES

;ROUTINE TO SET THE CAPABILITIES
;	CALL SETCAP
;RETURNS +1:	WHEEL OR OPERATOR REQUIRED
;	 +2:	SUCCESSFUL

SETCAP:	MOVEI T1,.FHSLF		;SET THIS FORK'S CAPABILITIES
	RPCAP			;READ THEM FIRST
	TRNN T2,SC%WHL!SC%OPR	;MUST BE ABLE TO SET WHEEL OR OPERATOR
	RET			;FAIL
	MOVE T3,T2		;ENABLE ALL CAPABILITIES
	EPCAP			;ENABLE CAPABILITIES
	 ERJMP R
	RETSKP			;DONE

;ROUTINE INIT THE LOG FILE

INILOG:	MOVSI T1,(GJ%SHT)	;GET A JFN ON THE LOG FILE
	HRROI T2,[ASCIZ/SYSTEM:ACCESS-CONTROL.LOG/]
	GTJFN
	 JRST [	WARN <COULD NOT INITIALIZE SYSTEM:ACCESS-CONTROL.LOG >
		RET]
	MOVEM T1,LOGJFN		;SAVE THE JFN
	RETSKP			;DONE


;ROUTINE TO INITIALIZE THE PI SYSTEM

INIPI:	MOVEI T1,.FHSLF		;INIT LEVTAB AND CHNTAB
	MOVE T2,[LEVTAB,,CHNTAB]
	SIR
	MOVEI T1,.FHSLF		;TURN ON DESIRED CHANNELS
	MOVE T2,ONCHNS		;ALL PANIC CHANNELS + CONTROL-C
	AIC
	MOVEI T1,.FHSLF		;ENABLE INTERRUPT SYSTEM
	EIR
	MOVE T1,[400000,,-5]	;READ INTERRUPT MASK
	RTIW
	MOVEM T2,INTMSK		;SAVE MASK
	MOVEM T3,DEFMSK		;AND DEFFERED MASK
	MOVE T1,[400000,,-5]	;SET NEW MASK
	MOVSI T2,(1B3)		;ONLY CONTROL-C
	SETZ T3,
	STIW
	 ERJMP [ ERRMES (<COULD NOT DISABLE CONTROL-C>)]
	MOVE T1,[3,,0]		;ENABLE FOR CONTROL-C
	ATI
	 ERJMP [ ERRMES (<COULD NOT ENABLE CONTROL-C TRAPPING>)]
	SETOM PIFLG		;MARK THAT PI IS ENABLED
	RET			;DONE
;ROUTINE TO ENABLE ACCESS CONTROL FUNCTIONS

ENAFNC:	MOVSI T4,-ENATLN	;SET UP TO SCAN TABLE OF FUNCTIONS
	JUMPE T4,R		;IF NONE, THEN DONE
ENAFN1:	MOVEI T1,.SFSOK		;SET ACCESS FUNCTION
	MOVE T2,ENATAB(T4)	;GET FUNCTION TO SET UP
	SMON			;ENABLE IT
	 ERCAL WRN
	AOBJN T4,ENAFN1		;LOOP BACK FOR ALL FUNCTIONS
	RET			;DONE


;ROUTINE TO INITIALIZE THE COMMAND TABLES FOR LOG AN ACCESS DECISION

INICMD:	RET			;FOR NOW
;ERROR ROUTINES

;ROUTINES FOR EXITING OUT OF ACCESS CONTROL JOB
;	THESE ROUTINES TURN OFF THE ACCESS CONTROL FUNCTIONS

PANIC:	WARN <PANIC CHANNEL INTERRUPT OCCURRED >
CNTRLC:
DIE:	HRROI T1,[ASCIZ/
% ACCESS CONTROL JOB: ACCESS CONTROL TERMINATED
/]
	PSOUT
	CALL DISFNC		;DISABLE ALL ACCESS CONTROL FUNCTIONS
	CALL DISPI		;DISABLE PI SYSTEM
	HALTF			;STOP
	JRST START		;CONTINUE


;ROUTINE TO DISABLE ACCESS CONTROL FUNCTIONS

DISFNC:	MOVSI T4,-ENATLN	;SET UP POINTER TO TABLE
	JUMPE T4,R		;IF NONE, THEN DONE
DISFN1:	MOVEI T1,.SFSOK		;GET SMON FUNCTION CODE
	MOVE T2,ENATAB(T4)	;GET ACCESS CONTROL FUNCTION
	TLZ T2,(SF%EOK)		;DISABLE
	SMON			;ALLOW EACH FUNCTION TO WORK
	 ERJMP .+1		;IGNORE ERRORS
	AOBJN T4,DISFN1		;LOOP BACK FOR ALL FUNCTIONS
	RET			;DONE


;ROUTINE TO DISABLE THE PI SYSTEM

DISPI:	SKIPN PIFLG		;WAS IT ENABLED?
	RET			;NO, THEN DONE
	MOVEI T1,.FHSLF		;DISABLE THE PI SYSTEM
	DIR
	MOVE T1,[400000,,-5]	;RESTORE INTERRUPT MASKS
	MOVE T2,INTMSK		;INTERRUPT MASK
	MOVE T3,DEFMSK		;DEFFERRED MASK
	STIW
	 ERJMP .+1
	MOVEI T1,.FHSLF		;DISABLE ALL CHANNELS
	MOVEI T2,0
	AIC
	RET			;DONE
;ROUTINE TO TYPE OUT WARNING MESSAGES ON TTY
;ACCEPTS IN T1/	STRING POINTER OR 0
;	CALL WRNMES
;RETURNS +1:	ALWAYS

WRN:	SETZ T1,		;NO SPECIAL MESSAGE 
WRNMES:	HRRZ T2,0(P)		;GET THE ADR OF THE CALLER
	SUBI T2,1		;BACK THE PC UP TO THE CALL ADR
	ASUBR <WRNMSP,WRNMSA>
	HRROI T1,[ASCIZ/
% ACCESS CONTROL JOB (PC = /]
	PSOUT
	MOVEI T1,.PRIOU		;OUTPUT THE PC
	MOVE T2,WRNMSA		;GET THE ADR OF THE CALLER
	MOVEI T3,10
	NOUT			;TYPE OUT PC
	 JFCL
	HRROI T1,[ASCIZ/): /]
	PSOUT
	SKIPE T1,WRNMSP		;ANY SPECIAL MESSAGE
	PSOUT			;YES, OUTPUT IT
	HRROI T1,[ASCIZ/ - /]
	SKIPE WRNMSP		;ANY MESSAGE?
	PSOUT			;YES, LEAVE A SPACE
	MOVEI T1,.PRIOU		;GET TTY JFN
	HRLOI T2,.FHSLF		;TYPE OUT LAST ERROR
	SETZ T3,
	ERSTR
	 JFCL
	 JFCL
	HRROI T1,[ASCIZ/
/]
	PSOUT
	RET			;DONE
;CONSTANTS AND VARIABLES

LEVTAB:	LEV1PC
	LEV2PC
	LEV3PC

CHNTAB:	1,,CNTRLC		;0 - CONTROL-C INTERRUPT
	BLOCK ^D8		;1 - 8
	1,,PANIC		;9
	0			;10
	1,,PANIC		;11
	1,,PANIC		;12
	BLOCK 2			;13 - 14
	1,,PANIC		;15
	1,,PANIC		;16
	1,,PANIC		;17
	BLOCK 2			;18 - 19
	1,,PANIC		;20
	BLOCK ^D15		;21 - 35

ONCHNS:	1B0!1B9!1B11!1B12!1B15!1B16!1B17!1B20
;BUILD THE DISPATCH TABLES

DEFINE BLDTAB <
	FNC (GOASD,SF%EOK,SF%DOK) ;ASSIGN A DEVICE
	FNC (GOCAP,SF%EOK,SF%DOK) ;ENABLE CAPABILITIES
	FNC (GOLOG,SF%EOK,SF%DOK) ;LOGIN
	FNC (GOLGO,SF%EOK,SF%DOK) ;LOGOUT 
	FNC (GOCRD,SF%EOK,SF%DOK) ;CREATE DIRECTORY
	FNC (GOSMT,SF%EOK,SF%DOK) ;STRUCTURE MOUNT
	FNC (GOMDD,SF%EOK,SF%DOK) ;ENTER MDDT
	FNC (GOCJB,SF%EOK,SF%DOK) ;CRJOB
	FNC (GOCFK,SF%EOK,SF%DOK) ;CFORK
	FNC (GOTBR,SF%EOK,SF%DOK) ;SET TERMINAL BAUD RATE
	FNC (GOENQ,SF%EOK)	  ;CHANGE ENQ QUOTA
	FNC (GOCLS,SF%EOK,SF%DOK) ;SET SCHEDULER CLASS
	FNC (GOCL0,SF%EOK,SF%DOK) ;SET CLASS AT LOGIN
	FNC (GOMTA,SF%EOK,SF%DOK) ;ACCESS AN MT:
	FNC (GOACC,SF%EOK)	  ;ACCESS OR CONNECT TO DIR
	FNC (GOOAD,SF%EOK,SF%DOK) ;ASSIGN DUE TO OPENF
	FNC (GODNA,SF%EOK,SF%DOK) ;ACCESS TO DECNET
	FNC (GOANA,SF%EOK,SF%DOK) ;ACCESS TO ARPANET
>

DEFINE FNC (FC,ENA,DEF) <
	IFE <SF%EOK-ENA>,<XWD .'FC,FC>>

DSPTAB:	BLDTAB
	DSPTLN==.-DSPTAB
DEFINE FNC (FC,ENA,DEF) <
	IFNB <DEF>,<<ENA>!<DEF>! .'FC>
	IFB <DEF>,<<ENA>! .'FC>>

ENATAB:	BLDTAB
	SF%EOK!400000		;ENABLE FOR USER MODE GETOK'S
	SF%EOK!400001
	SF%EOK!400001
	SF%EOK!400003
	SF%EOK!400004
	SF%EOK!400005
	SF%EOK!400006
	SF%EOK!400007
	ENATLN==.-ENATAB

USRDSP:
	XWD 400000,USRRQ0
	XWD 400001,USRRQ1
	XWD 400002,USRRQ2
	XWD 400003,USRRQ3
	XWD 400004,USRRQ4
	XWD 400005,USRRQ5
	XWD 400006,USRRQ6
	XWD 400007,USRRQ7
USRDLN==.-USRDSP
;BUILD TABLES FOR SPECIAL TEST CODE

DEFINE BLDTAB <
	FNC (GOASD,STASD)	;ASSIGN SPECIAL DEVICE
	FNC (GOCAP,STCAP)	;SET CAPS
	FNC (GOCJB,STCJB)	;CRJOB
	FNC (GOTBR,STTBR)	;TER BAUD RATE
	FNC (GOCFK,STCFK)	;CR FORK
	FNC (GOENQ,STENQ)	;SET ENQ QUOTA
	FNC (GOLOG,STLOG)	;LOGIN
	FNC (GOLGO,STLGO)	;LOGOUT
	FNC (GOCRD,STCRD)	;CREATE
	FNC (GOSMT,STSMT)	;STRUCTURE MOUNT
	FNC (GOMDD,STMDD)	;ENTER MDDT
	FNC (GOCLS,STCLS)	;CLASS SCHEDULER CHANGE
	FNC (GOCL0,STCL0)	;LOGIN SET CLASS
	FNC (GOMTA,STMTA)	;MAG TAPE ACCESS
	FNC (GOACC,STACC)	;ACCESS OR CONNECT
	FNC (GOOAD,STOAD)	;ASSIGN/OPENF
	FNC (GODNA,STDNA)	;DECNET ACCESS
	FNC (GOANA,STANA)	;ARPANET ACCESS
>

DEFINE FNC (CODE,ROUTIN) <
	XWD .'CODE,ROUTIN
>
STCTAB:	BLDTAB
STCLEN=.-STCTAB
DEFINE BLDTAB <
	FNC (USCD0,STUSR0)	;USER FUNCTION 0
	FNC (USCD1,STUSR1)	;USER FUNCTION 1
	FNC (USCD2,STUSR2)	;USER FUNCTION 2
	FNC (USCD3,STUSR3)	;USER FUNCTION 3
	FNC (USCD4,STUSR4)	;USER FUNCTION 4
	FNC (USCD5,STUSR5)	;USER FUNCTION 5
	FNC (USCD6,STUSR6)	;USER FUNCTION 6
	FNC (USCD7,STUSR7)	;USER FUNCTION 7
>
.USCD0==400000			;CODE FOR USER FUNCTION 0
.USCD1==400001			;CODE FOR USER FUNCTION 1
.USCD2==400002			;CODE FOR USER FUNCTION 2
.USCD3==400003			;CODE FOR USER FUNCTION 3
.USCD4==400004			;CODE FOR USER FUNCTION 4
.USCD5==400005			;CODE FOR USER FUNCTION 5
.USCD6==400006			;CODE FOR USER FUNCTION 6
.USCD7==400007			;CODE FOR USER FUNCTION 7

USTCTB:	BLDTAB
USTCLN=.-USTCTB
;VARIABLES

VARBEG==.			;START OF THE VARIABLE AREA

LOGJFN:	0			;LOG FILE JFN
INTMSK:	0			;INTERRUPT MASK
DEFMSK:	0			;DEFFERRED INTERRUPT MASK
LEV1PC:	0
LEV2PC:	0
LEV3PC:	0
PIFLG:	0			;0 = PI NOT ON, -1 = PI ON

	ARGLEN==100
ARGBLK:	BLOCK ARGLEN		;BLOCK TO HOLD RCVOK REQUEST

STRING:	BLOCK 100		;TEMP STRING

	PDLEN==200
PDL:	BLOCK PDLEN		;PUSH DOWN LIST

	JILEN==20
JIBLK:	BLOCK JILEN		;GETJI BLOCK

VAREND==.			;END OF THE VARIABLE AREA

	END <3,,ENTVEC>