[comp.os.vms] Setting the UIC of Your Process From Inside

lars@ACC.ARPA (05/31/88)

Recently, Art Stine of Clarkson University posted a routine to
allow the process to change it's own UIC. Unfortunately, his 
routine does not do all that you would want it to do.
In order for the process to still have access to the JOB logical name
table, you need to change the owner of that critter as well.
The follwowing program which we use around here to allow people
to charge their files and CPU time to a project account, while
keeping their username intact, contains an improved routine to
set the UIC.
		/ Lars Poulsen
		  Advanced Computer Communications
		  Lars@ACC_SB-UNIX.ARPA
-----------------
	.TITLE	Charge
	.Ident	/4.03/
;    ________________________________________________________
;   /                                                         \
;   |          AAA          CCCCCCCCCCCCCC    CCCCCCCCCCCCCC   |
;   |         AAAAA        CCCCCCCCCCCCCCCC  CCCCCCCCCCCCCCCC  |
;   |        AAAAAAA       CCCCCCCCCCCCCCCCC CCCCCCCCCCCCCCCCC |
;   |       AAAA AAAA      CCCC              CCCC              |
;   |      AAAA   AAAA     CCCC              CCCC              |
;   |     AAAA     AAAA    CCCC              CCCC              |
;   |    AAAA       AAAA   CCCC              CCCC              |
;   |   AAAA  AAAAAAAAAAA  CCCCCCCCCCCCCCCCC CCCCCCCCCCCCCCCCC |
;   |  AAAA    AAAAAAAAAAA CCCCCCCCCCCCCCCC  CCCCCCCCCCCCCCCC  |
;   | AAAA      AAAAAAAAA   CCCCCCCCCCCCCC    CCCCCCCCCCCCCC   |
;    \________________________________________________________/
;
;	Copyright (c) 1983 Advanced Computer Communications, Inc
;	720 Santa Barbara Street, Santa Barbara, California  93101
;	(805) 963-8801
;
;	A license to copy and use (but not for profit) and to
;	modify for their own use (but not to re-distribute modified
;	versions) is hereby granted to all DECUS members and to
;	all users in the ARPAnet community.
;	If you make changes or improvements, please send a copy
;	of your enhanced version back to ACC.
;
;
; File:		CHARGE.MAR
;
; Author:	Lars Poulsen <Lars @ ACC.ARPA>
;
; Project:	General Utility Programs (6050)
;
; Function:	Change the accounting data for current VMS job
;
; Components:	This file only
;
; Revision History:
;	29-Jun-1983	Original version
;
;	1.03 - 21-Jul-1983	Lars Poulsen
;		Do not allow automatic UIC update when charging to
;		the default account, unless this is the user's own
;		account. (Before this, you could switch to annybody's
;		uic because you were authorized to the default account)
;
;	1.04 - 25-Jul-1983	Lars Poulsen
;		Allow shared update on SYSUAF and CHARGENUM
;
;	1.05 - 26-Aug-1983	Lars Poulsen
;		Fix bug the caused $OPEN CHARGENUM to always fail
;		(RMS-F-SHR).
;		Shortcircuit CHECK_AUTH for users with SETPRV.
;
;	4.00 - 03-Oct-1985	Lars Poulsen
;		Fix for use with VMS 4.x (UAF changes)
;	4.01 - 21-Oct-1985	Lars Poulsen
;		One more offset to symbolic form (missed last time)
;
;	4.02 - 23-Oct-1985	Lars Poulsen
;		Add re-making of JOB Logical Name Table from
;		Ken@CIT-HAMLET.ARPA
;	4.03 - 30-Oct-1985	Lars Poulsen
;		Back off 4.02 and replace with zapping Job LNM
;		ownership
;
; Assembly Command Line:
;		MACRO/LIST CHARGE
;
; Task Build Command Line:
;		LINK CHARGE+SYS$SYSTEM:SYS.STB/SELECT+SYSDEF.STB/SELECT
;
; Usage Notes:
;		Charge 1234	(ACC 4-digit project code)
;	or	Charge NAME	(Project name in SYSUAF)
;
; Application Notes:
;		See file CHARGE.HLP
;
; System Notes:
;		Must be INSTALLED with PRIV=(CMK,SYSPRV)
;

P1	=	4
P2	=	8
P3	=	12

	.LIBRARY	/SYS$LIBRARY:LIB.MLB/				;851003
									;851003
	$IPLDEF								;851030
	$LNMDEF								;851023
	$LNMSTRDEF							;851030
	$ORBDEF								;851030
	$PRVDEF								;851003
	$UAFDEF								;851003

ACC_STR:
	.WORD	12.,^X010E
	.LONG	NEW_ACNT

DEF_ACCNT: .ASCII	/6050    /	; Default value of account	;830721
									;830721
NEW_UIC: .LONG	0							;830721
NEW_ACNT: .ASCII	/            /		;			;830721
									;830721
RMS_FAB: $FAB 	FAC=GET, SHR=UPD					;V1.04

RMS_RAB: $RAB	FAB=RMS_FAB, UBF=RMS_BUF, USZ=2048.

RMS_BUF: .BLKB	2048.

GETJPI_LST:
	.WORD	12,JPI$_USERNAME
	.LONG	USER_NAME,0
	.WORD	8,JPI$_CURPRIV						;830826
	.LONG	PRIV_MASK,0						;830826
	.LONG	0
USER_NAME:
	.ASCII	/            /
PRIV_MASK:								;830826
	.BLKL	2							;830826
WARNING: .ASCID	"CHARGE-W-NOAUTH - " -					;830826
		"This code not authorized in CHARGENUM.DAT"		;830826
									;830826
PROMPT:	.ASCID	"Account code ?"
									;830721
UAF_NAME:								;830721
	.ASCII	"SYS$SYSTEM:SYSUAF.DAT"					;830721
UAF_FNS	= .-UAF_NAME							;830721
									;830721
CHG_NAME:
	.ASCII	"SYS$MANAGER:CHARGENUM.DAT"
CHG_FNS	= .-CHG_NAME

NAMEDESC:	.ASCID	/SYS$LOGIN/					;831030
TBLDESC:	.ASCID	/LNM$JOB/					;831030

	.ENTRY	CHARGE,0

	$GETJPI_S	,,,ITMLST=GETJPI_LST	; Get the name of user	;830721
	BLBS	R0,10$							;830721
	RET								;830721
									;870321
10$:	$PUSHADR PROMPT,CONTEXT=Q					;870321
	$PUSHADR ACC_STR,CONTEXT=Q
	CALLS	#2,G^LIB$GET_FOREIGN
	BLBS	R0,11$
	RET				; Exit to VMS

11$:	CMPL	NEW_ACNT+4,#^A/    /	; Is code 4 chars long ?
	BNEQ	102$

	MOVL	#4,R0			; 4 chars
	MOVB	#^A/0/,R1
	MOVB	#^A/9/,R2
	MOVL	#NEW_ACNT,R3
51$:
	CMPB	(R3),R1			; Compare to '0'
	BLSS	102$
	CMPB	(R3)+,R2		; Compare to '9'
	BGTR	102$
	SOBGTR	R0,51$
	BRW	104$

102$:	$PUSHADR NEW_UIC,CONTEXT=L
	$PUSHADR NEW_ACNT,CONTEXT=L
	$PUSHADR ACC_STR,CONTEXT=Q
	CALLS	#3,CHECK_USER
	BLBS	R0,104$
	RET				; Exit to VMS
;
;	NEW_ACNT contains new account code
;	Check that this user may use that code
;
104$:	CMPC3	#8,RMS_BUF+UAF$T_USERNAME, -				;851021
			USER_NAME	; Did he ask to be himself ?	;851021
	BEQL	5$			; If eql, yes - no problem	;851021
;
;	Charge <me> is always ok, others we need to look up in
;	Sys$manager:Chargenum.dat
;
	$PUSHADR NEW_ACNT,CONTEXT=L
	CALLS	#1,CHECK_AUTH
	BLBS	R0,5$
	BBC	#PRV$V_SETPRV,-						;830826
		 PRIV_MASK,70$						;830826
	$PUSHADR WARNING,CONTEXT=L					;830826
	CALLS	#1,G^LIB$PUT_OUTPUT					;830826
5$:
	PUSHL	NEW_UIC
	$PUSHADR NEW_ACNT,CONTEXT=L
	CALLS	#2,SET_ACNT
70$:	RET				; Exit to VMS			;830826

	.ENTRY	CHECK_USER,0
;
;	This routine searches the SYSUAF for a given username
;	and stores the ACNT and UIC of that username in the
;	two given locations.
;	If not found (or illegal default reference)
;	it will return SS$_NOSUCHUSER or SS$_NOPRIV
;
;	Idsw = CHECK_USER(%desc(Username),%ref(Acnt),%ref(Uic)
;	Acnt .eq. 8H12345678						;830721
;	Uic .eq. Group*(2**16) + Member					;830721
;									;830721
	$FAB_STORE FAB=RMS_FAB, FNA=UAF_NAME, FNS=#UAF_FNS		;830721
	$OPEN	FAB=RMS_FAB						;830721
	BLBC	R0,104$							;830721
	$CONNECT RAB=RMS_RAB						;830721
	BLBS	R0,105$							;830721
104$:	RET								;830721
;									;830721
;	Get next record from SYSUAF					;830721
;									;830721
105$:	$GET	RAB=RMS_RAB						;830721
	BLBC	R0,108$

	$PUSHADR @P1(AP)
	$PUSHADR THIS_USER
	CALLS	#2,G^STR$COMPARE
	TSTL	R0
	BNEQ	105$
;									;830721
;	We found the user that he asked for				;830721
;	If this is the default account (ACC: 6050) or blank,		;830721
;	then it must be the user's own in order to be valid		;830721
;									;830721
	CMPB	RMS_BUF+UAF$T_ACCOUNT,#^A/ /	; Blank account ?	;851003
	BEQL	106$				; If EQL, yes		;851003
	TSTB	RMS_BUF+UAF$T_ACCOUNT		; Zero account ?	;851003
	BEQL	106$				; If EQL, yes		;851003
	CMPC3	#8,RMS_BUF+UAF$T_ACCOUNT,DEF_ACCNT ; Default account ?	;851003
	BNEQ	107$				; If NEQ, no - so use it;851003
106$:	CMPC3	#8,RMS_BUF+UAF$T_USERNAME, -				;851003
			USER_NAME	; Did he ask to be himself ?	;851003
	BEQL	107$			; If eql, yes - no problem	;**-7
	$CLOSE	FAB=RMS_FAB						;830721
	MOVL	#SS$_NOPRIV,R0		; Privilege violation		;830721
	RET								;830721
									;830721
107$:	MOVQ	RMS_BUF+UAF$T_ACCOUNT,@P2(AP)	; Store new account	;851003
	MOVL	RMS_BUF+UAF$L_UIC,@P3(AP)	;  and UIC in process	;851003
	$CLOSE	FAB=RMS_FAB						;**-2
	MOVL	#SS$_NORMAL,R0
	RET

108$:	CMPL	R0,#RMS$_EOF
	BNEQ	110$
	MOVL	#SS$_NOSUCHUSER,R0
110$:	RET

THIS_USER:
	.WORD	12,^X010E
	.LONG	RMS_BUF+UAF$T_USERNAME					;851021

	.ENTRY	CHECK_AUTH,0
;
;	Acnt = 4H1234
;	Idsw = CHECK_AUTH(%ref(Acnt)
;
	$FAB_STORE FAB=RMS_FAB FNA=CHG_NAME, FNS=#CHG_FNS, FAC=<GET>,-	;830826
			SHR=<GET>					;830826
	$OPEN	FAB=RMS_FAB
	BLBC	R0,25$			; If no file, go ahead
	$CONNECT RAB=RMS_RAB
	BLBC	R0,25$			; If file destroyed, go ahead

	MOVL	#4,R0			; 4 chars
	MOVB	#^A/0/,R1
	MOVB	#^A/9/,R2
	MOVL	P1(AP),R3		; Point to Acnt
51$:
	CMPB	(R3),R1			; Compare to '0'
	BLSS	91$
	CMPB	(R3)+,R2		; Compare to '9'
	BGTR	91$
	SOBGTR	R0,51$

61$:
	MOVC5	#0,RMS_BUF,#^A/ /,#16,RMS_BUF
	$GET	RAB=RMS_RAB
	BLBC	R0,95$
	CMPL	RMS_BUF,@P1(AP)		; Right one ?
	BNEQ	61$
	CMPL	RMS_BUF+4,USER_NAME	; This user ?
	BNEQ	61$
	CMPL	RMS_BUF+8,USER_NAME+4
	BNEQ	61$
	$CLOSE	FAB=RMS_FAB

25$:	MOVL	#SS$_NORMAL,R0
	RET
;
;	Requested account ID is not numeric
;
91$:
	MOVL	#SS$_NOPRIV,R0
	RET
;
;	Error reading file
;	Eof ?
;
95$:	CMPL	R0,#RMS$_EOF		; If we hit end of file
	BNEQ	96$			;  Then
	MOVL	#SS$_NOPRIV,R0		;   Say NOT AUTHORIZED
96$:	RET

	.ENTRY	SET_ACNT,0
;
;	Acnt = 8H12345678						;830721
;	Uic  = Group*(2**16) + Member
;	Idsw = SET_ACNT(%ref(Acnt),%val(Uic))
;
	$CMKRNL_S PATCH_IT,(AP)		; Call action routine
	RET

	.ENTRY	PATCH_IT,0

	MOVL	@#SCH$GL_CURPCB,R0	; Get PCB
	TSTL	P2(AP)			; Do we need to set the UIC ?
	BLEQ	10$			; If neg or zero, no
	MOVL	P2(AP),PCB$L_UIC(R0)	; Set UIC			;830721
10$:
	MOVL	PCB$L_JIB(R0),R0	; Get JIB
	MOVAL	JIB$T_ACCOUNT(R0),R1	; Point to Account code
	MOVQ	@P1(AP),(R1)		; Set new account code		;830721
	MOVQ	@P1(AP),CTL$T_ACCOUNT					;830721
;
;	Change ownership of Job Logical Name Table
;
	SETIPL	#IPL$_ASTDEL		; Prevent LNM tables from change
	PUSHL	R4			; Save PCB
	JSB	G^LNM$LOCKR		; Lock LNM MUTEX for reading
	MOVQ	NAMEDESC,R0		; Search for SYS$LOGIN
	BICL2	#^XFFFF0000,R0		; 
	MOVQ	TBLDESC,R2		;  in LNM$JOB
	BICL2	#^XFFFF0000,R2		; 
	MOVL	#PSL$C_USER,R5		; Search in User Mode
	JSB	G^LNM$SEARCHLOG
	PUSHR	#^M<R0,R1>
	MOVL	2*4(SP),R4
	JSB	G^LNM$UNLOCK		; Unlock mutex
	SETIPL	#0
	POPR	#^M<R0,R1>
	BLBC	R0,20$
;					; r1 -> Logical name block
	MOVL	LNMB$L_TABLE(R1),R1	; R1 -> Table Header
	MOVL	LNMTH$L_ORB(R1),R1	; R1 -> Owner Rights Block
	MOVL	P2(AP),ORB$L_OWNER(R1)	; Zap the ownership
20$:
	RET

	.END	CHARGE
-------------
1 CHARGE

 CHARGE acnt
 CHARGE project

This command is used to charge computer time to a particular
ACC project number. Only the LAST CHARGE command in a job
is significant.

 Only accounts specifically authorized for the user issuing 
 the command can be used.
2 Arguments
 It takes one argument, which can be 
 - a 4-digit account number (such as 6050), in which case, the 
   job will be charged to that account
 - a project name (such as SOGS), in which case that project 
   will be looked up in the VAX/VMS user authorisation file,
   and (a) the job will be charged to that account and 
   (b) the UIC of the process will be set so that any files 
   created by the job after this point will be charged to that 
   project.
   The second form is not valid if the account number is 6050
   or blank.
2 Setup
 The following commands are included in SYS$MANAGER:SYSTARTUP.COM:
	$ MCR INSTALL
	CHARGE /PRIV=(SYSPRV,CMKRNL)
 The definition CHARGE :== MCR CHARGE is included in 
	SYS$MANAGER:SYLOGIN.COM
2 Maintenance
 Source code:	[.]CHARGE.MAR
 Target image:	SYS$SYSTEM:CHARGE.EXE
2 Files
 This program uses the following files:

	SYS$SYSTEM: SYSUAF.DAT
		The VAX/VMS user authorisation file

	SYS$MANAGER:CHARGENUM.DAT
		The list of valid account/userid combinations
		Each record has a 4-digit numeric account
		number immediately followed by the USERNAME.
		[If this file is not found, all combinations
		are valid. If this file is found but unreadable,
		all accounts are rejected.]
------