.title	SHOW	Show IDs and their owners
	.ident	/V1.02/
	.sbttl	Documentation
;
;	This set of subroutines implements the identifier-only
;	set of subcommands of the SHOW command. The subroutine
;	SHOW_OWNERS shows all identifiers that hold a given
;	identifier.  The subroutine SHOW_USER will show what
;	identifiers are held by anothed ID. These are for the
;	IAF (or AUTH_ID) package.  SHOW_IDENT will display all
;	the identifiers the user can control.   SHOW_AUTH, will
;	show all other users that are authorized to grant this
;	ID.   For the AUTH_ID package.
;
;	Eric F. Richards
;	24-Apr-86
;	Gould OSD VAXcluster VMS V4.3
;

;
;	register use:
;	r0 -- used for error text to complain
;	R1 -- scratch in print, prtall, etc
;	R2 -- address of output ID buffer
;	r3 -- usually used for a context variable
;	r4 -- address of descriptor for HEADER line
;	r5 -- output text buffer descriptor
;	r6 -- attributes buffer address
;	r7 -- address of uic argument to COMPLAIN
;	r8 -- printed flag
;	r9 -- temp used by prtall
;	
	.sbttl	Macros, constants, etc

	.macro	clrsp space, fill=#0	; macro for clearing space
	subl	space, sp		; on stack for a data area.
	movc5	#0, (sp), fill, -	; data area is init'd to
		  space, (sp)		; nulls by this macro
	.endm	clrsp			; that's it!

	bufsiz	= 132			; buffer size for output line

	$climsgdef			; define CLI errors
	$rmsalldef			; define RMS codes
	$ssdef				; define system service offsets
	$kgbdef				; define identifier properties
	$uicdef				; define UIC codes

	.enable	suppression		; clean up the listing files
	.disable traceback, debug	; hands off w/debugger
	.default displacement, word	; use word-relative for everything!

	.page
	.sbttl	SHOW_AUTH code
	.psect	$code, long, exe, nowrt, pic, shr
	.entry	show_auth, ^m<r4, r5, r7, r8, r9>
	moval	-(sp), r7			; r7 = held id buffer address

	bsbw	get_n_check_id			; ...like it says!

	pushal	ctr5				; build header descriptor
	pushl	s^#ctr5_len			; ...need its length
	movl	sp, r4				; save its address

	subl	#bufsiz, sp			; make a buffer on the stack
	pushl	sp				; build a descriptor for it
	pushl	#bufsiz				; descriptor needs size
	movl	sp, r5				; r5 = output string descr

	movb	#rab$c_key, iafrab+rab$b_rac	; use access by KEY
	movb	s^#id_key_size, iafrab+rab$b_ksz ; the key size is this
	movb	s^#id_key, iafrab+rab$b_krf	; walk the ID key
	movw	s^#recsiz, iafrab+rab$w_usz	; set output buffer length
	movl	r7, iafrab+rab$l_kbf		; set key as ID buffer

	$get	rab=iafrab			; get the record
	blbc	r0, 20$				; if it's not there, give

	movb	#rab$c_seq, iafrab+rab$b_rac	; go sequentially
	movl	(r7), r9			; get ident name in header
	bsbw	header				; display the header for this
	movl	s^#ctr6_len, (r4)		; set up the generic ID printer
	moval	ctr6, 4(r4)			; ...descriptor

5$:	movl	recbuf+uic_offset, r9		; get UIC value
	bsbw	prtid				; print just the Identifier
	blbc	r0, 10$				; error here is not so good
	$get	rab=iafrab			; walk the file sequentially
	blbc	r0, 7$				; loop until failure
	cmpl	(r7), recbuf+id_offset		; are we still looking at
	beql	5$				; ...this ID? loop if so
7$:	cmpl	#rms$_rnf, r0			; no more records?
	beql	15$				; if so, success -- normal out
	cmpl	#rms$_eof, r0			; end of file?
	bneq	10$				; if not, error out
15$:	movl	#ss$_normal, r0			; set success status
10$:	ret					; go back with error
20$:	movl	#iaf_privonly, r0		; set error for priv'd users
	brw	complain			; error out

	.page
	.sbttl	SHOW_IDENT code
	.entry	show_ident, ^m<r2, r3, r4, r5, r6, r7, r8, r9>
;
;	check for SYSPRV. if SYSPRV, then walk the ID list to find out
;	what IDs are out there.
;
	clrl	r8				; set printed flag to FALSE

	clrsp	#bufsiz				; make room for the output text
	pushl	sp				; make a descriptor for it
	pushl	#bufsiz				; ...rest of descr
	movl	sp, r5				; save a pointer to the descr
	pushal	ctr4				; build header descr
	pushl	#ctr4_len			; ...rest of descriptor
	movl	sp, r4				; save ptr to the descr on stck
	moval	-(sp), r6			; r6 = attributes buffer

	bbc	s^#flag_sysprv, flags, nopriv	; is no sysprv, skip this code

	assume	uic$k_match_all eq -1		; allow next instruction to work
	mnegl	#1, -(sp)			; set wild card search
	movl	sp, r7				; r7 = wild card buffer

	bsbw	get_n_check_uic			; ...get and check for the UIC
	blbs	r0, 10$				; look at other IDENT if there
	cmpl	#cli$_absent, r0		; was it the normal error?
	beql	99$				; if so, continue
	ret					; error -- go back NOW!

10$:	movl	(r7), r9			; if looking up someone else's,
	brb	othprv				; ...display their UIC in headr

99$:	movl	uic, r9				; use this ID for header msg
	moval	-(sp), r2			; r2 = output buffer for result
	clrl	-(sp)				; make room for a context var.
	movl	sp, r3				; r3 = context var buffer

plp:	$idtoasc_s id=(r7), -			; search entire rightslist
		contxt=(r3), -			; for identifiers - keep contxt
		resid=(r2), -			; store returned id here
		attrib=(r6)			; get attributes of the ID
	blbc	r0, 20$				; on error go home quietly

	cmpl	#uic$k_max_uic, (r2)		; did we get a real ID?
	bgequ	plp				; if not, go back to try again
	blbs	r8, 10$				; don't print header if prt'd

	bsbw	header				; print heading on terminal
	blbc	r0, 20$				; on error fubar out

10$:	bsbw	prtall				; print out a line
	blbs	r0, plp				; loop on if successful
20$:	brw	clean2				; use a common cleanup path

nopriv:	moval	uic, r7				; get address of UIC
	movl	(r7), r9			; set the header UIC
othprv:	moval	recbuf+id_offset, r2		; r2 points to ID field
	movb	#rab$c_key, iafrab+rab$b_rac	; use access by KEY
	movb	s^#uic_key_size, iafrab+rab$b_ksz ; the key size is this
	movb	s^#uic_key, iafrab+rab$b_krf	; walk th UIC key
	movw	s^#recsiz, iafrab+rab$w_usz	; set output buffer length
	movl	r7, iafrab+rab$l_kbf		; set key as UIC buffer

	$get	rab=iafrab			; get the record
	blbc	r0, 20$				; if it's not there, give

	movb	#rab$c_seq, iafrab+rab$b_rac	; go sequentially
	bsbw	header				; display the header for this
5$:	movl	recbuf+id_offset, r9		; get ID value
	$idtoasc_s id=r9, -			; get the attributes of this ID
		attrib=(r6)			; write the attributes here
	blbc	r0, 10$				; error here is a real prob
	bsbw	prtall				; print out the ID and info
	blbc	r0, 10$				; error here is not so good
	$get	rab=iafrab			; walk the file sequentially
	blbc	r0, 7$				; loop until failure
	cmpl	(r7), recbuf+uic_offset		; are we still looking at
	beql	5$				; ...this UIC? loop if so
7$:	cmpl	#rms$_rnf, r0			; no more records?
	beql	15$				; if so, success -- normal out
	cmpl	#rms$_eof, r0			; end of file?
	bneq	10$				; if not, error out
15$:	movl	#ss$_normal, r0			; set success status
10$:	ret					; go back with error
;
;	Error handler if we can't display any IDs
;
20$:	cmpl	#rms$_rnf, r0			; no records found?
	beql	30$				; if not, return
	ret					; else, return error
30$:	movl	#iaf_peon, r0			; set error status
	brw	complain			; get out, complain on the way
	
	.sbttl	SHOW_OWNERS code
	.page
	.entry	show_owners, ^m<r2, r3, r4, r5, r6, r7, r9>
	clrl	-(sp)			; make room for the held ID
	movl	sp, r7			; r7 = held id buffer

	bsbw	get_n_check_id		; ...like it says!

	clrl	-(sp)			; make a buffer for the attribute mask
	movl	sp, r6			; R6 = attribute mask
	clrsp	#bufsiz			; make a text buffer for output
	pushl	sp			; make a descriptor for said buffer
	pushl	#bufsiz			; ...rest of descriptor
	movl	sp, r5			; r5 = a string of nulls
	clrl	-(sp)			; make room for a context variable
	movl	sp, r3			; r3 = context variable
	clrl	-(sp)			; make room for id buffer
	assume	uic$k_match_all eq -1	; allow next instruction to work
	mnegl	#1, -(sp)		; set it ast a wild card search
	movl	sp, r2			; r2 = wild card buffer

	pushal	ctr1			; build descriptor for $FAO ctrstr
	pushl	s^#ctr1_len		; ...length for descriptor
	movl	sp, r4			; R4 = control string 1
	movl	(r7), r9		; format the ID name
	bsbw	prtid			; print out the line
	blbc	r0, done		; on error get out here

lp:	$find_holder_s id=(r7), -	; use a wild card lookup to...
		holder=(r2), -		; find out who holds this ID
		attrib=(r6), -		; return the attributes here
		contxt=(r3)		; use the context to keep track of this
	blbc	r0, done		; on error clean up things

	bsbw	prtall			; find out about resources & print

	blbs	r0, lp			; on success loop

done:	bsbw	cleanif			; clean up if necessary
finis:	ret				; quick error out
	.sbttl	SHOW_USER code

	.page
	.align	long
	.entry	show_user, ^m<r2, r3, r4, r5, r6, r7, r8, r9>
	clrl	r8			; set printed flag to FALSE

	clrq	-(sp)			; make room for the holder ID
	movl	sp, r7			; r7 = holder id buffer

	bsbw	get_n_check_uic		; get the UIC, verify it's there
	blbc	r0, finis		; if error get out fast

	clrsp	#bufsiz			; make a text buffer for output
	pushl	sp			; make a descriptor for said buffer
	pushl	#bufsiz			; ...rest of descriptor
	movl	sp, r5			; r5 = a string of nulls

	pushal	ctr3			; build descriptor for $FAO ctrstr
	pushl	#ctr3_len		; ...length for descriptor
	movl	sp, r4			; R4 = control string 1

cont2:	clrl	-(sp)			; make a buffer for the attribute mask
	movl	sp, r6			; R6 = attribute mask
	clrl	-(sp)			; make room for a context variable
	movl	sp, r3			; r3 = context variable
	assume	uic$k_match_all eq -1	; allow next instruction to work
	mnegl	#1, -(sp)		; set it as a wild card search
	movl	sp, r2			; r2 = wild card buffer

loop:	$find_held_s id=(r2), -		; use a wild card lookup to...
		holder=(r7), -		; find out who holds this ID
		attrib=(r6), -		; return the attributes here
		contxt=(r3)		; use the context to keep track of this
	blbc	r0, clean1		; on error clean up things

	pushl	(r2)			; can we look at this ID legally?
	calls	#1, check_access	; ...let's find out!
	blbc	r0, loop		; if we can't, skip this

	blbs	r8, 10$			; if header has been prt'd, skip

	movl	(r7), r9		; format the ID name
	bsbw	header			; print header
	blbc	r0, 20$			; on error fubar out
10$:	bsbw	prtall			; find out about the resources & print
	blbs	r0, loop		; on success, loop
20$:	bsbw	cleanif			; straighten out the RDB if needed
	ret				; and go home

	.sbttl	Support routines
	.page

get_n_check_id:				; used by SHOW_AUTH, SHOW_OWNERS
	pushal	id			; build descr for the ID
	pushl	s^#id_len		; ... label to get from cmd line
	movl	sp, r0			; save a temp ptr to it
	pushl	r7			; write numeric ID here
	pushl	r0			; get it from this label
	calls	#4, getid		; get the ID and unwind the stack!
	blbc	r0, 10$			; on error get out

	tstl	(r7)			; is this a UIC identifier?
	blss	20$			; if not, we're okay -- skip this!
	movl	#iaf_wrongtype, r0	; set error
	brb	complain		; and complain about it!
10$:	ret				; and we're outta here

20$:	pushl	(r7)			; can we look at this identifier?
	calls	#1, check_access	; let's find out!
	blbs	r0, 30$			; if so, go on with it
	movl	#iaf_nopriv, r0		; else, set no priv message
	brb	complain		; error out
30$:	rsb				; go back to caller


header:	bsbw	prtid			; print out the identifier
	blbc	r0, clean1		; on error get out here

	movl	#1, r8			; set R8 to TRUE
	rsb				; return to caller

clean1:	movl	#iaf_noids, r2		; set error status for some
	brb	clean3			; go to common path
clean2:	movl	#iaf_peon, r2		; set error status for others
clean3:	bsbb	cleanif			; clean up the rights database
	blbc	r0, 10$			; on real error go back, NOW!
	blbc	r8, 20$			; if we printed something, return
10$:	ret				; ...right here
20$:	movl	r2, r0			; set error status
;
;	Display error message with 1 param, go back to calller
;
complain:
	pushl	(r7)			; this is the arg to the error message
	pushl	#1			; this is the number of FAO arguments
	pushl	r0			; error code is here
	calls	#3, putmsg		; display the error message
	ret				; done, go back to caller

cleanif:
	cmpl	#ss$_nosuchid, r0	; did we finish walking the ID list?
	beql	10$			; if not, save error status, ret
	pushl	r0			; save error status
	$finish_rdb_s contxt=(r3)	; clean up the database
	popl	r0			; restore error status
	rsb				; return to caller
10$:	movl	#ss$_normal, r0		; set success
	rsb				; return to caller

get_n_check_uic:			; look up UIC, return on failure
	pushal	id			; build descr for the ID
	pushl	s^#id_len		; ... label to get from cmd line
	movl	sp, r0			; save a temp ptr to it
	pushl	r7			; write numeric ID here
	pushl	r0			; get it from this label
	calls	#4, getid		; get the ID and unwind the stack!
	blbc	r0, 10$			; on error get out
	tstl	(r7)			; did we get a UIC type ID?
	bgeq	10$			; if so, keep going
	movl	#iaf_needuic, r0	; else, set wrong type of ID
	brb	complain		; and error out
10$:	rsb				; return to caller

;
;	Print the IDs in various forms...
;

prtall:	movw	#bufsiz, (r5)			; init output descriptor
	movl	sp, r0				; save stack pointer
	pushal	ctr2				; build control descr
	pushl	s^#ctr2_len			; ...for output line
	movl	sp, r9				; save address of the pointer
;
;	This next instruction must be the last thing PUSHED on the stack,
;	outside of CALLS argument lists.
;
	pushl	r0				; save stack pointer on stack!
	movw	#bufsiz, (r5)			; init outstring descr
	movaw	#^a/  /, r0			; assume RESOURCE
	bbs	#kgb$v_resource, (r6), 10$	; is that the case?
	movaw	#^a/NO/, r0			; ...not if we get here!
10$:
	.if df	kgb$v_dynamic			; is this V4.4 or after?
	movaw	#^a/  /, r1			; assume DYNAMIC
	bbs	#kgb$v_dynamic, (r6), 20$	; is that true?
	movaw	#^a/NO/, r1			; ...not if this executes.
20$:
	$fao_s	ctrstr=(r9), -			; format the output string
		outbuf=(r5), -			; write the output here
		outlen=(r5), -			; truncate the output
		p1=(r2), -			; ID to format
		p2=#2, -			; length of RESOURCE string
		p3=r0, -			; address of the string
		p4=#2, -			; length of DYNAMIC string
		p5=r1				; address of the string
	.endc					; end of conditional ass'y.

	.if ndf	kgb$v_dynamic			; if we are between 4.0 and 4.4
	$fao_s	ctrstr=(r9), -			; format the output string
		outbuf=(r5), -			; write the output here
		outlen=(r5), -			; truncate the output
		p1=(r2), -			; ID to format
		p2=#2, -			; length of RESOURCE string
		p3=r0				; address of the string
	.endc					; end of conditional ass'y

	popl	sp				; unwind stack
	brb	print				; print out the line, return

prtid:	movw	#bufsiz, (r5)			; init string descriptor
	$fao_s	ctrstr=(r4), -			; format the ID into the
		outbuf=(r5), -			; string buffer descr. ID is
		outlen=(r5), -			; passed by value in R9.
		p1 = r9				; ... the ID itself

print:	blbc	r0, 10$				; on error go back, now.
	pushl	r5				; put output descr on the stack
	calls	#1, put_output			; print it out
10$:	rsb					; go back.



	.sbttl	Constants and other stuff
	.psect	$pdata, long, noexe, nowrt, shr, pic
id:	.ascii	/ID/				; CLI label for the parameter
	id_len	= . - id			; and its length

ctr1:	.ascii	/Owners of identifier !%I:/	; Header string for the ID
	ctr1_len = . - ctr1			; ...and its length

ctr6:						; format just the ID, no atribs
ctr2:	.ascii	/!40<!%I!>/			; format the ID and its attribs
	ctr6_len = . - ctr6			; ...length of just ID string
	.ascii	/!ADRESOURCE/			; format string for RESOURCE
	.iif ndf kgb$v_dynamic, ctr2_len = . - ctr2 ; if pre 4.4, no DYNAMIC
	.if df	kgb$v_dynamic			; if after 4.4, we'll need to
	.ascii	/  !ADDYNAMIC/			; ...format DYNAMIC, too
	ctr2_len = . - ctr2			; set length of string
	.endc					; end of conditional ass'y

ctr3:	.ascii	/Identifiers owned by !%I:/	; Header string for the ID
	ctr3_len = . - ctr3			; ...and its length

ctr4:	.ascii	/UIC !%I controls the following identifiers:/
	ctr4_len = . - ctr4

ctr5:	.ascii	/Controllers of identifier !%I:/
	ctr5_len = . - ctr5

	.end					; that's all, folks!