PROGRAM USER_ACCESS_CHECKER
C
C++UAC.FOR
C
C Facility: 
C	System management utility for VMS Turnkey Accounts.
C	Fermilab Accelerator Control System.
C
C Abstract:
C	This program implements maintenance and checking of the file of user
C	names and hashed passwords suitable for providing secure access to
C	turnkey accounts.
C
C Environment:
C	Called as a DCL foreign command from command procedures used to
C	implement (secure) turnkey accounts.
C--
C
C Author: F. Nagy
C Modification History:
C V0.0	24-Feb-84  FJN	Created for PLA account and for possible use in
C			securing control system turnkey accounts in the world
C			of port selectors and DECnet.
C V1.0	13-Mar-84  FJN	First working version for actual usage
C V1.1	13-Mar-84  FJN	Added UAC_PROMPT support and single line EDIT mode.
C V1.2	14-Mar-84  FJN	Must open UAC file in EDIT routines before trying to
C			use information in /FILE/!
C V2.0	16-Mar-84  FJN	Added extra text, redid EDIT_xxx routines, added
C			EDIT-mode COPY command, etc. etc. etc...
C
	CHARACTER*(*) version
	PARAMETER (version = 'V2.0')
C
C+0Main Program
C
C Functional Description:
C	Check that SYS$COMMAND is a terminal and assign an I/O channel to same.
C	Partially decode the foreign command line to check the action and then
C	call the action subsystem routine.
C
C Calling Sequence:
C	$ UAC := $FERMI$UTIL:UAC
C	$ UAC action-keyword [parameters...]
C
C	Enter EDIT mode to maintain access file:
C	$ UAC EDIT
C	UAC-EDIT> command
C
C	Enter EDIT mode for single command:
C	$ UAC EDIT command
C
C	Prompt for username and password and check access file:
C	$ UAC CHECK usersym [label]
C
C	Change password of specified user:
C	$ UAC CHANGE user
C
C	Get extra text associated with a user:
C	$ UAC GETTEXT user textsym
C
C Side Effects:
C	The password file is given by the logical name UACFILE or defaults to
C	"SYS$DISK:UACFILE.DAT".  When used in CHECK mode, an optional parameter
C	specifies a DCL label to "GOTO" on an access failure, otherwise UAC
C	prints a message and returns an Error severity.  All input of passwords
C	is done with no echoing on the terminal.
C
C	The logical name UAC_HELPLIB must be defined (as SYS$HELP:FERMIHELP)
C	for the EDIT mode HELP command to function.
C
C	If the logical name UAC_PROMPT is defined, then its equivalence string
C	is used as the CHECK mode username prompt.  If the logical name is not
C	defined, the prompt string used is "Username: ".
C-
	INCLUDE	'FERMI$LIB:LCLFORDEF($DVIDEF)/NOLIST'
	INCLUDE	'SYS$LIBRARY:FORSYSDEF($DCDEF)/NOLIST'
C
	COMMON /TERMINAL/ ttchan
	INTEGER*2 ttchan		!Terminal I/O channel
C	
	EXTERNAL UAC__FATAL, UAC__NOTATERM, UAC__NOACTION
	EXTERNAL UAC__UNKACTION, UAC__INSFPARM
C
	INTEGER*4 SYS$ASSIGN		!Assign I/O channel system service
	INTEGER*4 SYS$GETDVI		!Get Device Information service
	INTEGER*4 LIB$GET_FOREIGN	!Get foreign command line routine
	INTEGER*4 LIB$LOCC		!Locate character in string
C
	INTEGER*4 status		!Completion status
	INTEGER*4 items(4)		!$GETDVI item list
	INTEGER*2 items_1(2)
	EQUIVALENCE (items_1,items)
	INTEGER*4 class			!Device class code return
	CHARACTER*255 line		!Foreign line buffer
	INTEGER*2 l_line		!Length of foreign line
	INTEGER*2 l_action		!Length of action keyword
C
C Setup Item code list for $GETDVI to get SYS$COMMAND device class.
C
	items_1(1) = 4			!Return buffer size
	items_1(2) = DVI$_DEVCLASS	!Device class
	items(2) = %LOC( class)		!Return buffer for class code
	items(3) = 0			!No return length
	items(4) = 0			!List terminator
C
C Assign I/O channel to SYS$COMMAND and check for terminal.
C
	status = SYS$ASSIGN( 'SYS$COMMAND:', ttchan,,)
	IF (.NOT. status)
	1	CALL LIB$STOP( UAC__FATAL, %VAL(0), %VAL(status))
	status = SYS$GETDVI(, %VAL(ttchan),, items,,,,)
	IF (.NOT. status)
	1	CALL LIB$STOP( UAC__FATAL, %VAL(0), %VAL(status))
	IF (class .NE. DC$_TERM) CALL LIB$STOP( UAC__NOTATERM)
C
C Get foreign command line and search for space separating action keyword
C from the parameters.
C
	status = LIB$GET_FOREIGN( line,, l_line)
	IF (.NOT. status)
	1	CALL LIB$STOP( UAC__FATAL, %VAL(0), %VAL(status))
	IF (l_line .EQ. 0) CALL LIB$STOP( UAC__NOACTION)
	l_action = LIB$LOCC( ' ', line(1:l_line))
	IF (l_action .EQ. 0) l_action = l_line	!Just keyword on line
C
C Check action code and call the subsystem routine for it.
C
	IF (line(1:l_action) .EQ. 'EDIT') THEN
	    IF (l_action .GE. l_line) THEN
		CALL UAC_EDITOR( '*')		!Multi-mode
		ELSE
		CALL UAC_EDITOR( line(l_action+1:l_line))
		ENDIF
	    ELSE IF (line(1:l_action) .EQ. 'CHECK') THEN
	    IF (l_action .GE. l_line) CALL LIB$STOP( UAC__INSFPARM)
	    CALL UAC_CHECKER( line(l_action+1:l_line))
C
	    ELSE IF (line(1:l_action) .EQ. 'CHANGE') THEN
	    IF (l_action .GE. l_line) CALL LIB$STOP( UAC__INSFPARM)
	    CALL UAC_CHANGE( line(l_action+1:l_line))
C
	    ELSE IF (line(1:l_action) .EQ. 'GETTEXT') THEN
	    IF (l_action .GE. l_line) CALL LIB$STOP( UAC__INSFPARM)
	    CALL UAC_GETTEXT( line(l_action+1:l_line))
C
	    ELSE
	    CALL LIB$STOP( UAC__UNKACTION)
	    ENDIF
C
	END
	INTEGER*4 FUNCTION ACCESS_CHECK( username, prompt)
C
	CHARACTER*(*) username, prompt
C
C+/ACCESS_CHECK
C
C Functional Description:
C	Prompt for password input and check against UAC file for the specified
C	user name.
C
C Input Parameters:
C	username - user name key to access file.
C	prompt - prompt string for user
C
C Implicit Inputs:
C	NONE
C
C Output Parameters:
C	Returns completion condition code:
C		SS$_NORMAL	success, access permitted
C		UAC__INCPASSWD	failure, incorrect password
C		UAC__UNATHUSR	failure, unauthorized user
C
C Implicit Outputs:
C	NONE
C
C Side Effects:
C	NONE
C-
	INCLUDE	'UAC.INC'
C
					!Password text
	CHARACTER*(UAC_K_PWDMAX) password
	INTEGER*2 l_pwd			!Length of password text
	INTEGER*4 test_pwd		!Password text hashed to 32-bits
	INTEGER*4 filed_pwd		!Stored hashed password
	INTEGER*4 HASH_CODER		!Routine to hash a password
	LOGICAL*4 READ_UACFILE		!Routine to read access file
	EXTERNAL  SS$_NORMAL		!Success return
	EXTERNAL  UAC__INCPASSWD	!Failure return, password mismatch
	EXTERNAL  UAC__UNATHUSR		!Failure return, no such user
C
C Read stored password from access file.
C
	IF (READ_UACFILE( username, filed_pwd)) THEN
C
C Check for non-blank password, if so prompt for and check what the user
C believes is his password.
C
	    IF (filed_pwd .NE. 0) THEN
C
C Get password from user w/o echoing it.
C
		CALL ASK_USER( prompt, .FALSE., .NOT.lcpwd,
	1		       password, l_pwd)
C
C Hash the password to a 32-bit number.
C
		test_pwd = HASH_CODER( password(1:l_pwd))
C
C Got record from file, compare test and stored passwords.
C
		IF (test_pwd .EQ. filed_pwd) THEN
		    ACCESS_CHECK = %LOC(SS$_NORMAL)
		    ELSE
		    ACCESS_CHECK = %LOC(UAC__INCPASSWD)
		    ENDIF
		ELSE
C
C Access file has blank password, no need to prompt for one.
C
		ACCESS_CHECK = %LOC(SS$_NORMAL)
		ENDIF
	    ELSE
C
C No such username appears in the access file...
C
	    ACCESS_CHECK = %LOC(UAC__UNATHUSR)
	    ENDIF
C
	RETURN
	END
	SUBROUTINE  ASK_USER( prompt, echo, cvtlc, answer, l_answer)
C
	CHARACTER*(*) prompt
	LOGICAL*1 echo, cvtlc
	CHARACTER*(*) answer
	INTEGER*2 l_answer
C
C+/ASK_USER
C
C Functional Description:
C	Used in CHECK and CHANGE modes to ask question to user on SYS$COMMAND.
C
C Input Parameters:
C	prompt - user prompt text string
C	echo - TRUE if user's answer is to be echoed, FALSE if answer is not to
C	       be echoed (used for password input).
C	cvtlc - TRUE if lowercase characters are to be converted to uppercase.
C
C Implicit Inputs:
C	ttchan - terminal I/O channel
C
C Output Parameters:
C	answer - text string answer returned by the user
C	l_answer - length of answer text string
C
C Implicit Outputs:
C	NONE
C
C Side Effects:
C	All echoed input is converted to uppercase and trailing blanks are
C	removed.  Unechoed input may contain lowercase characters but will
C	not contain trailing spaces.
C-
	INCLUDE	'SYS$LIBRARY:FORSYSDEF($IODEF)/NOLIST'
C
	COMMON /TERMINAL/ ttchan
	INTEGER*2 ttchan		!Terminal I/O channel
C	
	INTEGER*4 io_echo		!I/O function code with echoing
	PARAMETER (io_echo = IOR( IO$_READPROMPT, IO$M_CVTLOW))
	INTEGER*4 io_noecho		!I/O function code with no echo
	PARAMETER (io_noecho = IOR( IO$_READPROMPT, IO$M_NOECHO))
	EXTERNAL UAC__FATAL		!Fatal error
C
	INTEGER*4 status		!Completion status
	INTEGER*4 SYS$QIOW		!System I/O service
	INTEGER*4 iofcn			!I/O function code
	INTEGER*2 iosb(4)		!I/O status return block
C
	IF (echo) THEN
	    iofcn = io_echo
	    ELSE
	    iofcn = io_noecho
	    IF (cvtlc) iofcn = IOR( iofcn, IO$M_CVTLOW)
	    ENDIF
C
	status = SYS$QIOW(, %VAL(ttchan), %VAL(iofcn), iosb,,,
	1		  %REF(answer), %VAL(LEN(answer)),,,
	2		  %REF(prompt), %VAL(LEN(prompt)))
C
	IF (.NOT. status)
	1	CALL LIB$STOP( UAC__FATAL, %VAL(0), %VAL(status))
	IF (.NOT. iosb(1))
	1	CALL LIB$STOP( UAC__FATAL, %VAL(0), %VAL(iosb(1)))
C
	l_answer = iosb(2)		!Input length w/o terminator
C
C Remove any trailing spaces...
C
	CALL STR$TRIM( answer, answer(1:l_answer), l_answer)
C
	RETURN
	END
	INTEGER*4 FUNCTION EDIT_ADD
C
C+/EDIT_ADD
C
C Functional Description:
C	Process the EDIT mode ADD directive to add a new user to the password
C	file.
C
C Input Parameters:
C	NONE
C
C Implicit Inputs:
C	uacfile - unit on which access file has been opened.
C	reclen - access file record length
C
C Output Parameters:
C	NONE
C
C Implicit Outputs:
C	record - record written to access file.
C
C Side Effects:
C	NONE
C-
	INCLUDE	'UAC.INC'
	CHARACTER*(*) OK_CHARS		!Legal characters for username
	PARAMETER (OK_CHARS = '$_0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ')
C
	EXTERNAL  SS$_NORMAL		!Success code
					!User name/access file key
	CHARACTER*(UAC_K_KEYMAX) username
					!Password text
	CHARACTER*(UAC_K_PWDMAX) password
	CHARACTER*(UAC_K_TXTMAX) text	!Extra text field
	INTEGER*2 l_un			!Length of username
	INTEGER*2 l_pwd			!Length of password text
	LOGICAL*4 READ_UACFILE		!Check for username in file
	EXTERNAL  UAC__USRTOOLNG, UAC__USRALRDY, UAC__INVUSRNAM
	INTEGER*4 HASH_CODER		!Hash coding function
	INTEGER*4 LIB$LOCC		!Character search
	LOGICAL*4 CLI$GET_VALUE		!Get command line value
	LOGICAL*4 CLI$PRESENT		!Test for qualifier present
	INTEGER*4 hashed		!Hashed password
C
	IF (uacfile .EQ. 0) CALL OPEN_UACFILE
C
C Get username from command line, check length and characters.
C
	CALL CLI$GET_VALUE( 'USERNAME', username)
	CALL STR$TRIM( username, username, l_un)
	DO l_pwd = 1, l_un
	    IF (LIB$LOCC( username(l_pwd:l_pwd), OK_CHARS) .EQ. 0) THEN
		EDIT_ADD = %LOC(UAC__INVUSRNAM)
		RETURN
		ENDIF
	    ENDDO
	IF (l_un .LE. namelen) THEN
	    l_un = namelen		!Space pad short keys
	    ELSE
	    CALL LIB$SIGNAL(UAC__USRTOOLNG, %VAL(1), %VAL(namelen))
	    l_un = namelen		!Truncate long name
	    ENDIF
C
C Get password from /PASSWORD qualifier
C
	IF (CLI$PRESENT( 'PASSWORD')) THEN
	    IF (CLI$GET_VALUE( 'PASSWORD', password)) THEN
		CALL STR$TRIM( password, password, l_pwd)
		IF (.NOT.lcpwd)
	1	    CALL STR$UPCASE( password, password(1:l_pwd))
		ELSE
		l_pwd = 0		!/PASSWORD w/o value for blank
		ENDIF
	    ELSE
	    l_pwd = 0			!No /PASSWORD, use blank password
	    ENDIF
C
C Get extra text from /TEXT qualifier
C
	IF ((textlen .GT. 0) .AND. CLI$PRESENT( 'TEXT'))
	1	CALL CLI$GET_VALUE( 'TEXT', text)
C
	IF (READ_UACFILE( username(1:l_un), hashed)) THEN
C
C Username already in access file, do not permit ADD
C
	    EDIT_ADD = %LOC(UAC__USRALRDY)
	    ELSE
C
C Username not found, hash password and write record with access count of 0.
C
	    IF (l_pwd .EQ. 0) THEN
		hashed = 0		!No password
		ELSE
		hashed = HASH_CODER( password(1:l_pwd))
		ENDIF
	    CALL LIB$MOVC3( 4, hashed, %REF(record(UAC_L_HPWD:)))
	    CALL LIB$MOVC3( 4, 0, %REF(record(UAC_L_ACNT:)))
	    record(UAC_T_NAME:) = username(1:l_un)
	    IF (textlen .GT. 0) record(textbeg:) = text(1:textlen)
C
	    WRITE (UNIT=uacfile, FMT='(A)') record(1:reclen)
	    EDIT_ADD = %LOC(SS$_NORMAL)
	    ENDIF
C
	RETURN
	END
	INTEGER*4 FUNCTION EDIT_COPY
C
C+/EDIT_COPY
C
C Functional Description:
C	Process the EDIT mode COPY directive to copy user records from one
C	access file to another.
C
C Input Parameters:
C	NONE
C
C Implicit Inputs:
C	NONE
C
C Output Parameters:
C	Returns status.
C		SS$_NORMAL	success
C		UAC__FILDATERR	file data error in secondary input file
C
C Implicit Outputs:
C	NONE
C
C Side Effects:
C	Secondary file opened READONLY so records will not be locked.
C-
	INCLUDE	'UAC.INC'
C
	LOGICAL*4 READ_KEYED		!Read file record, keyed
	LOGICAL*4 READ_SEQ		!Read file record, sequential
	EXTERNAL  UAC__FILDATERR	!Returned if no data record
	EXTERNAL  UAC__USRNOTIN		!Returned if user not found
	EXTERNAL  SS$_NORMAL		!Success code
	LOGICAL*4 CLI$GET_VALUE		!Get command line argument
	LOGICAL*2 CLI$PRESENT		!Check for qualifier present/negated
	CHARACTER*63 file		!File specification...
	INTEGER*2 if_reclen		!Record length for secondary input file
	INTEGER*2 if_namelen		!Key length for secondary file
	INTEGER*2 if_textlen		!Extra text length for secondary file
	INTEGER*2 if_keyend		!Key end position in secondary file
	INTEGER*2 if_textbeg		!Extra text beginning in secondary file
	EXTERNAL  UAC__NOTCOPIED	!Signal if user not copied
	CHARACTER*(UAC_K_RECMAX) new	!New input record copied to here
C
	IF (uacfile .EQ. 0) CALL OPEN_UACFILE
C
C Check for /INPUT qualifier to set input file name...
C
	IF (CLI$PRESENT( 'INPUT')) THEN
	    CALL CLI$GET_VALUE( 'INPUT', file)
	    ELSE
C
C If no /INPUT, then use "UACFILE;-1" as the file specification...
C
	    file = 'UACFILE;-1'
	    ENDIF
C
C Open secondary access file with read-only access.
C
	OPEN( UNIT=2, ACCESS='KEYED', FORM='FORMATTED',
	1     FILE=file, DEFAULTFILE='SYS$DISK:[].DAT',
	2     SHARED, READONLY, STATUS='OLD')
C
C Now get file record length to calculate username length.
C
	INQUIRE (UNIT=2, RECL=if_reclen)
C
C Now read special data record (via blank key) to get other parameters.
C
	IF (READ_KEYED( 2, ' ')) THEN
	    if_textlen = ZEXT( ICHAR( record(UAC_B_XTSZ:UAC_B_XTSZ)))
	    ELSE
	    EDIT_COPY = %LOC(UAC__FILDATERR)
	    CLOSE (UNIT=2)
	    RETURN
	    ENDIF
C
C Now calculate secondary key and extra text field sizes and offsets.
C
	if_namelen = if_reclen - if_textlen - (UAC_T_NAME - 1)
	if_keyend = UAC_T_NAME + if_namelen - 1
	if_textbeg = UAC_T_NAME + if_namelen
C
C Now get input parameter, either "*" to copy entire file or a user's name
C
	CALL CLI$GET_VALUE( 'USERNAME', file)
	IF (file .EQ. '*') THEN
C
C Loop over and read all username records from secondary file...
C
	    DO WHILE( READ_SEQ( 2))
C
C Reformat input record and write to the access file...
C
		IF (if_textlen .GT. 0) THEN
		    file = record(if_textbeg:if_reclen)		!Save text
		    ELSE
		    file = ' '					!No input text
		    ENDIF
		IF (namelen .GT. if_namelen)
	1		record(UAC_T_NAME+if_namelen:) = ' '	!Blank pad name
		IF (textlen .GT. 0)
	1		record(textbeg:) = file(1:textlen)
		CALL LIB$MOVC3( 4, 0, %REF(record(UAC_L_ACNT:)))
		new = record
C
C Now either write new record to file or complain that user already exists
C (and must be copied "manually").
C
		IF (READ_KEYED( uacfile, new(UAC_T_NAME:keyend))) THEN
		    UNLOCK (UNIT=uacfile)
		    CALL LIB$SIGNAL( UAC__NOTCOPIED, %VAL(1),
	1			     new(UAC_T_NAME:keyend))
		    ELSE
		    WRITE (UNIT=UACFILE, FMT='(A)') record(1:reclen)
		    ENDIF
		ENDDO
	    EDIT_COPY = %LOC(SS$_NORMAL)
	    ELSE
C
C Copy single user, read user's record.  If found, reformat and write to 
C access file.  If not found, return error condition.
C
	    IF (READ_KEYED( 2, file(1:if_namelen))) THEN
C
		IF (if_textlen .GT. 0) THEN
		    file = record(if_textbeg:if_reclen)		!Save text
		    ELSE
		    file = ' '					!No input text
		    ENDIF
		IF (namelen .GT. if_namelen)
	1		record(UAC_T_NAME+if_namelen:) = ' '	!Blank pad name
		IF (textlen .GT. 0)
	1		record(textbeg:) = file(1:textlen)
		CALL LIB$MOVC3( 4, 0, %REF(record(UAC_L_ACNT:)))
		new = record
C
C Either write new record or rewrite existing user record.
C
		IF (READ_KEYED( uacfile, new(UAC_T_NAME:keyend))) THEN
		    REWRITE (UNIT=UACFILE, FMT='(A)') record(1:reclen)
		    ELSE
		    WRITE (UNIT=UACFILE, FMT='(A)') record(1:reclen)
		    ENDIF
		EDIT_COPY = %LOC(SS$_NORMAL)
		ELSE
		EDIT_COPY = %LOC(UAC__USRNOTIN)
		ENDIF
	    ENDIF
C
	CLOSE (UNIT=2)
C
	RETURN
	END
	INTEGER*4 FUNCTION EDIT_CREATE
C
C+/EDIT_CREATE
C
C Functional Description:
C	Process the EDIT mode CREATE directive to create a new password file.
C
C Input Parameters:
C	NONE
C
C Implicit Inputs:
C	NONE
C
C Output Parameters:
C	Returns status.
C
C Implicit Outputs:
C	uacfile - set to unit on which new access file is open
C	namelen - set to length of user name key for access file
C	minpwdlen - set to minimum allowed password length
C	reclen - set to access file record length.
C	lcpwd - set to TRUE if lowercase characters permitted in password.
C
C Side Effects:
C	NONE
C-
	INCLUDE	'UAC.INC'
C
	EXTERNAL  SS$_NORMAL		!Success code
	LOGICAL*4 CLI$GET_VALUE		!Get command line argument
	CHARACTER*63 file		!For file specification/logical name
	INTEGER*4 status		!Completion status
	INTEGER*4 GET_QUALIFIER_VALUE	!Get numeric value of command qualifier
	LOGICAL*2 CLI$PRESENT		!Check for qualifier present/negated
C
C Initialize to normal username and minimum password lengths then override with
C user specified values via the CREATE command qualifiers.
C
	namelen = 12			!Same as VMS username
	minpwdlen = 8			!To irritate people
	textlen = 0			!No extra text
	status = GET_QUALIFIER_VALUE( 'KEYLEN', namelen)
	IF (.NOT. status) THEN
	    EDIT_CREATE = status
	    RETURN
	    ENDIF
	status = GET_QUALIFIER_VALUE( 'MINPWDLEN', minpwdlen)
	IF (.NOT. status) THEN
	    EDIT_CREATE = status
	    RETURN
	    ENDIF
	status = GET_QUALIFIER_VALUE( 'TEXTLEN', textlen)
	IF (.NOT. status) THEN
	    EDIT_CREATE = status
	    RETURN
	    ENDIF
	lcpwd = CLI$PRESENT( 'LOCASE')
C
	reclen = namelen + textlen + (UAC_T_NAME - 1)
	keyend = UAC_T_NAME - 1 + namelen
	textbeg = UAC_T_NAME + namelen		!Extra text beginning
C
C Get user-specified access file specification from CREATE command.
C Otherwise use UACFILE as filename or a logical name.
C
	IF (.NOT. CLI$GET_VALUE( 'FILE', file)) file = 'UACFILE'
C
C Create access file.
C
	OPEN( UNIT=1, ACCESS='KEYED', FORM='FORMATTED',
	1     FILE=file, DEFAULTFILE='SYS$DISK:[].DAT',
	2     SHARED, STATUS='NEW', CARRIAGECONTROL='NONE',
	3     KEY=(UAC_T_NAME:keyend:CHARACTER), RECORDSIZE=reclen,
	4     ORGANIZATION='INDEXED', RECORDTYPE='FIXED')
C
	uacfile = 1			!File created and opened.
C
C Write file data record with minimum password length and lowercase flag.
C Also clear the file access count.
C
	CALL LIB$MOVC3( 1, minpwdlen, %REF(record(UAC_B_MPWL:)))
	CALL LIB$MOVC3( 1, lcpwd, %REF(record(UAC_B_LCPW:)))
	CALL LIB$MOVC3( 1, textlen, %REF(record(UAC_B_XTSZ:)))
	CALL LIB$MOVC3( 4, 0, %REF(record(UAC_L_ACNT:)))
	record(UAC_T_NAME:) = ' '	!Key and extra text of blanks
C
	WRITE (UNIT=uacfile,FMT='(A)') record(1:reclen)
C
	EDIT_CREATE = %LOC(SS$_NORMAL)
C
	RETURN
	END
	INTEGER*4 FUNCTION EDIT_DELETE
C
C+/EDIT_DELETE
C
C Functional Description:
C	Process the EDIT mode DELETE directive to delete a user from the
C	password file.
C
C Input Parameters:
C	NONE
C
C Implicit Inputs:
C	uacfile - unit number on which access file has been opened.
C
C Output Parameters:
C	Returns completion status.
C
C Implicit Outputs:
C	NONE
C
C Side Effects:
C	NONE
C-
	INCLUDE	'UAC.INC'
C
	EXTERNAL  SS$_NORMAL		!Success code
					!User name/access file key
	CHARACTER*(UAC_K_KEYMAX) username
	INTEGER*2 l_un			!Length of username
	LOGICAL*4 READ_UACFILE		!Check for username in file
	INTEGER*4 junk			!Unused stuff
	EXTERNAL  UAC__USRTOOLNG, UAC__USRNOTIN
C
	IF (uacfile .EQ. 0) CALL OPEN_UACFILE
C
C Get username from command line.
C
	CALL CLI$GET_VALUE( 'USERNAME', username)
	CALL STR$TRIM( username, username, l_un)
	IF (l_un .LE. namelen) THEN
	    l_un = namelen		!Space pad short keys
	    ELSE
	    CALL LIB$SIGNAL(UAC__USRTOOLNG, %VAL(1), %VAL(namelen))
	    l_un = namelen		!Truncate long name
	    ENDIF
C
	IF (READ_UACFILE( username(1:l_un), junk)) THEN
C
C Username found, re-read and delete record.
C
	    READ (UNIT=uacfile, FMT='(A)', KEYEQ=username(1:l_un))
	1	record
	    DELETE (UNIT=uacfile)
	    EDIT_DELETE = %LOC(SS$_NORMAL)
	    ELSE
C
C Username not yet in access file, do not permit MODIFY
C
	    EDIT_DELETE = %LOC(UAC__USRNOTIN)
	    ENDIF
C
	RETURN
	END
	INTEGER*4 FUNCTION EDIT_HELP
C
C+/EDIT_HELP
C
C Functional Description:
C	Provide help on EDIT mode commands.
C
C Input Parameters:
C	NONE
C
C Implicit Inputs:
C	NONE
C
C Output Parameters:
C	NONE
C
C Implicit Outputs:
C	NONE
C
C Side Effects:
C	The logical name UAC_HELPLIB must be defined to point to the
C	help library in which the UAC topic is stored.
C-
	INCLUDE	'FERMI$LIB:LCLFORDEF($HLPDEF)'
	CHARACTER*(*) UAC_HELP
	PARAMETER (UAC_HELP = 'UAC_HELPLIB')
C
	INTEGER*4 status		!Completion status
	CHARACTER*63 result		!Buffer for logical name translation
	INTEGER*4 SYS$TRNLOG		!Service to translate a logical name
	INTEGER*4 CLI$GET_VALUE		!Service to get DCL command parameter
	INTEGER*4 LBR$OUTPUT_HELP	!Help output routine
	EXTERNAL  LIB$PUT_OUTPUT	!Output to SYS$OUTPUT routine
	EXTERNAL  LIB$GET_INPUT		!Input from SYS$INPUT routine
	EXTERNAL  UAC__FATAL, UAC__HLPNOTAVL
	EXTERNAL  SS$_NOTRAN		!Success, name not translated
C
C Check for UAC_HELPLIB logical name
C
	status = SYS$TRNLOG( UAC_HELP,, result,,,)
	IF (.NOT.status) THEN
	    CALL LIB$STOP( UAC__FATAL,, %VAL(status))
	    ELSE IF (status .EQ. %LOC(SS$_NOTRAN)) THEN
	    EDIT_HELP = %LOC(UAC__HLPNOTAVL)
	    ELSE
	    status = CLI$GET_VALUE( 'TOPIC', result)
	    IF (.NOT.status) result = ' '	!No topic on command line
	    EDIT_HELP = LBR$OUTPUT_HELP( LIB$PUT_OUTPUT,,
	1				 'UAC EDIT '//result, UAC_HELP,
	2				 HLP$M_PROMPT, LIB$GET_INPUT)
	    ENDIF
C
	RETURN
	END
	INTEGER*4 FUNCTION EDIT_MODIFY
C
C+/EDIT_MODIFY
C
C Functional Description:
C	Process the EDIT mode MODIFY directive to change the password of a
C	user already in the password file.
C
C Input Parameters:
C	NONE
C
C Implicit Inputs:
C	uacfile - file open flag/unit number
C	namelen - length of username key
C	reclen - length of access file record.
C
C Output Parameters:
C	Returns status.
C
C Implicit Outputs:
C	NONE
C
C Side Effects:
C	NONE
C-
	INCLUDE	'UAC.INC'
C
	EXTERNAL  SS$_NORMAL		!Success code
					!User name/access file key
	CHARACTER*(UAC_K_KEYMAX) username
					!Password text
	CHARACTER*(UAC_K_PWDMAX) password
	CHARACTER*(UAC_K_TXTMAX) text	!Extra text field
	INTEGER*2 l_un			!Length of username
	INTEGER*2 l_pwd			!Length of password text
	LOGICAL*4 READ_KEYED		!Keyed read of access file
	EXTERNAL  UAC__USRTOOLNG, UAC__USRNOTIN
	INTEGER*4 HASH_CODER		!Hash coding function
	LOGICAL*4 CLI$GET_VALUE
	LOGICAL*4 CLI$PRESENT		!Test for qualifier present
	INTEGER*4 hashed		!Hashed password
C
	IF (uacfile .EQ. 0) CALL OPEN_UACFILE
C
C Get username and password from command line.
C
	CALL CLI$GET_VALUE( 'USERNAME', username)
	CALL STR$TRIM( username, username, l_un)
	IF (l_un .LE. namelen) THEN
	    l_un = namelen		!Space pad short keys
	    ELSE
	    CALL LIB$SIGNAL(UAC__USRTOOLNG, %VAL(1), %VAL(namelen))
	    l_un = namelen		!Truncate long name
	    ENDIF
C
C Get password from /PASSWORD qualifier
C
	IF (CLI$PRESENT( 'PASSWORD')) THEN
	    IF (CLI$GET_VALUE( 'PASSWORD', password)) THEN
		CALL STR$TRIM( password, password, l_pwd)
		IF (.NOT.lcpwd)
	1	    CALL STR$UPCASE( password, password(1:l_pwd))
		ELSE
		l_pwd = 0		!/PASSWORD w/o value for blank
		ENDIF
	    ELSE
	    l_pwd = 0			!No /PASSWORD, use blank password
	    ENDIF
C
C Get extra text from /TEXT qualifier
C
	IF ((textlen .GT. 0) .AND. CLI$PRESENT( 'TEXT'))
	1	CALL CLI$GET_VALUE( 'TEXT', text)
C
	IF (READ_KEYED( uacfile, username(1:l_un))) THEN
C
C Username found, make modifications to the record.
C
	    IF (CLI$PRESENT( 'PASSWORD')) THEN
C
C New password to be stuffed.
C
	    IF (l_pwd .EQ. 0) THEN
		hashed = 0		!No password
		ELSE
		hashed = HASH_CODER(password(1:l_pwd))
		ENDIF
	    CALL LIB$MOVC3( 4, hashed, %REF(record(UAC_L_HPWD:)))
	    ENDIF
C
C New extra text field contents if /TEXT seen
C
	    IF (CLI$PRESENT( 'TEXT'))
	1	record(textbeg:) = text(1:textlen)
C
C Reset access count if /RESET... seen.
C
	    IF (CLI$PRESENT( 'RESET'))
	1	CALL LIB$MOVC3(4, 0, %REF(record(UAC_L_ACNT:)))
C
C Rewrite record with modifications.
C
	    REWRITE (UNIT=uacfile, FMT='(A)') record(1:reclen)
	    EDIT_MODIFY = %LOC(SS$_NORMAL)
	    ELSE
C
C Username not yet in access file, do not permit MODIFY
C
	    EDIT_MODIFY = %LOC(UAC__USRNOTIN)
	    ENDIF
C
	RETURN
	END
	INTEGER*4 FUNCTION EDIT_SHOW
C
C+/EDIT_SHOW
C
C Functional Description:
C	Process the EDIT mode SHOW directive to list the usernames in the
C	password file.
C
C Input Parameters:
C	NONE
C
C Implicit Inputs:
C	namelen - length of username key.
C	minpwdlen - minimum length of the password text.
C	lcpwd - lowercase character flag for password.
C
C Output Parameters:
C	Returns completion status.
C
C Implicit Outputs:
C	NONE
C
C Side Effects:
C	NONE
C-
	INCLUDE	'UAC.INC'
C
	EXTERNAL  SS$_NORMAL		!Success code
	CHARACTER*(UAC_K_RECMAX) user	!Username
	INTEGER*2 l_user		!Length of username
	INTEGER*4 accessed		!Access count for user
	INTEGER*4 status		!I/O and completion status
	INTEGER*4 LIB_FAO_OUTPUT	!Formatted output to SYS$OUTPUT
	LOGICAL*4 EDIT_SHOW_READS	!Sequential record read routine
	EXTERNAL  UAC__FATAL
	LOGICAL*4 full_show		!Complete printout flag
	LOGICAL*4 CLI$PRESENT
C
C Set flag based on /FULL and /BRIEF qualifiers
C
	full_show = CLI$PRESENT( 'FULL') .OR. .NOT.CLI$PRESENT( 'BRIEF')
C
	IF (uacfile .EQ. 0) CALL OPEN_UACFILE
C
C Read first record to get total file accesses, also setup for sequential
C reads.
C
	CALL EDIT_SHOW_READ0( accessed)
C
	IF (full_show) THEN
C
	    status = LIB_FAO_OUTPUT( '!/'//
	1		'User name key length is !UL characters'//
	2		', with padding.', %VAL(namelen))
	    IF (.NOT. status) CALL LIB$STOP( UAC__FATAL,, %VAL(status))
C
	    IF (lcpwd) THEN
		status = LIB_FAO_OUTPUT(
	1		'Minimum password length is !UL characters, '//
	2		'lowercase permitted.', %VAL(minpwdlen))
		ELSE
		status = LIB_FAO_OUTPUT(
	1		'Minimum password length is !UL characters, '//
	2		'uppercase only.', %VAL(minpwdlen))
		ENDIF
	    IF (.NOT. status) CALL LIB$STOP( UAC__FATAL,, %VAL(status))
C
	    status = LIB_FAO_OUTPUT(
	1		'File has been OPEN''ed !UL times.!/',
	2		%VAL(accessed))
	    IF (.NOT. status) CALL LIB$STOP( UAC__FATAL,, %VAL(status))
C
	    ELSE
	    CALL NEW_LINE
	    ENDIF
C
C Now read the user records until EOF
C
	DO WHILE (EDIT_SHOW_READS( user, l_user, accessed))
	    IF (full_show) THEN
		status = LIB_FAO_OUTPUT( '!8UL accesses by !AS',
	1				 %VAL(accessed), user(1:l_user))
		ELSE
		status = LIB_FAO_OUTPUT( '!AS', user(1:l_user))
		ENDIF
	    IF (.NOT. status) CALL LIB$STOP( UAC__FATAL,, %VAL(status))
	    ENDDO
C
	CALL NEW_LINE
C
	EDIT_SHOW = %LOC(SS$_NORMAL)
	RETURN
	END
	SUBROUTINE EDIT_SHOW_READ0( accesses)
C
	INTEGER*4 accesses
C
C+/EDIT_SHOW_READ0
C
C Functional Description:
C	Read first record from password file for the EDIT SHOW command.
C
C Input Parameters:
C	NONE
C
C Implicit Inputs:
C	uacfile - unit number on which the access file is open.
C	namelen - length of access file keys.
C	reclen - length of access file records.
C
C Output Parameters:
C	accesses - number of times (including this one) that the access file
C		   has been opened.
C
C Implicit Outputs:
C	NONE
C
C Side Effects:
C	NONE
C-
	INCLUDE	'SYS$LIBRARY:FORSYSDEF($FORIOSDEF)'
C
	INCLUDE	'UAC.INC'
C
	CHARACTER*(UAC_K_KEYMAX) first	!First username record
	INTEGER*4 junk			!Useless stuff
C
	DATA first/' '/
C
	CALL READ_KEYED( uacfile, first(1:namelen))
C
C Record read successfully, get 32-bit access count and unlock the record.
C
	CALL LIB$MOVC3( 4, %REF(record(UAC_L_ACNT:)), accesses)
	UNLOCK (UNIT=uacfile)
C
	RETURN
	END
	LOGICAL*4 FUNCTION EDIT_SHOW_READS( name, l_name, accesses)
C
	CHARACTER*(*) name
	INTEGER*2 l_name
	INTEGER*4 accesses
C
C+/EDIT_SHOW_READS
C
C Functional Description:
C	Reads user records from access file in sequential order.
C
C Input Parameters:
C	NONE
C
C Implicit Inputs:
C	uacfile - unit on which the access file has been opened.
C	reclen - length of records in access file.
C
C Output Parameters:
C	Returns TRUE if a record was read successfully, else returns FALSE
C	when the EOF is reached.
C
C	name - user name from record.
C	l_name - length of user name.
C	accesses - number of times the user's record has been accessed.
C
C Implicit Outputs:
C	record - contains the just read record.
C
C Side Effects:
C	NONE
C-
	INCLUDE	'SYS$LIBRARY:FORSYSDEF($FORIOSDEF)'
C
	INCLUDE	'UAC.INC'
C
	LOGICAL*4 READ_SEQ		!Sequential read routine
C
	IF (READ_SEQ( uacfile)) THEN
C
C Record read successfully, unlock it and get 32-bit access count and
C non-padded user name.
C
	    UNLOCK (UNIT=uacfile)
	    CALL LIB$MOVC3( 4, %REF(record(UAC_L_ACNT:)), accesses)
	    CALL STR$TRIM( name, record(UAC_T_NAME:reclen), l_name)
C
	    EDIT_SHOW_READS = .TRUE.
	    ELSE
C
C End-of-file reached, no more user records...
C
	    EDIT_SHOW_READS = .FALSE.
	    ENDIF
C
	RETURN
	END
	INTEGER*4 FUNCTION GET_QUALIFIER_VALUE( label, ivalue)
C
	CHARACTER*(*) label
	INTEGER*2 ivalue
C
C+/GET_QUALIFIER_VALUE
C
C Functional Description:
C	Get numeric value of a command line qualifier.
C
C Input Parameters:
C	label - identifier for the DCL qualifier
C
C Implicit Inputs:
C	NONE
C
C Output Parameters:
C	Returns status:
C		SS$_NORMAL	success
C		OTS$_INPCONERR	input conversion error
C	ivalue - returns value specified for qualifier, unchanged if the
C		 qualifier was not used on the command line.
C
C Implicit Outputs:
C	NONE
C
C Side Effects:
C	NONE
C-
	CHARACTER*32 cvalue		!Qualifier text value
	LOGICAL*4 CLI$PRESENT		!Check for qualifier presence
	INTEGER*4 OTS$CVT_TI_L		!Convert text to binary
	EXTERNAL  SS$_NORMAL
C
	IF (CLI$PRESENT( label)) THEN
	    CALL CLI$GET_VALUE( label, cvalue)
	    GET_QUALIFIER_VALUE =
	1	OTS$CVT_TI_L( cvalue, ivalue, %VAL(2), %VAL(1))
	    ELSE	    
	    GET_QUALIFIER_VALUE = %LOC(SS$_NORMAL)
	    ENDIF
C
	RETURN
	END
	INTEGER*4 FUNCTION HASH_CODER( password)
C
	CHARACTER*(*) password
C
C+/HASH_CODER
C
C Functional Description:
C	Implements the hashing of the password string into a 32-bit longword.
C
C Input Parameters:
C	password - input text string to be hashed.
C
C Implicit Inputs:
C	NONE
C
C Output Parameters:
C	Returns a 32-bit hashed password.
C
C Implicit Outputs:
C	NONE
C
C Side Effects:
C	Makes use of the LIB$CRC routine with a modified Autodin-II polynominal
C	table to perform the hash coding.
C-
	INTEGER*4 LIB$CRC		!VAX-11 CRC instruction
	INTEGER*4 autodin(16)		!Modified Autodin-II polynominal table
C
C  Modified AUTODIN-II polynominal table used by CRC algorithm:
C
	DATA autodin/
	1 '010D490C'X, '1DB71064'X, '3B6E20C8'X, '26D930AC'X,
	2 '76DC41D0'X, '6B6B51F4'X, '4DB26158'X, '5105713C'X,
	3 'EDB88320'X, 'F0CF9344'X, 'D6D6A3E8'X, 'CB61B38C'X,
	4 '9B64C2B0'X, '86D3D2D4'X, 'A01AE278'X, 'BDBDF21C'X/
C
	IF (LEN(password) .EQ. 0) THEN
C
C Return 0 for blank password...
C
	    HASH_CODER = 0
	    ELSE
C
C Calculate 32-bit CRC from the password text.
C
	    HASH_CODER = LIB$CRC( autodin, -1, password)
	    ENDIF
C
	RETURN
	END
	SUBROUTINE  NEW_LINE
C
C+/NEW_LINE
C
C Functional Description:
C	Output a carriage-return/line-feed to SYS$OUTPUT.
C
C Input Parameters:
C	NONE
C
C Implicit Inputs:
C	NONE
C
C Output Parameters:
C	NONE
C
C Implicit Outputs:
C	NONE
C
C Side Effects:
C	NONE
C-
	INTEGER*4 status
	INTEGER*4 LIB$PUT_OUTPUT
	EXTERNAL  UAC__FATAL
C
	status = LIB$PUT_OUTPUT( ' ')
	IF (.NOT. status) CALL LIB$STOP( UAC__FATAL,, %VAL(status))
C
	RETURN
	END
	SUBROUTINE  OPEN_UACFILE
C
C+/OPEN_UACFILE
C
C Functional Description:
C	Open existing UAC file of user names and passwords.
C
C Input Parameters:
C	NONE
C
C Implicit Inputs:
C	NONE
C
C Output Parameters:
C	NONE
C
C Implicit Outputs:
C	uacfile - set to unit number file is open on as flag that file has
C		  been opened.
C	namelen - length of user name in records
C	minpwdlen - minimum allowed password text length
C	reclen - length of access file records.
C	lcpwd - lowercase password flag.
C
C Side Effects:
C	NONE
C-
	INCLUDE	'UAC.INC'
	INTEGER*4 OFF_MPWL		!Offset to minimum password byte
	INTEGER*4 OFF_XTSZ		!Offset to extra text length byte
	INTEGER*4 OFF_LCPW		!Offset to lowercase password flag byte
	PARAMETER (OFF_MPWL = UAC_B_MPWL - UAC_L_HPWD)
	PARAMETER (OFF_XTSZ = UAC_B_XTSZ - UAC_L_HPWD)
	PARAMETER (OFF_LCPW = UAC_B_LCPW - UAC_L_HPWD)
C
	LOGICAL*4 READ_UACFILE		!Read UAC file record
	BYTE file_data(0:3)		!Hold special data stored in file
					!Key for special data record
	EXTERNAL UAC__FILDATERR		!Signal if no data record
	LOGICAL*2 save_count		!Save for access count flag
C
	DATA uacfile/0/			!Init to file not opened
	DATA count_access/ .FALSE./	!Default is to silently read records
C
C Open file with write access.
C
	OPEN( UNIT=1, ACCESS='KEYED', FORM='FORMATTED',
	1     FILE='UACFILE', DEFAULTFILE='SYS$DISK:[].DAT',
	2     SHARED, STATUS='OLD')
	uacfile = 1			!File is open
C
C Now get file record length to calculate username length.
C
	INQUIRE (UNIT=uacfile, RECL=reclen)
C
C Now read special data record (via blank key) to get minimum password length
C
	save_count = count_access
	count_access = .TRUE.		!Counts file opens
	IF (READ_UACFILE( ' ', file_data)) THEN
	    minpwdlen = ZEXT(file_data(OFF_MPWL))
	    lcpwd = ZEXT(file_data(OFF_LCPW))
	    textlen = ZEXT(file_data(OFF_XTSZ))
	    ELSE
	    CALL LIB$SIGNAL( UAC__FILDATERR)
	    ENDIF
	count_access = save_count
C
C Now calculate key and extra text field sizes and offsets.
C
	namelen = reclen - textlen - (UAC_T_NAME - 1)
	keyend = UAC_T_NAME + namelen - 1
	textbeg = UAC_T_NAME + namelen
C
	RETURN
	END
	LOGICAL*4 FUNCTION READ_KEYED( unit, username)
C
	CHARACTER*(*) username
	INTEGER*2 unit
C
C+/READ_KEYED
C
C Functional Description:
C	Perform a keyed-read (KEYEQ) given the string key in username.
C
C Input Parameters:
C	unit - unit number for keyed read.
C	username - key for record to be read, text.
C
C Implicit Inputs:
C	NONE
C
C Output Parameters:
C	Returns TRUE if record read successfully; FALSE if no such username in
C	the file.
C
C Implicit Outputs:
C	record - if successful, the record is returned here.
C
C Side Effects:
C	The record is left locked.
C-
	INCLUDE	'SYS$LIBRARY:FORSYSDEF($FORIOSDEF)'
	INTEGER*4 RETRY_LIMIT
	PARAMETER (RETRY_LIMIT = 10)
C
	INCLUDE	'UAC.INC'
C
	INTEGER*4 retries		!Locked record retry counter
	INTEGER*4 status		!I/O and completion status
	EXTERNAL  UAC__ACCFILERR, UAC__ACCRECLCK
C
	DO retries = 1,RETRY_LIMIT
	    READ (UNIT=unit, KEYEQ=username, FMT='(A)', IOSTAT=status)
	1	record
C
	    IF (status .EQ. 0) THEN
C
C Record read successfully.
C
		READ_KEYED = .TRUE.
		RETURN
		ELSE IF (status .EQ. FOR$IOS_ATTACCNON) THEN
C
C No such record as given by the key, return failure to caller (no record to
C unlock).
C
		READ_KEYED = .FALSE.
		RETURN
C
		ELSE IF (status .NE. FOR$IOS_SPERECLOC) THEN
C
C Some unexpected read error...
C
		CALL LIB$SIGNAL( UAC__ACCFILERR, %VAL(1), %VAL(status))
		ENDIF
C
C Record is locked, sleep for a bit and try again...
C
	    status = LIB_SLEEP_MILLISECS( 500)
	    IF (.NOT. status) CALL LIB$SIGNAL( %VAL(status))
	    ENDDO
C
C Exhausted retries and record still locked...
C
	CALL LIB$STOP( UAC__ACCRECLCK)
C
	END
	LOGICAL*4 FUNCTION READ_SEQ( unit)
C
	INTEGER*2 unit
C
C+/READ_SEQ
C
C Functional Description:
C	Perform a sequential read on an indexed file.
C
C Input Parameters:
C	unit - unit number for keyed read.
C
C Implicit Inputs:
C	NONE
C
C Output Parameters:
C	Returns TRUE if record read successfully; FALSE if end of file reached.
C
C Implicit Outputs:
C	record - if successful, the record is returned here.
C
C Side Effects:
C	The record is left locked.
C-
	INCLUDE	'SYS$LIBRARY:FORSYSDEF($FORIOSDEF)'
	INTEGER*4 RETRY_LIMIT
	PARAMETER (RETRY_LIMIT = 10)
C
	INCLUDE	'UAC.INC'
C
	INTEGER*4 retries		!Locked record retry counter
	INTEGER*4 status		!I/O and completion status
	EXTERNAL  UAC__ACCFILERR, UAC__ACCRECLCK
C
	DO retries = 1,RETRY_LIMIT
	    READ (UNIT=unit, FMT='(A)', IOSTAT=status) record
C
	    IF (status .EQ. 0) THEN
C
C Record read successfully.
C
		READ_SEQ = .TRUE.
		RETURN
		ELSE IF (status .EQ. -1) THEN
C
C End of file reached.
C
		READ_SEQ = .FALSE.
		RETURN
C
		ELSE IF (status .NE. FOR$IOS_SPERECLOC) THEN
C
C Some unexpected read error...
C
		CALL LIB$SIGNAL( UAC__ACCFILERR, %VAL(1), %VAL(status))
		ENDIF
C
C Record is locked, sleep for a bit and try again...
C
	    status = LIB_SLEEP_MILLISECS( 500)
	    IF (.NOT. status) CALL LIB$SIGNAL( %VAL(status))
	    ENDDO
C
C Exhausted retries and record still locked...
C
	CALL LIB$STOP( UAC__ACCRECLCK)
C
	END
	LOGICAL*4 FUNCTION READ_UACFILE( username, hashpwd)
C
	CHARACTER*(*) username
	INTEGER*4 hashpwd
C
C+/READ_UACFILE
C
C Functional Description:
C	Read a record from the User Access Check file.
C
C Input Parameters:
C	username - key for record to be read, text.
C
C Implicit Inputs:
C	count_access - if TRUE then the access count is incremented and the
C		       record is rewritten; if FALSE then the record is just
C		       unlocked.
C
C Output Parameters:
C	Returns TRUE if record read successfully; FALSE if no such username in
C	the file.
C	hashpwd - returns the 32-bit hashed password if a record is read.
C
C Implicit Outputs:
C	record - successfully read record.
C
C Side Effects:
C	NONE
C-
	INCLUDE	'SYS$LIBRARY:FORSYSDEF($FORIOSDEF)'
C
	INCLUDE	'UAC.INC'
C
	LOGICAL*4 READ_KEYED		!Keyed I/O routine
C
	IF (READ_KEYED( uacfile, username)) THEN
C
C Record read successfully, pull password out of the record.
C
	    CALL LIB$MOVC3( 4, %REF(record(UAC_L_HPWD:)), hashpwd)
C
C Either count access (update access count and rewrite the record), or
C unlock the record.
C
	    IF (count_access) THEN
		CALL LIB$MOVC3( 4, %REF(record(UAC_L_ACNT:)), i)
		CALL LIB$MOVC3( 4, i + 1, %REF(record(UAC_L_ACNT:)))
		REWRITE (UNIT=uacfile, FMT='(A)') record(1:reclen)
		UNLOCK (UNIT=uacfile)
		ELSE
		ENDIF
	    READ_UACFILE = .TRUE.
	    ELSE
C
C No such record as given by the key, return failure to caller (no record to
C unlock).
C
	    READ_UACFILE = .FALSE.
	    ENDIF
C
	RETURN
	END
	SUBROUTINE  REWRITE_PASSWORD( username, hashpwd)
C
	CHARACTER*(*) username
	INTEGER*4 hashpwd
C
C+/REWRITE_PASSWORD
C
C Functional Description:
C	Rewrite a record into the User Access Check file with a new password.
C
C Input Parameters:
C	username - key for record to be rewritten, text.
C	hashpwd - the 32-bit hashed password for the record.
C
C Implicit Inputs:
C	namelen - length of the name key in the UAC record.
C	reclen - length of the access file records.
C	record - record read for the user.
C
C Output Parameters:
C	NONE
C
C Implicit Outputs:
C	NONE
C
C Side Effects:
C	NONE
C-
	INCLUDE	'SYS$LIBRARY:FORSYSDEF($FORIOSDEF)'
C
	INCLUDE	'UAC.INC'
C
	INTEGER*4 status		!I/O and completion status
C
	CALL READ_KEYED( uacfile, username)
C
C Record read successfully, set the new 32-bit hashed password/data and
C rewrite the record.
C
	CALL LIB$MOVC3( 4, hashpwd, %REF(record(UAC_L_HPWD:)))
	REWRITE (UNIT=uacfile, FMT='(A)') record(1:reclen)
C
	RETURN
	END
	SUBROUTINE UAC_CHANGE( username)
C
	CHARACTER*(*) username
C
C+/UAC_CHANGE
C
C Functional Description:
C	Implement CHANGE mode to permit user to change his own password in the
C	file.
C
C Input Parameters:
C	username - username parameter from foreign command line.
C
C Implicit Inputs:
C	namelen - length of user name key in access file
C	minpwdlen - minimum length (in characters) of new passwords
C	reclen - access file record length.
C	lcpwd - lowercase password flag.
C
C Output Parameters:
C	NONE
C
C Implicit Outputs:
C	NONE
C
C Side Effects:
C	NONE
C-
	INCLUDE	'UAC.INC'
C
	EXTERNAL UAC__NONAME
C
	INTEGER*4 status		!Completion status
					!User's name as file key
	CHARACTER*(UAC_K_KEYMAX) namekey
					!New password text
	CHARACTER*(UAC_K_PWDMAX) password
	INTEGER*2 l_pwd			!Length of password text
	CHARACTER*(UAC_K_PWDMAX) verify	!New password verification text
	INTEGER*2 l_vfy			!Length of verification text
	INTEGER*4 ACCESS_CHECK		!Check access file for authorization
	INTEGER*4 hashed		!Hashed password
	INTEGER*4 HASH_CODER		!Routine to hash password
	EXTERNAL  UAC__PWDNOTVFY	!Warning, password not verified
	INTEGER*4 LIB_FAO_OUTPUT	!Formatted output
	EXTERNAL  UAC__FATAL
C
	IF ((LEN(username) .EQ. 0) .OR. (username(1:1) .EQ. ' '))
	1	CALL LIB$STOP( UAC__NONAME)
	namekey = username
C
C Open the UAC file for WRITE access.
C
	CALL OPEN_UACFILE
C
C Get current password text, hash it and check UAC file to valid authorization
C to change password.
C
	CALL NEW_LINE
	status = ACCESS_CHECK( namekey(1:namelen), 'Old password: ')
C
C If not authorized, signal the error.
C
	IF (.NOT. status) CALL LIB$STOP( %VAL(status))
C
C Get new password and verify its entry before changing the access file.
C
	CALL NEW_LINE
	l_pwd = -1			!Init for 0th loop
	DO WHILE (l_pwd .LT. minpwdlen)
	    CALL ASK_USER( 'New password: ', .FALSE., .NOT.lcpwd,
	1		   password, l_pwd)
	    IF (l_pwd .LT. minpwdlen) THEN
		status = LIB_FAO_OUTPUT( 'Minimum password length '//
	1				 'is !UW characters, please '//
	2				 'try again.!/',
	3				 %VAL(minpwdlen))
		IF (.NOT.status)
	1		CALL LIB$SIGNAL( UAC__FATAL,, %VAL(status))
		ENDIF
	    ENDDO
	CALL NEW_LINE
	CALL ASK_USER( 'Verification: ', .FALSE., .NOT.lcpwd,
	1	       verify, l_vfy)
	IF (verify(1:l_vfy) .NE. password(1:l_pwd)) THEN
	    CALL LIB$SIGNAL( UAC__PWDNOTVFY)
	    ELSE
C
C New password verified, hash code it and stuff into access file.
C
	    hashed = HASH_CODER( password(1:l_pwd))
C
	    CALL REWRITE_PASSWORD( namekey(1:namelen), hashed)
	    ENDIF
C
	RETURN
	END
	SUBROUTINE UAC_CHECKER( parameters)
C
	CHARACTER*(*) parameters
C
C+/UAC_CHECKER
C
C Functional Description:
C	Implement CHECK mode to input a username and password and check the
C	password file to permit user access.
C
C Input Parameters:
C	parameters - remainder of command line parameters, DCL symbol name to
C		     return user name and optional goto-on-failure label
C
C Implicit Inputs:
C	namelen - length of user name key in access file.
C
C Output Parameters:
C	NONE
C
C Implicit Outputs:
C	NONE
C
C Side Effects:
C	If DCL label specified, then a "$ GOTO label" DCL statement
C	will be executed if access is failed.  If the logical name
C	UAC_PROMPT is defined, its equivalence string is used as the
C	username prompt.
C-
	INCLUDE	'UAC.INC'
	CHARACTER*(*) DEFAULT_PROMPT	!Default username prompt string
	PARAMETER (DEFAULT_PROMPT = 'Username: ')
C
	EXTERNAL UAC__NONAME
C
	INTEGER*2 l_symbol		!Length of DCL symbol name
	LOGICAL*1 have_label		!Set if DCL GOTO-on-failure label 
	INTEGER*4 LIB$LOCC		!Locate character
					!User's name
	CHARACTER*(UAC_K_KEYMAX) username
	INTEGER*2 l_un			!Length of user's name
	INTEGER*4 status		!Completion status
	INTEGER*4 LIB$SET_SYMBOL	!To define a DCL symbol
					!Password text
	CHARACTER*(UAC_K_PWDMAX) password
	INTEGER*2 l_pwd			!Length of password text
	INTEGER*4 ACCESS_CHECK		!Check access file for authorization
	CHARACTER*63 uprompt		!Username prompt string
	INTEGER*2 l_up			!Length of username prompt
	INTEGER*4 SYS$TRNLOG		!Logical name translation service
	EXTERNAL  UAC__FATAL, SS$_NOTRAN
C
	IF ((LEN(parameters) .EQ. 0) .OR.
	1   (parameters(1:1) .EQ. ' '))
	1	CALL LIB$STOP( UAC__NONAME)
C
C Get length of DCL symbol name and set DCL label flag.
C
	l_symbol = LIB$LOCC( ' ', parameters)
	IF (l_symbol .EQ. 0) THEN
	    have_label = .FALSE.	!No DCL label for goto-on-failure
	    l_symbol = LEN(parameters)
	    ELSE
	    have_label = .TRUE.
	    ENDIF
C
C Open the UAC file for READONLY access.
C
	CALL OPEN_UACFILE
	count_access = .TRUE.		!Count record access
C
C Setup username prompt string, use UAC_PROMPT equivalence string if the
C logical name is defined.
C
	status = SYS$TRNLOG( 'UAC_PROMPT', l_up, uprompt,,,)
	IF (.NOT. status) THEN
	    CALL LIB$STOP( UAC__FATAL,, %VAL(status))
	    ELSE IF (status .EQ. %LOC(SS$_NOTRAN)) THEN
	    uprompt = DEFAULT_PROMPT	!Using default prompt string
	    l_up = LEN(DEFAULT_PROMPT)
	    ENDIF
C
C Get user's name and set DCL symbol.
C
	CALL ASK_USER( uprompt(1:l_up), .TRUE., .TRUE., username, l_un)
C
	status = LIB$SET_SYMBOL( parameters(1:l_symbol),
	1			 username(1:l_un))
	IF (.NOT. status) CALL LIB$SIGNAL( UAC__FATAL,, %VAL(status))
C
C Get password text, hash it and check UAC file.
C
	status = ACCESS_CHECK( username(1:namelen), 'Password: ')
C
C If access is authorized, exit.  Continue on if access failed.
C
	IF (status) RETURN
C
C If no goto-on-failure label, signal the error.
C
	IF (.NOT. have_label) CALL LIB$STOP( %VAL(status))
C
C Execute DCL GOTO command to skip to the failure label.
C
	status = LIB$DO_COMMAND( '$ GOTO '//parameters(l_symbol:))
	IF (.NOT. status) CALL LIB$SIGNAL( %VAL(status))
C
	RETURN
	END
	SUBROUTINE UAC_EDITOR( command)
C
	CHARACTER*(*) command
C
C+/UAC_EDITOR
C
C Functional Description:
C	Implement EDIT mode to permit manager to create, enter users in and
C	maintain the password file.
C
C Input Parameters:
C	command - either "*" for multi-command mode, or the text of the single
C		  command to be executed
C
C Implicit Inputs:
C	NONE
C
C Output Parameters:
C	NONE
C
C Implicit Outputs:
C	NONE
C
C Side Effects:
C	NONE
C-
	EXTERNAL UAC$PARSE_TABLE	!EDIT command parsing tables
	EXTERNAL RMS$_NORMAL, RMS$_EOF, UAC__FATAL
	EXTERNAL UAC__PARSEFAIL
C
	INTEGER*4 sts			!Completion code
	INTEGER*4 rdsts			!Input status
	INTEGER*4 LIB$GET_INPUT		!Get line from SYS$INPUT:
	INTEGER*4 CLI$DCL_PARSE		!DCL routine to parse command line
	INTEGER*4 CLI$DISPATCH		!DCL routine to dispatch command
	CHARACTER*255 line		!Command line
	INTEGER*2 l_line		!Command line length
C
C Check for single command on UAC command line.
C
	IF (command .NE. '*') THEN
C
C Parse and execute the single command...
C
	    sts = CLI$DCL_PARSE( command, UAC$PARSE_TABLE)
	    IF (sts) THEN
		sts = CLI$DISPATCH()
		IF (.NOT. sts) CALL LIB$SIGNAL( %VAL(sts))
		ENDIF
C
	    RETURN
	    ENDIF
C
	rdsts = %LOC(RMS$_NORMAL)	!Init to loop
C
C Loop over input command lines until we get EOF
C
	DO WHILE (rdsts)
	    rdsts = LIB$GET_INPUT( line, 'UAC_EDIT>', l_line)
	    IF (rdsts) THEN
C
C If command is EXIT (or "exit"), then simulate input EOF.
C
		IF ((line(1:4) .EQ. 'EXIT') .OR.
	1	    (line(1:4) .EQ. 'exit')) THEN
		    rdsts = %LOC(RMS$_EOF)
		    ELSE
C
C Parse and dispatch the command.
C
		    sts = CLI$DCL_PARSE( line(1:l_line),
	1				 UAC$PARSE_TABLE)
		    IF (sts) THEN
			sts = CLI$DISPATCH()
			IF (.NOT. sts) CALL LIB$SIGNAL( %VAL(sts))
			ENDIF
		    ENDIF
		ELSE IF (rdsts .NE. %LOC(RMS$_EOF)) THEN
		CALL LIB$STOP( UAC__FATAL,, %VAL(rdsts))
		ENDIF
	    ENDDO
C
	RETURN
	END
	SUBROUTINE UAC_GETTEXT( parameters)
C
	CHARACTER*(*) parameters
C
C+/UAC_GETTEXT
C
C Functional Description:
C	Extract and return the extra text from the access file record
C	for the named user.
C
C Input Parameters:
C	parameters - remainder of command line parameters, user name and
C		     DCL symbol in which to return extra text
C
C Implicit Inputs:
C	namelen - length of user name key in access file.
C	record - user's record from access file
C
C Output Parameters:
C	NONE
C
C Implicit Outputs:
C	NONE
C
C Side Effects:
C	NONE
C-
	INCLUDE	'UAC.INC'
C
	EXTERNAL UAC__NONAME
C
	INTEGER*4 LIB$LOCC		!Locate character
					!User's name
	CHARACTER*(UAC_K_KEYMAX) username
	INTEGER*2 l_un			!Length of user's name
	INTEGER*4 status		!Completion status
	INTEGER*4 LIB$SET_SYMBOL	!To define a DCL symbol
					!Password text
	EXTERNAL  UAC__INSFPARM		!No text symbol parameter
	LOGICAL*4 READ_UACFILE		!Read access file recrod
	EXTERNAL  UAC__FATAL, UAC__USRNOTIN
	INTEGER*4 null_descr(2)		!NULL string descriptor
C
	DATA null_descr/2*0/
C
	IF ((LEN(parameters) .EQ. 0) .OR.
	1   (parameters(1:1) .EQ. ' '))
	1	CALL LIB$STOP( UAC__NONAME)
C
C Get length of user name and start of DCL symbol name
C
	l_un = LIB$LOCC( ' ', parameters)
	IF (l_un .EQ. 0) CALL LIB$STOP( UAC__INSFPARM)
C
C Open the UAC file.
C
	CALL OPEN_UACFILE
C
C Read the record for our user, signal and exit if no such user.
C
	username = parameters(1:l_un)
	IF (.NOT. READ_UACFILE( username(1:namelen), status))
	1	CALL LIB$STOP( UAC__USRNOTIN)
C
C Set DCL symbol to the extra text.
C
	IF (textlen .GT. 0) THEN
	    status = LIB$SET_SYMBOL( parameters(l_un+1:),
	1			     record(textbeg:reclen))
	    ELSE
	    null_descr(2) = %LOC(record)
	    status = LIB$SET_SYMBOL( parameters(l_un+1:),
	1			     null_descr)
	    ENDIF
	IF (.NOT. status) CALL LIB$SIGNAL( UAC__FATAL,, %VAL(status))
C
	RETURN
	END