;++
; Facility:
;	POKE:	Program to modify the privileges of another process.
;
; Abstract:
;	This facility will modifiy the privileges of a process from
;	another process(preferrably a system operator).  CMKRNL privilege 
;	is required to execute the program. It is invoked by the DCL 
;	command POKE (see POKE.CLD), e.g.
;
;		$ POKE/ID=3004F/PRIVILEGES=(OPER,NOACNT,PRMMBX)
;		$ POKE/ID=120034/NOPRIVILEGES	!Take all
;		$ POKE/ID=20075/PRIVILEGES=ALL	!Give all
;
;	Each privilege listed must have at least 4 characters.
;
; Written by:
;	Clair Garman and Amy Becker
;	Educational Services
;	Digital Equipment Company
;	Washington, DC
;	January 1983
;
;--
	$IPLDEF
	$ACBDEF
	$DYNDEF
	$CLIMSGDEF
	$PHDDEF
	$PRIDEF
	$PCBDEF
;
	.TITLE	POKE
;
	.PSECT	DATA	PIC,NOEXE,LONG,NOSHR,WRT
;
	$DSCDEF
ID_DESC:	.ASCID	/ID/
PRIV_DESC:	.ASCID	/PRIVILEGES/
LINE_DESC:	.ASCID	/$LINE/
IDBUF:		.WORD
		.BYTE	DSC$K_DTYPE_T
		.BYTE	DSC$K_CLASS_D
		.LONG
LINEBUF:	.WORD
		.BYTE	DSC$K_DTYPE_T
		.BYTE	DSC$K_CLASS_D
		.LONG
ID:		.LONG
ALL:		.ASCII	/ALL/
PRIV_LIST:	.ASCII	/CMKR/
		.ASCII	/CMEX/
		.ASCII	/SYSN/
		.ASCII	/GRPN/
		.ASCII	/ALLS/
		.ASCII	/DETA/
		.ASCII	/DIAG/
		.ASCII	/LOG_/
		.ASCII	/GROU/
		.ASCII	/ACNT/
		.ASCII	/PRMC/
		.ASCII	/PRMM/
		.ASCII	/PSWA/
		.ASCII	/ALTP/
		.ASCII	/SETP/
		.ASCII	/TMPM/
		.ASCII	/WORL/
		.ASCII	/MOUN/
		.ASCII	/OPER/
		.ASCII	/EXQU/
		.ASCII	/NETM/
		.ASCII	/VOLP/
		.ASCII	/PHY_/
		.ASCII	/BUGC/
		.ASCII	/PRMG/
		.ASCII	/SYSG/
		.ASCII	/PFNM/
		.ASCII	/SHME/
		.ASCII	/SYSP/
		.ASCII	/BYPA/
		.ASCII	/SYSL/
PRIV_LIST_SIZE  =  . - PRIV_LIST
LOCK_RANGE:	.ADDRESS	LOCK_BEGIN
		.ADDRESS	LOCK_END
;++
;
; This is a special kernel AST that will execute in the context of the 
; target process whose privilege is being changed.  This AST will set 
; and/or clear the privilege bits in the several process privilege masks 
; for the target process.
;
;	Inputs:	R0:R3	Scratch
;		R4	PCB address of target process
;		R5	Address of ACB
;
;--
KERNEL_AST:
	DSBINT	#IPL$_SYNCH			;Synch to NP pool
;
	TSTL	GIVE_PRIV			;Giving any privs?,test first L
	BNEQ	10$				;If bits set, giving privs
	TSTL	GIVE_PRIV+4			;Test second longword
	BEQL	TAKE_CHECK			;If EQL, no privs to be given
;++
; Set the privilege bits in the several privilege masks
;--
10$:	BISL2	GIVE_PRIV,G^CTL$GQ_PROCPRIV	;Set bits in P1 pointer page
	BISL2	GIVE_PRIV+4,G^CTL$GQ_PROCPRIV+4
	MOVL	G^CTL$GL_PHD,R0			;P1 addr of process header
	BISL2	GIVE_PRIV,PHD$Q_PRIVMSK(R0)	;Set bits in process header
	BISL2	GIVE_PRIV+4,PHD$Q_PRIVMSK+4(R0)
	BISL2	GIVE_PRIV,PHD$Q_AUTHPRIV(R0)
	BISL2	GIVE_PRIV+4,PHD$Q_AUTHPRIV+4(R0)
	BISL2	GIVE_PRIV,PHD$Q_IMAGPRIV(R0)
	BISL2	GIVE_PRIV+4,PHD$Q_IMAGPRIV+4(R0)
	BISL2	GIVE_PRIV,PCB$Q_PRIV(R4)	;Set bits in PCB
	BISL2	GIVE_PRIV+4,PCB$Q_PRIV+4(R4)
;
TAKE_CHECK:
	TSTL	TAKE_PRIV			;Taking any privs?,test first L
	BNEQ	10$				;If bits set, taking privs
	TSTL	TAKE_PRIV+4			;Test second longword
	BEQL	KAST_DONE			;If EQL, not taking privs
;++
; Clear the privilege bits in the several privilege masks
;--
10$:	BICL2	TAKE_PRIV,G^CTL$GQ_PROCPRIV	;Set bits in P1 pointer page
	BICL2	TAKE_PRIV+4,G^CTL$GQ_PROCPRIV+4
	MOVL	G^CTL$GL_PHD,R0			;P1 addr of process header
	BICL2	TAKE_PRIV,PHD$Q_PRIVMSK(R0)	;Set bits in process header
	BICL2	TAKE_PRIV+4,PHD$Q_PRIVMSK+4(R0)
	BICL2	TAKE_PRIV,PHD$Q_AUTHPRIV(R0)
	BICL2	TAKE_PRIV+4,PHD$Q_AUTHPRIV+4(R0)
	BICL2	TAKE_PRIV,PHD$Q_IMAGPRIV(R0)
	BICL2	TAKE_PRIV+4,PHD$Q_IMAGPRIV+4(R0)
	BICL2	TAKE_PRIV,PCB$Q_PRIV(R4)	;Set bits in PCB
	BICL2	TAKE_PRIV+4,PCB$Q_PRIV+4(R4)
;
; Deallocate the ACB from NP Pool
;
KAST_DONE:
	ENBINT					;Restore stored IPL (=2)
	MOVL	R5,R0				;ACB address
	JSB	G^EXE$DEANONPAGED
;
; Deallocate this AST code from NP Pool as we exit this code
;
	MOVAL	KERNEL_AST-12,R0		;Address of this code block
	JMP	G^EXE$DEANONPAGED
;
GIVE_PRIV:	.QUAD
TAKE_PRIV:	.QUAD
;
AST_SIZE	= . - KERNEL_AST
;
	.PSECT	CODE	PIC,EXE,LONG,SHR,NOWRT
;
POKE::	.WORD
;
; Determine the process ID of the process for which the privileges are 
; to be changed.
;
	PUSHAL	ID_DESC
	CALLS	#1,G^CLI$PRESENT
		CMPL	#CLI$_PRESENT,R0	;Was /ID= present?
		BEQL	10$			;If EQL, Yes
			PUSHL	R0		;Syntax error - no /ID=
			CALLS	#1,G^LIB$STOP
10$:	PUSHAL	IDBUF
	PUSHAL	ID_DESC
	CALLS	#2,G^CLI$GET_VALUE		;Get value of /ID=
		BLBS	R0,.+10
			PUSHL	R0
			CALLS	#1,G^LIB$STOP
	PUSHAL	ID
	PUSHL	IDBUF+4
	MOVZWL	IDBUF,-(SP)
	CALLS	#3,G^LIB$CVT_HTB		;Convert ID from text to binary
		BLBS	R0,.+10
			PUSHL	R0
			CALLS	#1,G^LIB$STOP
;
; Determine the list of privileges to be changed
;
	PUSHAL	PRIV_DESC
	CALLS	#1,G^CLI$PRESENT
		CMPL	#CLI$_PRESENT,R0	;Was /PRIV= present?
		BEQL	20$			;If EQL, Yes
			CMPL	#CLI$_NEGATED,R0;Was it /NOPRIV?
			BNEQ	15$		;If NEQ, No
			MNEGL	#1,TAKE_PRIV	;Set all bits in TAKE_PRIV
			MNEGL	#1,TAKE_PRIV+4
			BRW	MASK_FORMED
15$:		PUSHL	R0			;Syntax error - no /PRIV
		CALLS	#1,G^LIB$STOP
20$:	PUSHAL	LINEBUF
	PUSHAL	LINE_DESC
	CALLS	#2,G^CLI$GET_VALUE		;Entire command line
;
; If /PRIV=ALL, set all the bits in the privilege mask GIVE_PRIV
;
	MATCHC	#3,ALL,LINEBUF,@LINEBUF+4	;/PRIV=ALL?
	BNEQ	30$				;If NEQ, No
	MATCHC	#1,PRIV_LIST+10,#1,(R3)		;Check for ALLS(Allspool)
	BEQL	30$				;If EQL, not ALL
		MNEGL	#1,GIVE_PRIV		;Set all bits in GIVE_PRIV
		MNEGL	#1,GIVE_PRIV+4
		BRB	MASK_FORMED
;++
;
; Based upon the privilege list in the DCL command, set the bits in the
; two privilege masks: GIVE_PRIV and TAKE_PRIV.
;
; Register usage:	R6->PRIV_LIST pointer
;			R7->Bit number in the privilege mask
;
; The order of privileges in PRIV_LIST is of increasing bit numbers in
; a process privilege mask.
;
;--
30$:	MOVAL	PRIV_LIST,R6
	CLRL	R7
PRIV_CHECK:
	MATCHC	#4,(R6),LINEBUF,@LINEBUF+4	;Was that priv in /PRIV list?
	BNEQ	NEXT_PRIV			;If NEQ, no
		CMPW	#^A/NO/,-6(R3)		;R3 - one char after obj string
		BEQL	10$			;If EQL, /PRIV=NOxxxx
	INSV	#1,R7,#1,GIVE_PRIV		;Set bit in Give mask
	BRB	NEXT_PRIV
10$:	INSV	#1,R7,#1,TAKE_PRIV		;Set bit in Take mask
NEXT_PRIV:
	TSTL	(R6)+				;To next priv in PRIV_LIST
	INCL	R7				;To next bit in priv mask
	CMPL	#PRIV_LIST_SIZE/4,R7		;Is PRIV_LIST finished?
	BGEQ	PRIV_CHECK			;If GEQ, No
;
MASK_FORMED:
	$CMKRNL_S	ROUTIN=KRNL_CODE
;
	RET					;Exit main routine
;++
;
; $CMKRNL code - execute in kernel mode to:
;	1. load a special kernel AST into NP Pool
;	2. queue an ACB to the target process to execute that AST
;
;--
KRNL_CODE:	.WORD	^M<R2,R9>
;
	$LKWSET_S	LOCK_RANGE
		BLBS	R0,.+10
			PUSHL	R0
			CALLS	#1,G^LIB$STOP
LOCK_BEGIN:
	DSBINT	#IPL$_SYNCH			;Synch to NP Pool
;
; Validate the process ID given as a qualifier
;
	MOVL	SCH$GL_CURPCB,R11		;Get current PCB address
	MOVL	PCB$L_PID(R11),R11		;Get current PID number
	CMPL	ID,R11				;Is Pid of parent process
	BNEQ	10$				;No, continue
	BRW	NCP_PID				;Yes, put out error message
10$:	MOVZWL	ID,R9				;Process array number
	BNEQ	20$				;If NEQ, continue
	BRW	NCP_PID 			;Yes, null proc, put error msg
20$:	CMPW	#1,R9				;Compare to swapper
	BNEQ	25$				;If NEQ, continue
	BRW	NCP_PID				;Yes, put out error message
25$:	CMPW	R9,G^SGN$GW_MAXPRCCT		;Same as MAXPRCCNT?
	BLEQ	30$				;Less than, continue
	BRW	MAX_PID 			;Else, put out error message
30$:	MOVL	@SCH$GL_PCBVEC[R9],R10		;PCB address of target
	CMPL	R10,#SCH$GL_NULLPCB	        ;Same as NULL process?
	BEQL	NSP_PID          		;If EQL, yes, put out error msg
	CMPW	@SCH$GL_SEQVEC[R9],ID+2 	;Do seq numbers match?
	BEQL	40$				;If EQL, contintue
	BRW	SEQ_PID 		        ;No, put out error message
;
; Allocate NP Pool buffer and load special kernel AST
;
40$:	MOVL	#AST_SIZE+12,R1			;12 byte header
	JSB	G^EXE$ALONONPAGED
		BLBC	R0,NO_NP_POOL		;Br if insuff NP pool
	MOVW	R1,8(R2)			;Size of buffer into buffer
	MOVL	R2,R9				;Address of NP buffer
	MOVC3	#AST_SIZE,KERNEL_AST,12(R9)	;Move code into NP pool
;
; Allocate NP Pool for ACB and queue ACB to target process
;
	MOVL	#ACB$K_LENGTH,R1		;Size of ACB
	JSB	G^EXE$ALONONPAGED
		BLBC	R0,NO_NP_POOL		;Br if insuff NP Pool
	MOVL	ID,ACB$L_PID(R2)		;PID of target process
	MOVW	R1,ACB$W_SIZE(R2)		;Size of NP Pool buffer
	MOVB	#DYN$C_ACB,ACB$B_TYPE(R2)	;Type of data block
	INSV	#1,#ACB$V_KAST,#1,ACB$B_RMOD(R2) ;Mark as SKAST
	MOVAL	12(R9),ACB$L_KAST(R2)		;Addr of NP SKAST code
;
	ENBINT					;Restore IPL 0
	MOVL	R2,R5				;ACB addr for SCH$QAST
	MOVL	#PRI$_TICOM,R2			;Max pri boost 
	JSB	G^SCH$QAST
;
	MOVL	#SS$_NORMAL,R0			;Exit kernel code
	RET
;
; Error routines for kernel code
;
NO_NP_POOL:
	ENBINT
	MOVL	#SS$_INSFMEM,R0
	RET
NSP_PID:
	ENBINT
	MOVL	#POK_NOSUCHPROC,R0
	RET
NCP_PID:
	ENBINT
	MOVL	#POK_NOTCAPABLE,R0
	RET
MAX_PID:
	ENBINT
	MOVL	#POK_EXCMAXCNT,R0
	RET
SEQ_PID:
	ENBINT
	MOVL	#POK_INVSEQNUM,R0
	RET
;
LOCK_END:
	.END	POKE