	.title	k11lcl	do things for site specific stuff
	.ident	/1.2.01/

	.include	/IN:K11MAC.MAC/

	.psect	$code


;	18-Jan-84  11:27:39  Brian Nelson
;	22-Mar-84  15:46:51  BDN rewrite for tkb/onlpat patching


	.sbttl	okuser


;	input:	2(sp)	address of an  .asciz string  containing  the first
;			three (3) characters of the current command name.
;	output:	nothing
;
;	You have the option (see K11CDF.MAC for the $NAME macro) of  either
;	doing a  MOV (SP)+,@SP   and a RETURN (accepting the command) or of
;	doing a  CMP (SP)+,(SP)+ and a RETURN (rejecting the command).
;





okuser::mov	2(sp)	,r0
	mov	#clist	,r2		; point to the protection byte

10$:	tstb	1(r2)			; if the text is null, we are done
	beq	100$			; bye
	tstb	@r2			; if the protection byte is null,
	beq	50$			; then skip this entry
	cmpb	1(r2)	,@r0		; check for a match on this entry
	bne	50$			; no match
	cmpb	2(r2)	,1(r0)		; check byte number 2
	bne	50$			; no match
	cmpb	3(r2)	,2(r0)		; check byte number 2
	bne	50$			; no match

	call	getuic			; get the ppn
	tst	...uic			; check based on the group number?
	beq	20$			; no
	swab	r0			; yes, get group number over please
	cmpb	r0	,...uic+0	; check it out now
	blos	30$			; it's ok
	br	90$			; it's not, exit with error
	

20$:	tst	...uic+2		; no, try checks based on programmer #
	beq	30$			; no checks exit with success
	cmpb	r0	,...uic+2	; check based on this now
	blos	30$			; it's ok, exit
	br	90$			; it's not ok, exit

30$:	call	getuic			; last check is to see if the command
	swab	r0			; itself is restricted based on group #
	cmpb	r0	,@r2		; by checking the protection byte for a
	bhi	90$			; group number match. if >, then error
	br	100$			; it's ok, exit

50$:	add	#4	,r2		; point to the next table entry
	br	10$			; next please


90$:	print	#rs			; a match, disallow the command
	cmp	(sp)+	,(sp)+
	return
100$:	mov	(sp)+	,@sp
	return


	.save
	.psect	$PDATA	,D
rs:	.asciz	/Access not allowed to this command/<cr><lf>
	.even
	.restore

	global	<getuic>



	.sbttl	the list of commands to check
	.psect	$pdata


;	To enable checks, patch the first byte from 0 to 377.
;	For example,  to make the DIR command unavailable to
;	non-priv users, patch ..$DIR byte offset 0 from 0 to
;	377 octal.
;	Also, please note that the first check will be based
;	on project (group) number as a check lower or same.
;	 If ...uic+0 = 0 then that check is skipped in favor
;	of  checking the programmer  number in ...uic+2.  If
;	that is zero, then no checking will be done.
;
;
;	As in:
;
;
;	procedure check_commands
;
;	  i := 0 ;
;	  found_a_match := false ;
;	  while ( clist[i][1] <> 0 ) and not found_a_match
;	   do
;		begin
;		  if clist[i][0] <> 0
;		   then
;		     found_a_match :=    cmd_name[0] = clist[i][1]
;				     and cmd_name[1] = clist[i][2]
;				     and cmd_name[2] = clist[i][3] ;
;		  i := succ(i) ;
;		end ;
;	  bad_command := false ;
;	  if found_a_match
;	    then
;		if (...uic <> 0 ) and ( group_number > ...uic )
;	  	  then bad_command := true
;	    else
;	   	if (...uic+2 <> 0 ) and ( programmer_number > ...uic+2 )
;	  	  then bad_command := true ;
;	  if not bad_command
;	    then
;		if ( group_number > clist[i][0]
;		  then bad_command := true
;
;	end ;
;		       
;

...uic::.word	0			; no checks on group number
	.word	0			; no checks on user number

clist:
..$bye::.ascii	<000>/BYE/		; BYE         
..$com::.ascii	<000>/COM/		; COMMENT     
..$con::.ascii	<000>/CON/		; CONNECT     
..$cop::.ascii	<000>/COP/		; COPY        
..$del::.ascii	<000>/DEL/		; DELETE      
..$dir::.ascii	<000>/DIR/		; DIRECT      
..$dis::.ascii	<000>/DIS/		; DISCONNECT  
..$era::.ascii	<000>/ERA/		; ERASE       
..$exi::.ascii	<000>/EXI/		; EXIT        
..$fin::.ascii	<000>/FIN/		; FINISH      
..$get::.ascii	<000>/GET/		; GET         
..$han::.ascii	<000>/HAN/		; HANGUP      
..$hel::.ascii	<000>/HEL/		; HELP        
..$loc::.ascii	<000>/LOC/		; LOCAL       
..$log::.ascii	<000>/LOG/		; LOGOUT      
..$not::.ascii	<000>/NOT/		; NOTE        
..$qui::.ascii	<000>/QUI/		; QUIT        
..$rec::.ascii	<000>/REC/		; RECEIVE     
..$rem::.ascii	<000>/REM/		; REMOTE      
..$ren::.ascii	<000>/REN/		; RENAME      
..$rdi::.ascii	<000>/RDI/		; REMOTE DIR
..$sen::.ascii	<000>/SEN/		; SEND        
..$ser::.ascii	<000>/SER/		; SERVER      
..$set::.ascii	<000>/SET/		; SET         
..$sho::.ascii	<000>/SHO/		; SHOW        
..$spa::.ascii	<000>/SPA/		; SPACE       
..$sys::.ascii	<000>/SYS/		; SYSTEM      
..$tak::.ascii	<000>/TAK/		; TAKE        
..$tra::.ascii	<000>/TRA/		; TRANSMIT    
..$typ::.ascii	<000>/TYP/		; TYPE        
..$who::.ascii	<000>/WHO/		; WHO         
	.byte	0,0,0,0
	.even

	.sbttl	using onlpat for RSTS/E to patch this


	.if ne	,0
	.ift


!	RSTS/E Kermit optional patches
!
!	Brian Nelson  30-Mar-84  09:47:07
!
!
!	 Example of patching RSTS/E Kermit to disable commands based
!	on user programmer  number.  The  effect  of  the  following
!	patches  is  to  disallow  any user with a programmer number
!	greater than  127  (ie,  100,221)  to  access  the  commands
!	DELETE  ,DIRECTORY,  ERASE  and RENAME. If you would like to
!	do this based  on  project  number  instead  you  can  patch
!	either  ...UIC+0  to  be  the  high  cutoff point instead of
!	patching ...UIC+2, or you can use different project  numbers
!	for  each  command by changing the '377' (which is in octal)
!	to the desired cutoff point. To restict access  to  the  DIR
!	command  to  users  with  a project (group) number less than
!	(10,*), you would patch ..$DIR byte offset zero  from  0  to
!	10.  (the  '.'  is  needed  to force ONLPAT to use a decimal
!	interpretation of the number. 
!
!	 At this  time the only other thing you may want to patch is
!	location ..DIRP offset  zero, which  is by  default 1.  This
!	value is checked  against  the user's project  number by the
!	DIRECTORY command.  If the user's project  number is greater
!	than  this number,  the ppn (uic) field  for the DIR command
!	is zeroed,  thus  preventing that  user from looking  at the
!	directory listing  of ANY other  account.  The default is to
!	restrict the use  of ppn's for this  command to  [1,*] users
!	only.  The last patch here changes that to include [2,*].
!
!
! Keep user's with programmer numbers > 127 from using DIR, DEL, REN and ERA.
!
!
File to patch? 
Base address? ...UIC+2
Offset address? 0
 Base	Offset  Old     New?
??????	000000	000000	? 127.
??????	000002	041000	? ^Z
Offset address? ^Z
Base address? ..$DEL
Offset address? -1
 Base	Offset  Old     New?
??????	177777	   120	? <LF>
??????	000000	   000	? 377
??????	000001	   104	? ^Z
Offset address? ^Z
Base address? ..$DIR
Offset address? -1
 Base	Offset  Old     New?
??????	177777	   114	? <LF>
??????	000000	   000	? 377
??????	000001	   104	? ^Z
Offset address? ^Z
Base address? ..$ERA
Offset address? -1
 Base	Offset  Old     New?
??????	177777	   123	? <LF>
??????	000000	   000	? 377
??????	000001	   105	? ^Z
Offset address? ^Z
Base address? ..$REN
Offset address? -1
 Base	Offset  Old     New?
??????	177777	   115	? <LF>
??????	000000	   000	? 377
??????	000001	   122	? ^Z
Offset address? ^Z
Base address? ..DIRP
Offset address? 0
 Base	Offset  Old     New?
??????	000000	000001	? 2
??????	000002	??????	? ^C


	.endc


	.sbttl	possibly throttle back non priv users speed

	.psect	$pdata

slowgr::.word	2			; cutoff for group numbers
slowdo::.word	0			; if <> 0, then slow xfers down
slowbd::.word	1200.
	.psect	$code			; resume r/o code section

throtl::save	<r0,r1>
	tst	slowdo			; really do this
	beq	100$			; no
	tst	pauset			; already a pause set ?
	bne	100$			; yes, skip this please
	call	getuic			; get the account number please
	swab	r0			; get group number in r0 please
	cmpb	r0	,slowgr		; ignore this user ?
	blos	100$			; yes
	calls	ttspeed	,<#ttname>	; get the current transfer rate
	tst	r0			; failure ?
	beq	100$			; skip this in that case
	cmp	r0	,slowbd		; slow this user down ?
	blos	100$			; no
	mov	r0	,r1		; yes, compute delay in seconds
	clr	r0			; based on baud/(cutoff*4). Thus
	div	slowbd	,r0		; for 4800 baud, the delay would be
	asr	r0			; 1 second, reducing the effective
	asr	r0			; rate to 2400 baud
	tst	r0			; anything left?
	bne	10$			; nothing ?
	inc	r0			; always compute something
10$:	mov	r0	,pauset		; and save it
100$:	unsave	<r1,r0>
	return

	global	<getuic	,ttname	,pauset>
	

	.end
