!=====================================================================+
	! MASTER - program for allowing "proj_MASTER" holders to grant and    |
	!          revoke identifiers for their project.                      |
	!=====================================================================+
	! Author:  Harry Flowers
	!
	!  Command syntax:
	!
	!    $ MASTER GRANT[/SURE][/NOTNOW] identifier username
	!    $ MASTER REVOKE[/SURE][/NOW]   identifier username
	!    $ MASTER LIST                  identifier
	!
	!  /SURE suppresses the "Are you SURE" question for granting/revoking
	!        the proj_MASTER id itself (an unusual thing to do)
	!  /NOTNOW does not grant the identifier to existing processes; the
	!          default is to grant the identifier to existing processes
	!  /NOW revokes the identifier from existing processes; the default
	!       is not to revoke the identifier from existing processes
	!  Note: Granting and revoking to existing processes only takes affect
	!        on the node from which the MASTER command was issued; this is
	!        due to a node restriction in $GRANTID and $REVOKID (VMS V5.4).
	!
	!======================================================================
	!
	! Set up system services
	OPTION TYPE = EXPLICIT
	EXTERNAL LONG FUNCTION	LIB$GET_FOREIGN,	&
				LIB$STOP,		&
				LIB$SIGNAL,		&
				SYS$GETJPIW,		&
				SYS$GETUAI,		&
				SYS$ASCTOID,		&
				SYS$IDTOASC,		&
				SYS$FIND_HOLDER,	&
				SYS$ADD_HOLDER,		&
				SYS$REM_HOLDER,		&
				SYS$PROCESS_SCAN,	&
				SYS$GRANTID,		&
				SYS$REVOKID,		&
				SYS$FAO,		&
				SOR$BEGIN_SORT,		&
				SOR$RELEASE_REC,	&
				SOR$SORT_MERGE,		&
				SOR$RETURN_REC,		&
				SOR$END_SORT
	!
	%INCLUDE "$SSDEF" %FROM %LIBRARY "SYS$LIBRARY:BASIC$STARLET.TLB"
	%INCLUDE "$JPIDEF" %FROM %LIBRARY "SYS$LIBRARY:BASIC$STARLET.TLB"
	%INCLUDE "$KGBDEF" %FROM %LIBRARY "SYS$LIBRARY:BASIC$STARLET.TLB"
	%INCLUDE "$UAIDEF" %FROM %LIBRARY "SYS$LIBRARY:BASIC$STARLET.TLB"
	%INCLUDE "$PSCANDEF" %FROM %LIBRARY "SYS$LIBRARY:BASIC$STARLET.TLB"
	%INCLUDE "$SORDEF" %FROM %LIBRARY "SYS$LIBRARY:BASIC$STARLET.TLB"
	%INCLUDE "$DSCDEF" %FROM %LIBRARY "SYS$LIBRARY:BASIC$STARLET.TLB"
	!
	DECLARE LONG	STAT, RET_LENGTH
	DECLARE LONG CONSTANT BUF_LENGTH = 255%
	MAP(FIXED_STRING) STRING RET_STRING = BUF_LENGTH
	DECLARE LONG CONSTANT FATAL = 268435460%
	DECLARE STRING NODES
	!
	RECORD ITMLST
	    GROUP ITEM(2)
		VARIANT
		    CASE
			WORD	BUFFER_LEN
			WORD	ITEM_CODE
			LONG	BUFFER_ADDR
			LONG	LENGTH_ADDR
		    CASE
			LONG	TERMINATOR
		END VARIANT
	    END GROUP
	END RECORD
	!
	DECLARE STRING	COMMAND_LINE,		&
			PROMPT_STR,		&
		WORD	OUT_LEN
	!
	DECLARE STRING	ID_NAME,		&
		LONG	RIGHTS_ID,		&
			ID_ATTRIB
	!
	DECLARE	LONG	PROCESS_ID
	DECLARE ITMLST	ITEM_LIST
	DECLARE	LONG	IOSB(1%)
	DECLARE LONG	PROC_RIGHTS(128%)
	!
	MAP(RIGHTS_HOLDER)			&
		LONG	UIC,			&
		LONG	ZERO
	DECLARE	LONG	CONTEXT
	!
	DECLARE	STRING	USERNAME	
	!
	DECLARE	WORD	KEYBUFFER(4%),		&
			RECLENGTH,		&
		BYTE	WORKFILES		
	!
	!======================================================================
	! Misc declarations
	DECLARE STRING	QUALIFIER,		&
			COMMAND,		&
			PROJECT,		&
			PROJ_MASTER,		&
			MASTER_USER,		&
			PID,			&
			ANS,			&
		LONG	NOW,			&
			NOTNOW,			&
			SURE,			&
			BOUNCER,		&			
			NUMRECORDS,		&
			X, Y, Z
	!
	!======================================================================
	! Initialize some variables
	ZERO = 0%
	NOW = 0%
	NOTNOW = 0%
	SURE = 0%
	!NODES = "ADMIN*"
	!
	! Parse command line.  Find identifier name to grant/revoke, etc.
	!
	PROMPT_STR = "_Command: "
	!
	STAT = LIB$GET_FOREIGN(COMMAND_LINE,PROMPT_STR,OUT_LEN,)
	CALL LIB$STOP(STAT BY VALUE) IF (STAT AND 1%) = 0%
	!
	IF OUT_LEN = 0%
	    THEN
		PRINT "%MASTER-F-NOCMD, no command"
		CALL LIB$STOP(FATAL BY VALUE)
	END IF
	COMMAND_LINE = EDIT$(COMMAND_LINE,4%+8%+16%+32%+128%)
	!
	! Start our primitive parse of the command line
	Y = POS(COMMAND_LINE,"/",0%)		! First slash (/)
	WHILE Y <> 0%				! While there are /'s
	Z = POS(COMMAND_LINE,"/",Y+1%)		! Next / after Y
	X = POS(COMMAND_LINE," ",Y+1%)		! Next space after Y
	IF (Z = 0%) THEN Z = X \ END IF		! If no /, end @ space
	IF (X <> 0%) AND (X < Z) THEN Z = X \ END IF ! Space before /, end@space
	Z = LEN(COMMAND_LINE) + 1% IF Z = 0%	! No space or slash, end @ end+1
	QUALIFIER = SEG$(COMMAND_LINE,Y+1%,Z-1%) ! Extract qualifier
	COMMAND_LINE = LEFT$(COMMAND_LINE,Y-1%) + RIGHT$(COMMAND_LINE,Z)
	SELECT QUALIFIER
		CASE "NOW"
		    NOW = -1%
		    NOTNOW = 0%
		CASE "NOT" TO "NOTNOW"
		    NOTNOW = -1%
		    NOW = 0%
		CASE "SU" TO "SURE"
		    SURE = -1%
		CASE ELSE
		    PRINT "%MASTER-W-UNK, unknown qualifier: ";QUALIFIER
		END SELECT		
	Y = POS(COMMAND_LINE,"/",0%)		! Find remaining /'s
	NEXT 					! Y <> 0%; /'s to parse
	!
	COMMAND_LINE = EDIT$(COMMAND_LINE,8%+16%+128%)
	IF LEN(COMMAND_LINE) = 0%
	    THEN
		PRINT "%MASTER-F-NOCMD, no command"
		CALL LIB$STOP(FATAL BY VALUE)
	END IF
	X = POS(COMMAND_LINE," ",1%)		! First space
	X = LEN(COMMAND_LINE) + 1% IF X = 0%	! Only thing left
	COMMAND = LEFT$(COMMAND_LINE,X-1%)	! Command
	COMMAND_LINE = RIGHT$(COMMAND_LINE,X+1%)
	X = POS(COMMAND_LINE," ",1%)		! Next space
	X = LEN(COMMAND_LINE) + 1% IF X = 0%	! Only thing left
	ID_NAME = LEFT$(COMMAND_LINE,X-1%)	! Identifier name
	COMMAND_LINE = RIGHT$(COMMAND_LINE,X+1%)
	X = POS(COMMAND_LINE," ",1%)		! Next space
	X = LEN(COMMAND_LINE) + 1% IF X = 0%	! Only thing left
	USERNAME = LEFT$(COMMAND_LINE,X-1%)	! Username
	!
	!======================================================================
	! Construct the proj_MASTER identifier and use SYS$ASCTOID to convert
	! to ID.
	X = POS(ID_NAME,"_",1%)			! Underscore
	PROJECT = LEFT$(ID_NAME,X-1%)		! Project
	IF PROJECT = ""
	    THEN
		PRINT "%MASTER-F-NOID, no valid identifier specified"
		CALL LIB$STOP(FATAL BY VALUE)
	END IF
	PROJ_MASTER = PROJECT + "_MASTER"	! Project master
	STAT = SYS$ASCTOID(PROJ_MASTER BY DESC,	&
	                   RIGHTS_ID BY REF,	&
	                   ID_ATTRIB BY REF)
	CALL LIB$STOP(STAT BY VALUE) IF (STAT AND 1%) = 0%
	!
	! Use SYS$GETJPIW to get the invoker's username and process rights.
	ITEM_LIST::ITEM(0)::BUFFER_LEN	= BUF_LENGTH
	ITEM_LIST::ITEM(0)::ITEM_CODE	= JPI$_USERNAME
	ITEM_LIST::ITEM(0)::BUFFER_ADDR = LOC(RET_STRING)
	ITEM_LIST::ITEM(0)::LENGTH_ADDR = LOC(RET_LENGTH)
	ITEM_LIST::ITEM(1)::BUFFER_LEN	= 512%
	ITEM_LIST::ITEM(1)::ITEM_CODE	= JPI$_PROCESS_RIGHTS
	ITEM_LIST::ITEM(1)::BUFFER_ADDR	= LOC(PROC_RIGHTS(1%))
	ITEM_LIST::ITEM(1)::LENGTH_ADDR = LOC(PROC_RIGHTS(0%))
	ITEM_LIST::ITEM(2)::TERMINATOR  = 0%
	PROCESS_ID = 0%
	STAT = SYS$GETJPIW(,PROCESS_ID BY REF,,	&
	                   ITEM_LIST BY REF,	&
	                   IOSB(0%) BY REF,,)
	CALL LIB$STOP(STAT BY VALUE) IF (STAT AND 1%) = 0%
	CALL LIB$STOP(IOSB(0%) BY VALUE) IF (IOSB(0%) AND 1%) = 0%
	MASTER_USER = LEFT$(RET_STRING,RET_LENGTH)
	PROC_RIGHTS(0%) = PROC_RIGHTS(0%)/8%
	BOUNCER = -1%
	CHECK_ID:
	FOR X = 1 TO PROC_RIGHTS(0%)
	Y = 2%*X - 1%
	IF PROC_RIGHTS(Y) = RIGHTS_ID
	    THEN
		BOUNCER = 0%
		EXIT CHECK_ID
	END IF
	NEXT X
	IF BOUNCER
	    THEN
		PRINT "%MASTER-F-NOTMASTER, you don't hold " + PROJ_MASTER
		CALL LIB$STOP(FATAL BY VALUE)
	END IF
 ! Log the following information:
 ! date and time, MASTER username, grant/revoke, identifier, username
 ! DATE$          MASTER_USER      COMMAND       ID_NAME     USERNAME
	OPEN "MASTER_LOG:" AS FILE #1, ACCESS APPEND, ALLOW MODIFY
	PRINT #1, DATE$(0%) + " " + TIME$(0%) + " " + MASTER_USER + " " + &
		COMMAND + " " + ID_NAME + " " + USERNAME
	CLOSE #1
	!PRINT "Invoker's username: " + MASTER_USER
	!
	!======================================================================
	! Convert parsed identifier to ID
	STAT = SYS$ASCTOID(ID_NAME BY DESC,	&
	                   RIGHTS_ID BY REF,	&
	                   ID_ATTRIB BY REF)
	CALL LIB$STOP(STAT BY VALUE) IF (STAT AND 1%) = 0%
	!
	! Get parsed username's UIC.
	IF USERNAME = "" THEN GOTO DO_COMMAND \ END IF
	ITEM_LIST::ITEM(0)::BUFFER_LEN	= 4%
	ITEM_LIST::ITEM(0)::ITEM_CODE	= UAI$_UIC
	ITEM_LIST::ITEM(0)::BUFFER_ADDR = LOC(UIC)
	ITEM_LIST::ITEM(0)::LENGTH_ADDR = LOC(RET_LENGTH)
	ITEM_LIST::ITEM(1)::TERMINATOR  = 0%
	STAT = SYS$GETUAI(,,USERNAME BY DESC,ITEM_LIST BY REF,,,)
	CALL LIB$STOP(STAT BY VALUE) IF (STAT AND 1%) = 0%
	!
	DO_COMMAND:
	SELECT COMMAND
	    CASE "L" TO "LIST"
		! We will get and sort the list of usernames holding the id
		CONTEXT = 0%
		STAT = 0%
		NUMRECORDS = 0%
		KEYBUFFER(0%) = 1%		! One key
		KEYBUFFER(1%) = DSC$K_DTYPE_T	! Text key
		KEYBUFFER(2%) = 0%		! Ascending order
		KEYBUFFER(3%) = 0%		! Offset in record
		KEYBUFFER(4%) = 32%		! Key size
		RECLENGTH = 32%			! Record size
		WORKFILES = 0%			! Sort in memory
		! Set up the sort
		STAT = SOR$BEGIN_SORT(KEYBUFFER(0%) BY REF,	&
		                      RECLENGTH BY REF,,,,,,	&
		                      WORKFILES BY REF,)
		CALL LIB$STOP(STAT BY VALUE) IF (STAT AND 1%) = 0%
		! Find the holders
		WHILE STAT <> SS$_NOSUCHID
		STAT = SYS$FIND_HOLDER(RIGHTS_ID BY VALUE,	&
		                       UIC BY REF,		&
		                       ID_ATTRIB BY REF,	&
		                       CONTEXT BY REF)
		IF STAT = SS$_NOSUCHID THEN ITERATE \ END IF
		CALL LIB$STOP(STAT BY VALUE) IF (STAT AND 1%) = 0%
		! Translate the UIC to ASCII
		STAT = SYS$IDTOASC(UIC BY VALUE,		&
		                   RET_LENGTH BY REF,		&
		                   RET_STRING BY DESC,		&
		                   ,,,)
		CALL LIB$STOP(STAT BY VALUE) IF (STAT AND 1%) = 0%
		USERNAME = LEFT$(RET_STRING,RET_LENGTH) + SPACE$(32%-RET_LENGTH)
		NUMRECORDS = NUMRECORDS + 1%
		! Pass the username to the sort routine
		STAT = SOR$RELEASE_REC(USERNAME BY DESC,)
		CALL LIB$STOP(STAT BY VALUE) IF (STAT AND 1%) = 0%
		NEXT	! STAT <> SS$_NOSUCHID
		PRINT "%MASTER-I-LIST, listing"; NUMRECORDS;	&
			"users holding " + ID_NAME
		! Actually do the sort
		STAT = SOR$SORT_MERGE()
		CALL LIB$STOP(STAT BY VALUE) IF (STAT AND 1%) = 0%
		! Print the list
		FOR X = 1 TO NUMRECORDS
		STAT = SOR$RETURN_REC(RET_STRING BY DESC,	&
		                      RECLENGTH BY REF,)
		USERNAME = EDIT$(LEFT$(RET_STRING,RECLENGTH),2%)
		PRINT USERNAME
		NEXT X
		STAT = SOR$END_SORT()
		CALL LIB$STOP(STAT BY VALUE) IF (STAT AND 1%) = 0%
	    CASE "G" TO "GRANT"
		!
		! If the ID is the MASTER one, make sure of the change
		IF ID_NAME = PROJ_MASTER
		    THEN
			IF NOT SURE
			    THEN
				PRINT "Are you SURE you wish to grant " + &
					PROJ_MASTER + " to " + USERNAME;
				INPUT ANS
				ANS = EDIT$(ANS,2%+4%+32%)
				IF ANS <> "Y" AND ANS <> "YES"
				    THEN
					PRINT "%MASTER-F-NOTSURE, aborting"
					CALL LIB$STOP(FATAL BY VALUE)
				END IF
			END IF
		END IF
		! Use SYS$ADD_HOLDER to grant the identifier.
		STAT = SYS$ADD_HOLDER(RIGHTS_ID BY VALUE,	&
		                      UIC BY REF,		&
		                      ID_ATTRIB BY VALUE)
		CALL LIB$STOP(STAT BY VALUE) IF (STAT AND 1%) = 0%
		PRINT "%MASTER-I-GRANT, granted " + ID_NAME + " to " + USERNAME
		IF NOTNOW THEN GOTO THE_END \ END IF
		ITEM_LIST::ITEM(0)::BUFFER_LEN	= 0%
		ITEM_LIST::ITEM(0)::ITEM_CODE	= PSCAN$_UIC
		ITEM_LIST::ITEM(0)::BUFFER_ADDR = UIC
		ITEM_LIST::ITEM(0)::LENGTH_ADDR = PSCAN$M_EQL
		!Commented out because $GRANTID doesn't work cluster-wide
		!RET_STRING = NODES
		!ITEM_LIST::ITEM(1)::BUFFER_LEN	= LEN(NODES)
		!ITEM_LIST::ITEM(1)::ITEM_CODE	= PSCAN$_NODENAME
		!ITEM_LIST::ITEM(1)::BUFFER_ADDR = LOC(RET_STRING)
		!ITEM_LIST::ITEM(1)::LENGTH_ADDR = PSCAN$M_WILDCARD
		!ITEM_LIST::ITEM(2)::TERMINATOR  = 0%
		ITEM_LIST::ITEM(1)::TERMINATOR  = 0%
		STAT = SYS$PROCESS_SCAN(CONTEXT BY REF,	&
		                        ITEM_LIST BY REF)
		CALL LIB$SIGNAL(STAT BY VALUE) IF (STAT AND 1%) = 0%
		ITEM_LIST::ITEM(0)::BUFFER_LEN	= 4%
		ITEM_LIST::ITEM(0)::ITEM_CODE	= JPI$_PID
		ITEM_LIST::ITEM(0)::BUFFER_ADDR = LOC(PROCESS_ID)
		ITEM_LIST::ITEM(0)::LENGTH_ADDR = LOC(RET_LENGTH)
		ITEM_LIST::ITEM(1)::TERMINATOR  = 0%
		WHILE STAT <> SS$_NOMOREPROC
		STAT = SYS$GETJPIW(,CONTEXT BY REF,,	&
		                   ITEM_LIST BY REF,	&
		                   IOSB(0%) BY REF,,)
		IF STAT = SS$_NOMOREPROC THEN ITERATE \ END IF
		CALL LIB$STOP(STAT BY VALUE) IF (STAT AND 1%) = 0%
		CALL LIB$STOP(IOSB(0%) BY VALUE) IF (IOSB(0%) AND 1%) = 0%
		STAT = SYS$GRANTID(PROCESS_ID BY REF,,	&
		                   RIGHTS_ID BY REF,,)
		CALL LIB$SIGNAL(STAT BY VALUE) IF (STAT AND 1%) = 0%
		STAT = SYS$FAO("!XL",RET_LENGTH BY REF,	&
		               RET_STRING BY DESC,	&
		               PROCESS_ID BY VALUE)
		CALL LIB$SIGNAL(STAT BY VALUE) IF (STAT AND 1%) = 0%
		PID = LEFT$(RET_STRING,RET_LENGTH)
		PRINT "%MASTER-I-GRANT, updated process ";PID
		NEXT ! STAT <> SS$_NOMOREPROC
	    CASE "R" TO "REVOKE"	
		!
		! If the ID is the MASTER one, make sure of the change
		IF ID_NAME = PROJ_MASTER
		    THEN
			IF NOT SURE
			    THEN
				PRINT "Are you SURE you wish to revoke " + &
					PROJ_MASTER + " from " + USERNAME;
				INPUT ANS
				ANS = EDIT$(ANS,2%+4%+32%)
				IF ANS <> "Y" AND ANS <> "YES"
				    THEN
					PRINT "%MASTER-F-NOTSURE, aborting"
					CALL LIB$STOP(FATAL BY VALUE)
				END IF
			END IF
		END IF
		! Use SYS$REM_HOLDER to revoke the identifier.
		STAT = SYS$REM_HOLDER(RIGHTS_ID BY VALUE,	&
		                      UIC BY REF)
		CALL LIB$STOP(STAT BY VALUE) IF (STAT AND 1%) = 0%
		PRINT "%MASTER-I-REVOKE, revoked " + ID_NAME + " from " + &
			USERNAME
		IF NOT NOW THEN GOTO THE_END \ END IF
		ITEM_LIST::ITEM(0)::BUFFER_LEN	= 0%
		ITEM_LIST::ITEM(0)::ITEM_CODE	= PSCAN$_UIC
		ITEM_LIST::ITEM(0)::BUFFER_ADDR = UIC
		ITEM_LIST::ITEM(0)::LENGTH_ADDR = PSCAN$M_EQL
		!Commented out because $REVOKID doesn't work cluster-wide
		!RET_STRING = NODES
		!ITEM_LIST::ITEM(1)::BUFFER_LEN	= LEN(NODES)
		!ITEM_LIST::ITEM(1)::ITEM_CODE	= PSCAN$_NODENAME
		!ITEM_LIST::ITEM(1)::BUFFER_ADDR = LOC(RET_STRING)
		!ITEM_LIST::ITEM(1)::LENGTH_ADDR = PSCAN$M_WILDCARD
		!ITEM_LIST::ITEM(2)::TERMINATOR  = 0%
		ITEM_LIST::ITEM(1)::TERMINATOR  = 0%
		STAT = SYS$PROCESS_SCAN(CONTEXT BY REF,	&
		                        ITEM_LIST BY REF)
		CALL LIB$STOP(STAT BY VALUE) IF (STAT AND 1%) = 0%
		ITEM_LIST::ITEM(0)::BUFFER_LEN	= 4%
		ITEM_LIST::ITEM(0)::ITEM_CODE	= JPI$_PID
		ITEM_LIST::ITEM(0)::BUFFER_ADDR = LOC(PROCESS_ID)
		ITEM_LIST::ITEM(0)::LENGTH_ADDR = LOC(RET_LENGTH)
		ITEM_LIST::ITEM(1)::TERMINATOR  = 0%
		WHILE STAT <> SS$_NOMOREPROC
		STAT = SYS$GETJPIW(,CONTEXT BY REF,,	&
		                   ITEM_LIST BY REF,	&
		                   IOSB(0%) BY REF,,)
		IF STAT = SS$_NOMOREPROC THEN ITERATE \ END IF
		CALL LIB$STOP(STAT BY VALUE) IF (STAT AND 1%) = 0%
		CALL LIB$STOP(IOSB(0%) BY VALUE) IF (IOSB(0%) AND 1%) = 0%
		STAT = SYS$REVOKID(PROCESS_ID BY REF,,	&
		                   RIGHTS_ID BY REF,,)
		CALL LIB$SIGNAL(STAT BY VALUE) IF (STAT AND 1%) = 0%
		STAT = SYS$FAO("!XL",RET_LENGTH BY REF,	&
		               RET_STRING BY DESC,	&
		               PROCESS_ID BY VALUE)
		CALL LIB$SIGNAL(STAT BY VALUE) IF (STAT AND 1%) = 0%
		PID = LEFT$(RET_STRING,RET_LENGTH)
		PRINT "%MASTER-I-REVOKE, updated process ";PID
		NEXT ! STAT <> SS$_NOMOREPROC
	    CASE ELSE
		PRINT "%MASTER-F-UNKCMD, unknown command: " + COMMAND
		CALL LIB$STOP(FATAL BY VALUE)
	    END SELECT
	THE_END:
	END