.title	IDCTL	GRANT, REVOKE ids or control of them
	.ident	/V1.01/
	.sbttl	Documentation
;
;	These subroutines control ids, and who can touch them. The
;	subroutines are:
;
;	GRANT		- grant an ID to a holder ID
;			- grant control of an ID to a holder ID
;	REVOKE		- revoke an ID from a holder ID
;			- revoke control of an ID from a holder ID
;	
;
;	Eric F. Richards
;	23-Apr-86
;	Gould OSD VAXcluster VMS V4.3
;
	.sbttl	GRANT documentation
;
;	This subroutine will grant an identifier to another
;	identifier if access is allowed by the PRIVCHK function.
;	The subroutine GRANT is responsible for granting and
;	revoking identifiers or control, depending on the
;	switches passed to it from the command line.
;

	.sbttl	Macros, constants, etc...

	.macro	subs, old, new, cont, ?lbl	; macro to subs error texts
	cmpl	r0, #old			; did we get this error
	bneq	lbl				; if not, skip this code
	movl	#new, r0			; else, replace with this err
	brb	cont				; and jump to this location
lbl:						; this is the continuation pt
	.endm	subs				; that's this macro

	$ssdef					; define system service offsets
	$kgbdef					; define ID attributes
	$rmsalldef				; define all sorts of RMS stuff
	.enable	suppression			; clean up the listing file
	.disable traceback, debug		; hands off w/ debugger
	.default displacement, word		; word displacement only

	.sbttl	GRANT -- Main Code
	.page
	.psect	$code, long, exe, nowrt, pic, shr
	.entry	grant, ^m<r3, r6, r10, r11>

	clrq	-(sp)				; create a holder buffer
	movl	sp, r11				; r11 points to HOLDER

	clrl	-(sp)				; create an ID buffer
	movl	sp, r10				; r10 points to ID

	movl	sp, r3				; save a stack pointer
	pushal	user_id				; build a descr for the
	pushl	s^#user_id_len			; ...label USER_ID
	movl	sp, r0				; r0 = "USER_ID"

	pushl	r11				; let's get the "user-id"
	pushl	r0				; ...or "holder" info
	calls	#2, getid			; get the id
	blbc	r0, 10$				; on error fail out

	pushal	granted_id			; build a descr for the
	pushl	s^#granted_id_len		; ...label GRANTED_ID
	movl	sp, r0				; r0 = "GRANTED_ID"

	pushl	r10				; let's get the "id"
	pushl	r0				; or "identifier" info
	calls	#2, getid			; get the id
	blbc	r0, 10$				; on error fail out

	bsbw	rkind				; right IDs in right places?

	pushl	(r10)				; can we really grant this?
	calls	#1, check_access		; let's find out!
	blbc	r0, oops			; uh-oh... problems...

	pushal	control				; did we get the control sw?
	pushl	s^#control_len			; ...build a descr...
	pushl	sp				; and find out
	calls	#1, qualifier			; ...this will tell us
	movl	r3, sp				; unwind stack
	blbc	r0, grid			; if false, we do the ID itself

	pushal	gcconf				; find out if we want to
	pushl	#gcconf_len			; ...grant ctl of this or not
	pushl	(r11)				; the ID to grant ctl to
	pushl	(r10)				; the ID to be granted ctl of
	calls	#4, idconf			; speak now or forever hold...
	blbc	r0, nogr			; ...your peace (piece?)

	movl	(r11), recbuf+uic_offset	; put the UIC in its buffer
	movl	(r10), recbuf+id_offset		; and the ID in its buffer
	movw	s^#recsiz, iafrab+rab$w_rsz	; set the record size
	$put	rab=iafrab			; write the record!
	blbc	r0, 20$				; on error get out NOW

	pushl	#iaf_ctrgrant			; this is the message
	pushl	(r11)				; holder ID is here
	pushl	(r10)				; granted ID is here
	pushl	#3				; 3 args in the arrgh list
	callg	(sp), idlog			; log the message if required
	callg	(sp), audit			; log the "control granted"
10$:	ret					; all done, go back now!
20$:	brw	error				; skip to the "real" err handlr

oops:	pushl	(r10)				; error message says, can't do!
	pushl	#1				; 1 argument to errmsg
	pushl	#iaf_cantctl			; the message code itself
	pushl	#3				; 3 longwords on stack
	movl	sp, r0				; save address of vector
	$putmsg_s msgvec=(r0)			; generate the error
	ret					; return (w/out status)

grid:	tstl	r0				; did we get an error from QUAL
	bneq	errout				; if not, we have a problem
	pushal	gconf				; find out if we want to
	pushl	s^#gconf_len			;... grant this ID or not
	pushl	(r11)				; the id to grant to (holder)
	pushl	(r10)				; the id to be granted
	calls	#4, idconf			; find out about it!

	blbs	r0, noconf			; go here if Yes
nogr:	tstl	r0				; did we error out?
	bneq	errout				; if non-zero, we had an error
	movl	#ss$_normal, r0			; else, set success status
errout:	ret					; go back to caller

noconf:	clrl	r6				; assume no attributes
	movl	sp, r3				; save stack pointer
	pushal	resource			; build descriptor for
	pushl	s^#resource_len			; ...RESOURCE label
	pushl	sp				; give address to...
	calls	#1, qualifier			; ...this, to see if it's there
	movl	r3, sp				; restore stack pointer
	blbc	r0, 10$				; if NORESOURCE, skip next
	bisl	#kgb$m_resource, r6		; set RESOURCE attribute

10$:
	.if df	kgb$m_dynamic			; assemble this if dyn is there
	pushal	dynamic				; build descriptor for...
	pushl	s^#dynamic_len			; ...DYNAMIC label
	pushl	sp				; check if it is a qualifier
	calls	#1, qualifier			; ...here
	movl	r3, sp				; unwind stack
	blbc	r0, 15$				; if false, returned, NODYNAMIC
	bisl	#kgb$m_dynamic, r6		; else, set the DYNAMIC attrib
15$:	.endc					; end of conditional assembly

	$add_holder_s id = (r10), -		; add the Identifier
		      holder = (r11), -		; holder is here
		      attrib=r6			; use this attribute mask

	blbs	r0, 20$				; on error get out with message
	brw	error				; goto common error handler

20$:	movl	r0, r6				; save old status

	pushl	#iaf_granted			; this is the message
	pushl	(r11)				; holder ID is here
	pushl	(r10)				; granted ID is here
	calls	#3, idlog			; log the message if required
	movl	r6, r0				; restore error status
done:	ret					; and get outta here!

	.sbttl	REVOKE -- main code
	.page
	.entry	revoke, ^m<r2, r3, r10, r11>
	clrq	-(sp)				; create a holder buffer
	movl	sp, r11				; r11 points to HOLDER

	clrl	-(sp)				; create an ID buffer
	movl	sp, r10				; r10 points to ID

	movl	sp, r3				; save a stack pointer
	pushal	user_id				; build a descr for the
	pushl	s^#user_id_len			; ...label USER_ID
	movl	sp, r0				; r0 = "USER_ID"
	pushl	r11				; let's get the "user-id"
	pushl	r0				; ...or "holder" info
	calls	#2, getid			; get the id
	blbc	r0, 1$				; on error fail out

	pushal	granted_id			; build a descr for the
	pushl	s^#granted_id_len		; ...label GRANTED_ID
	movl	sp, r0				; r0 = "GRANTED_ID"
	pushl	r10				; let's get the "id"
	pushl	r0				; or "identifier" info
	calls	#2, getid			; get the id
	blbs	r0, 3$				; on error fail out
1$:	ret					; error out here

2$:	brw	oops				; jump point to error routine

3$:	bsbw	rkind				; right IDs in right places?

	pushl	(r10)				; can we really grant this?
	calls	#1, check_access		; let's find out!
	blbc	r0, 2$				; uh-oh... problems...

	pushal	control				; did we get the control sw?
	pushl	s^#control_len			; ...build a descr...
	pushl	sp				; and find out
	calls	#1, qualifier			; ...this will tell us
	movl	r3, sp				; unwind stack
	blbc	r0, rvid			; if false, we do the ID itself

	pushal	rcconf				; find out if we want to
	pushl	s^#rcconf_len			;... grant this ID or not
	pushl	(r11)				; the id to grant to (holder)
	pushl	(r10)				; the id to be granted
	calls	#4, idconf			; find out about it!
	blbc	r0, norv			; on error, we do nothing

	movb	#rab$c_key, iafrab+rab$b_rac	; use access by KEY
	movb	s^#rec_key, iafrab+rab$b_krf	; look at the record as the key
	movb	s^#rec_key_size, iafrab+rab$b_ksz ; use rec size as the key size
	movw	s^#recsiz, iafrab+rab$w_usz	; set output buffer size
	moval	recbuf, iafrab+rab$l_kbf	; use the rec buffer as the key
	movl	(r11), recbuf+uic_offset	; set UIC half
	movl	(r10), recbuf+id_offset		; set ID offset

	bicl	#rab$m_nlk, iafrab+rab$l_rop	; enable record locking
	$get	rab=iafrab			; get the record, locked in
	bisl	#rab$m_nlk, iafrab+rab$l_rop	; disable record locking
	blbc	r0, 5$				; on error get out
	$delete	rab=iafrab			; delete the record
	blbs	r0, 10$				; on success, prt log if needed

5$:	brw	error				; else, go to error handler
10$:	pushl	#iaf_ctr_revoked		; display this text
	pushl	(r11)				; holder ID is here
	pushl	(r10)				; granted ID is here
	pushl	#3				; 3 arguments to next 2 calls
	callg	(sp), idlog			; log the message if required
	callg	(sp), audit			; log change to security
	ret					; and get outta here!

rvid:	pushal	rconf				; find out if we want to
	pushl	s^#rconf_len			;... grant this ID or not
	pushl	(r11)				; the id to grant to (holder)
	pushl	(r10)				; the id to be granted
	calls	#4, idconf			; find out about it!

	blbs	r0, doit			; go here if Yes
norv:	tstl	r0				; did we error out?
	bneq	10$				; if non-zero, we had an error
	movl	#ss$_normal, r0			; else, set success status
10$:	ret					; go back to caller

doit:	$rem_holder_s id = (r10), -		; revoke the Identifier
		      holder = (r11)		; holder is here

	blbc	r0, error			; on error get out with message

	movl	r0, r2				; save error status
	pushl	#iaf_revoked			; this is the message
	pushl	(r11)				; holder ID is here
	pushl	(r10)				; granted ID is here
	calls	#3, idlog			; log the message if required
	movl	r2, r0				; restore error status
	ret					; and get outta here!

	.sbttl	Support routines
	.page
;
;	Make sure the right ID is in the right place, error if not so
;

rkind:	movl	sp, r0				; save stack pointer
	movl	(r11), r1			; r1 should have a uic
	bgeq	10$				; if that's the case, skip nxt
	pushl	r1				; begin building err txt vector
	pushl	#1				; 1 arg (above) for err (below)
	pushl	#iaf_needuic			; set error text

10$:	movl	(r10), r1			; r1 should have a res. id
	blss	30$				; if that's the case, skip
	pushl	r1				; begin building err txt vector
	pushl	#1				; 1 arg (above) for err (below)
	pushl	#iaf_wrongtype			; set error text

30$:	cmpl	sp, r0				; anything on the stack?
	beql	40$				; if no, return -- no probs
	subl	sp, r0				; r0 has number of bytes on st
	ashl	#-2, r0, -(sp)			; push longword count on stack
	movl	sp, r0				; save ptr to vector
	$putmsg_s msgvec=(r0)			; write the error text out
	ret					; go back to mainline

40$:	rsb					; go back to caller

error:						; internal error handler
	subs	rms$_rnf, iaf_noctl, 10$	; replace these codes with
	subs	rms$_dup, iaf_hasctl, 10$	; the corresponding ones
	subs	ss$_dupident, iaf_hasid, 10$	; and jump to the error handlr
	subs	ss$_nosuchid, iaf_noid, 10$	; if the substituion was made
	ret					; else, unexpected error

10$:	pushl	(r10)				; second arg to errmsg is ID
	pushl	(r11)				; first arg to errmsg is UIC
	pushl	#2				; 2 arguments to errmsg
	pushl	r0				; the message code itself
	pushl	#4				; 4 longwords on stack
	movl	sp, r0				; save address of vector
	$putmsg_s msgvec=(r0)			; generate the error
	ret					; return (w/out status)

	.page
	.psect	$pdata, long, noexe, nowrt, pic, shr
control:
	.ascii	/CONTROL/
	control_len = . - control

granted_id:
	.ascii	/GRANTED_ID/
	granted_id_len = . - granted_id

user_id:
	.ascii	/USER_ID/
	user_id_len = . - user_id

	.if df	kgb$m_dynamic
dynamic:
	.ascii	/DYNAMIC/
	dynamic_len = . - dynamic
	.endc

resource:
	.ascii	/RESOURCE/
	resource_len = . - resource

gconf:	.ascii	/Really grant !%I to !%I? (Y or N): /
	gconf_len = . - gconf

gcconf:	.ascii	/Really grant control of !%I to !%I? (Y or N): /
	gcconf_len = . - gcconf

rconf:	.ascii	/Really revoke !%I from !%I? (Y or N): /
	rconf_len = . - rconf

rcconf:	.ascii	/Really revoke control of !%I from !%I? (Y or N): /
	rcconf_len = . - rcconf

	.end				; that's it!!