;
; **********************************************************************
		.TITLE	CHGUIC
; this is a program to change the owner uic of a file
; it must be installed with privilege BYPASS
; this file must be linked w/ sys$useful:error
;
;***********************************************************************
;
;
;
$DSCDEF
$JPIDEF
$RMSDEF
$PRVDEF
$SHRDEF
$SSDEF
.PSECT STRUCTP,LONG
INFAB:	$FAB	FAC=<PUT>,NAM=NAMBLK,FOP=NAM,XAB=PROXAB		;fab to open file with
NAMBLK:	$NAM	RSA=STR1,RSS=NAM$C_MAXRSS,ESA=STR,ESS=NAM$C_MAXRSS
STR:	.BLKB NAM$C_MAXRSS
STR1:	.BLKB NAM$C_MAXRSS
PROXAB:	$XABPRO
CONVERT_DESC:	.LONG 0
		.LONG 0
STORAGE:	.LONG 0				;storage
FLAG:	.LONG 0
UIC:
MEMBER:	.WORD				;TEMP STORAGE FOR REQUESTED MEMBER NUM.
GROUP:	.WORD				;TEMP STORAGE FOR REQUESTED GROUP NUM.
;		JOB PROCESS INFO. LIST
JPI_LIST:	.WORD	4			;LENG OF BUFFER
		.WORD	JPI$_GRP		;REQUEST GROUP NUMBER OF UIC
		.LONG	CALLER_GRP		;ADDRESS TO RECEIVE GROUP NUM.
		.LONG	0			;DON'T NEED LENGTH  RETURN
		.WORD	4
		.WORD	JPI$_MEM		;REQUEST MEMBER NUMBER OF UIC
		.LONG	CALLER_MEM
		.LONG	0
		.WORD	4
		.WORD	JPI$_PROCPRIV
		.LONG	CALLER_PRIV		;REQUEST PRIVILEGES OF PROCESS
		.LONG	0
		.LONG	0			;END OF LIST
CALLER_GRP:	.BLKL	1			;PROCESS GROUP NUMBER
CALLER_MEM:	.BLKL	1			;PROCESS MEMBER NUMBER
CALLER_PRIV:	.BLKL	1			;PROCESS PRIV.
SYSTEM:		.LONG	0			;SYSTEM USER FLAG
FILE_DESC:	.LONG	0,STR1			;FILE DESC. AREA FOR STR1
GETCMD:	$CLIREQDESC -				;input so cli can return info on cmd line
			RQTYPE = CLI$K_GETCMD
DESCRIPTOR:	.BLKL 2				;descriptor for command line
SYNTAX: .ASCID /ILLEGAL COMMAND LINE/<13><10>
.EVEN
;
PROMPT_DESC:	.ASCID /$_FILE NAME:/	;prompt
;
; register usage
;
; R0 and R1 are scratch
; R6 and R7 are used to contain the description of the file spec
;	as it goes through several changes (device and dir are stripped)
;	R6 is the length and R7 is the address
; R8 is used once for scratch
; R9 is used to point to the nam block temporarily
; R10 is used to point to the fib temporarily
; R11 is used to point to the commonly used fab (infab)
; R0,R1,R6,R7,R8 are clobbered in parse, but nothing has happened before it
;
.PSECT CODE
START::
	.WORD 0
	MOVAL	INFAB,R11
;
; call parse to get the file spec and the uic
;
	BSBW	PARSE
;
;
	$GETJPI_S	ITMLST=JPI_LIST		;GET JOB PROCESS INFO.
;
	BBS	#PRV$V_WORLD,CALLER_PRIV,205$	;DOES HE HAVE WORLD PRIV.-
						;IF YES - SET HIM SYSTEM
	CMPL	#8,CALLER_GRP			;IS HE A SYSTEM GROUP?
	BLSS	200$				;NO
205$:	MOVL	#1,SYSTEM			;YES HE IS - SET FLAG
	BRW	207$				;NO MORE TESTS
200$:	CMPW	CALLER_GRP,GROUP		;IS THE PROCESS GROUP NUM. THE
						;SAME AS THE GROUP NUM. HE IS
						;TRYING TO CHANG THE FILE TO?
	BEQL	206$				;YES CONT.
	BRW	PRIV_ERR			;NO - GIVE A PRIV VIOLATION ERROP
206$:	BBS	#PRV$V_GROUP,CALLER_PRIV,207$	;DOES HE HAVE GROUP PRIV.?
	BRW	PRIV_ERR			;NO - GIVE A PRIV VIOLATION ERROP
207$:
	$PARSE	FAB=R11,ERR=REPORT_ERROR
MORE:
	$SEARCH	FAB=R11
	CMPL	R0,#RMS$_NMF
	BNEQ	211$
	JMP	DONE
211$:	BLBS	R0,CONT
	MOVL	R11,R10
	BSBW	REPORT
	RET
CONT:
	$OPEN FAB=R11
	BLBS	R0,202$				;BRANCH NO ERROR
	PUSHL	FAB$L_STV(R11)			;PUSH ERROR STATUS VALUE
	PUSHL	FAB$L_STS(R11)			;PUSH ERROR STATUS
	MOVAL	NAMBLK,R1			;MOVE ADD. OF NAME BLOCK TO R1
	MOVZBL	NAM$B_RSL(R1),FILE_DESC		;MOVE RESULANT STRING  LENGTH
						;TO FILE DESC. TO BE PRINTED
	PUSHAL	FILE_DESC			;PUSH CHAR STRING DESC. TO STACK
	PUSHL	#1				;NO. OF VARABLES ON STACK
	PUSHL	#<SHR$_OPENIN!<21@16>>		;ERROR CODE
	CALLS	#5,@#LIB$SIGNAL			;SIGNAL ERROR
	BRW	MORE
;
202$:
	BLBS	SYSTEM,201$			;IF SYSTEM USER - GO TO 201$
	CMPW	XAB$W_GRP+PROXAB,CALLER_GRP	;IS HE IN THE SAME GROUP
						;AS THE FILE OWNER
	BEQL	201$				;YES - CONTINUE
;
	PUSHL	#RMS$_PRV			;PUSH RMS PRIV. ERROR ON STACK
	MOVAL	NAMBLK,R1			;MOVE ADD. OF NAME BLOCK TO R1
	MOVZBL	NAM$B_RSL(R1),FILE_DESC		;MOVE RESULANT STRING  LENGTH
						;TO FILE DESC. TO BE PRINTED
	PUSHAL	FILE_DESC			;PUSH CHAR STRING DESC. TO STACK
	PUSHL	#1				;NO. OF VARABLES ON STACK
	PUSHL	#<SHR$_OPENIN!<21@16>>		;ERROR CODE
	CALLS	#4,@#LIB$SIGNAL			;SIGNAL ERRORS
	BRW	209$				;GO CLOSE FILE WITH NO CHANGES
;
201$:
; modify the uic on the close
;
	$XABPRO_STORE	XAB=PROXAB,UIC=UIC	;STORE NEW UIC IN XAB
209$:
	$CLOSE	FAB=R11
	BLBS	R0,210$				;BRANCH NO ERROR
;
	CMPL	#SS$_FILENUMCHK,FAB$L_STV(R11)	;THIS TEST SHOULD NOT BE NEC.
						;WE ARE GETTING THIS ERROR WHEN
						;RMS UPDATES THE UIC IN THE 2ND
						;BLOCK OF THE INDEX FILE
	BEQL	210$				;IGNORE THE ERROR AND GO WITH IT
;
	PUSHL	FAB$L_STV(R11)			;PUSH ERROR STATUS VALUE
	PUSHL	FAB$L_STS(R11)			;PUSH ERROR STATUS
	MOVAL	NAMBLK,R1			;MOVE ADD. OF NAME BLOCK TO R1
	MOVZBL	NAM$B_RSL(R1),FILE_DESC		;MOVE RESULANT STRING  LENGTH
						;TO FILE DESC. TO BE PRINTED
	PUSHAL	FILE_DESC			;PUSH CHAR STRING DESC. TO STACK
	PUSHL	#1				;NO. OF VARABLES ON STACK
	PUSHL	#<SHR$_CLOSEIN!<21@16>>		;ERROR CODE
	CALLS	#5,@#LIB$SIGNAL			;SIGNAL ERROR
210$:

	BITL	#NAM$M_WILDCARD,NAMBLK+NAM$L_FNB
	BEQL	DONE
	JMP	MORE
DONE:
	MOVL	#1,R0
	RET
;
PRIV_ERR:
	PUSHL	#1
	PUSHL	#RMS$_PRV		;PUSH VALUE OF PRIV. ERROR ON STACK
		CALLS	#2,LIB$SIGNAL		;SIGNAL THE FATAL ERROR AND EXIT
		MOVL	#1,R0
		RET
;
; this is a routine to get the command line and parse it
; output is one file name, with the descriptor in infab
; and an uic value
;
GET_NUM:
; this is a subroutine to pick the number out of the switch
; it is passed back in the longword storage
;
	MOVL	R1,CONVERT_DESC+4			;save addr of digit
5$:	MOVB	(R1)+,R0
	CMPB	R0,#^A/0/
	BLSS	10$
	CMPB	R0,#^A/7/
	BGTR	10$
	BRB	5$
10$:
	SUBL3	CONVERT_DESC+4,R1,CONVERT_DESC
	DECL	CONVERT_DESC
	PUSHAL	STORAGE
	PUSHAL	CONVERT_DESC
	MOVL	R1,R8				;*******
	CALLS	#2,FOR$CNV_IN_O
	MOVL	R8,R1				;*******
	BLBS	R0,A
	PUSHL	R0
	CALLS	#1,LIB$SIGNAL
	RET
A:
	RSB
;
; on to the main stuff
;
PARSE:
	CLRW	FLAG
	PUSHAB	W^GETCMD
	CALLS	#1,@CLI$A_UTILSERV(AP)
	MOVQ	W^GETCMD+CLI$Q_RQDESC,DESCRIPTOR
	TSTL	DESCRIPTOR
	BNEQ	1$
	BRW	PROMPT_FIRST
1$:
	LOCC	#^A%/%,DESCRIPTOR,@DESCRIPTOR+4		;is there a switch?
	MOVL	R0,R7				;save len of rest of str
	TSTL	R0
	BNEQ	3$
	BRW	NOSWITCH
3$:
	MOVL	R1,R6			;r6 points to whole origin string
	LOCC	#^A/=/,R0,(R1)				;find the colon
	TSTL	R0
	BNEQ	FINE
	MOVL	R6,R1
	MOVL	R7,R0					;restore r0,r1
	LOCC	#^A/:/,R0,(R1)			; is there an =?
	TSTL	R0
	BNEQ	FINE
SYNERR:
	PUSHAL	SYNTAX
	CALLS	#1,LIB$PUT_OUTPUT
	RET
FINE:
	INCL	R1					;advance over colon
	CMPB	(R1),#^A/[/
	BNEQ	NOBRACK
	INCL	R1				;skip it
	INCL	FLAG				;set flag
NOBRACK:
	BSBW	GET_NUM
	MOVW	STORAGE,GROUP
;	INCL	R1				;skip over comma******
	BSBW	GET_NUM
	MOVW	STORAGE,MEMBER
	DECL	R1				;SKIP OVER RBRACK*****
	BLBC	FLAG,NOBRACK1			;if no lbrack, then no right
	CMPB	(R1),#^A/]/
	BNEQ	SYNERR				;report error
	INCL	R1				;skip it
NOBRACK1:
	MOVL	R1,R8				;r8 points to rest of string
	DECL	R1
	MOVL	DESCRIPTOR+4,R7			;addr of whole str
	ADDL2	DESCRIPTOR,R7			;last byte of whole str
	SUBL2	R8,R7				;get size of rest of str
	INCL	R7
	SUBL2	R8,DESCRIPTOR			;adjust descriptor
	ADDL2	R6,DESCRIPTOR
	BGEQ	20$
	CLRL	DESCRIPTOR
20$:
	CMPL	R6,DESCRIPTOR+4
	BNEQ	40$
	MOVL	R8,DESCRIPTOR+4			;adjust beginning of str,if necc
	INCL	DESCRIPTOR+4
	DECL	DESCRIPTOR
	BRB	45$
40$:
	INCL	DESCRIPTOR
45$:
	TSTL	DESCRIPTOR			;may not be any more
	BLEQ	PROMPT_FIRST
;
;
; have at least one file spec, get it
;
NOSWITCH:
	MOVL	DESCRIPTOR+4,R1
	ADDL2	DESCRIPTOR,R1
100$:	SUBL3	DESCRIPTOR+4,R1,R0
	MOVB	R0,FAB$B_FNS(R11)
	MOVL	DESCRIPTOR+4,FAB$L_FNA(R11)
	RSB
;
; need to prompt for a file -- prompt away
;
PROMPT_FIRST:
	CLRQ	DESCRIPTOR
	MOVB	#DSC$K_CLASS_D,DESCRIPTOR+DSC$B_CLASS
	PUSHAL	PROMPT_DESC
	PUSHAL	DESCRIPTOR
	CALLS	#2,LIB$GET_INPUT
	MOVZWL	DESCRIPTOR+DSC$W_LENGTH,R0
	MOVB	R0,FAB$B_FNS(R11)
	MOVL	DESCRIPTOR+4,FAB$L_FNA(R11)
;
; got the file spec, return with it
;
	RSB
.END START
