10	! [LOMASKY.SYS]TRANSFER_PWD_TO_NODE.BAS
	!
	! When executed by a user, this program will:
	!  1) Read a nodename from SYS$COMMAND:.  If end-of-file, exit program.
	!  2) Open SYS$SYSTEM:SYSUAF.DAT on the specified node.
	!  3) Read a username from SYS$INPUT:.  If end-of-file, exit program.
	!  4) Read the username's current password data from the SYSUAF.
	!  5) Update the remote SYSUAF.DAT file with the current node's password
	!     data.
	!  6) Continue with above step #3.
	!
	! ----- Restriction:  Does not process SECONDARY Passwords -----
	!
	! ----- Restriction:  The user must have SYSPRV (or equiv) -----
	! -----               privilege -----
	!
	! ====> The user running this program must have proxy access on <====
	! ====> the remote node which grants SYSPRV privilege (or equiv) <====
	!
	! ----- Requires BASIC V3.n -----
	!
	! Compile and Link TRANSFER_PWD_TO_NODE.BAS as follows:
	!	$BASIC/LONG TRANSFER_PWD_TO_NODE
	!	$LINK/NOTRACEBACK TRANSFER_PWD_TO_NODE
	!	$SET PROT=(S:RWED,O:RWE,G:E,W:E) TRANSFER_PWD_TO_NODE.EXE
	!
	! ----- Last Change 05/01/90 by Brian Lomasky -----

	OPTION TYPE = EXPLICIT

	%LET %DEBUG = 0%			! 1 IF DEBUG, 0 IF NO DEBUG
						! (2 IS SAME AS 1, EXCEPT NO
						! FILE WILL BE UPDATED)

	ON ERROR GOTO ERROR_ROUTINE		! TRAP ALL ERRORS

	%INCLUDE "$LNMDEF" %FROM %LIBRARY "SYS$LIBRARY:BASIC$STARLET.TLB"
	%INCLUDE "$UAIDEF" %FROM %LIBRARY "SYS$LIBRARY:BASIC$STARLET.TLB"

	! ----- SYSTEM SERVICE ERROR CODES AND FUNCTION VALUES -----
	EXTERNAL LONG CONSTANT SS$_NOLOGNAM	! NO LOGICAL NAME TRANSLATION
	EXTERNAL LONG CONSTANT SS$_NORMAL	! NORMAL SUCCESS STATUS

	! ----- COMMON CONSTANTS -----
	DECLARE LONG CONSTANT TRUE = (1% = 1%)
	DECLARE LONG CONSTANT FALSE = NOT TRUE

	! ----- TO RETURN ERROR (0) IN $STATUS BUT HAVE NO MESSAGE -----
	! ----- DISPLAYED ON THE SCREEN, ALSO SET BIT 28 (HEX 10000000) IN -----
	! ----- THE VALUE YOU PASS TO SYS$EXIT -----
	DECLARE LONG CONSTANT ERROR_WITH_NO_PUTMSG = 0% OR X"10000000"L

	! ----- BASIC ERROR CODE CONSTANTS -----
	DECLARE WORD CONSTANT BUCKET_LOCKED = 154%
	DECLARE WORD CONSTANT END_OF_FILE = 11%
	DECLARE WORD CONSTANT PROTECTION_VIOLATION = 10%
	DECLARE WORD CONSTANT REC_NOT_FOUND = 155%

	RECORD TRNBUF				! $TRNLNM RECORD
		WORD BUFFER_LENGTH1
		WORD ITEM_CODE1
		LONG BUFFER_ADDRESS1
		LONG RETURN_LENGTH_ADDRESS1
		LONG LIST_TERMINATOR
	END RECORD TRNBUF

	RECORD UAIBUF				! $GETUAI RECORD
		WORD BUFFER_LENGTH1
		WORD ITEM_CODE1
		LONG BUFFER_ADDRESS1
		LONG RETURN_LENGTH_ADDRESS1
		WORD BUFFER_LENGTH2
		WORD ITEM_CODE2
		LONG BUFFER_ADDRESS2
		LONG RETURN_LENGTH_ADDRESS2
		WORD BUFFER_LENGTH3
		WORD ITEM_CODE3
		LONG BUFFER_ADDRESS3
		LONG RETURN_LENGTH_ADDRESS3
		WORD BUFFER_LENGTH4
		WORD ITEM_CODE4
		LONG BUFFER_ADDRESS4
		LONG RETURN_LENGTH_ADDRESS4
		WORD BUFFER_LENGTH5
		WORD ITEM_CODE5
		LONG BUFFER_ADDRESS5
		LONG RETURN_LENGTH_ADDRESS5
		LONG LIST_TERMINATOR
	END RECORD UAIBUF

	DECLARE STRING ERROR_LINE		! ERROR LINE DESCRIPTION
		ERROR_LINE = "INIT"		! INIT ERROR DESCRIPTION
	DECLARE WORD LOG_LENGTH			! LENGTH OF LOGICAL NAME
	DECLARE STRING NODE_NAME		! NODE NAME TO UPDATE
	DECLARE WORD SAVE_ERR			! SAVED ERROR NUMBER
	DECLARE LONG SYS_STATUS			! SYSTEM SERVICE STATUS
	DECLARE STRING TEMP_STRING		! TEMPORARY STRING
	DECLARE STRING THIS_NODE		! NAME OF THIS NODE
	DECLARE TRNBUF TRNITEM			! EQUATE $TRNLNM RECORD
	DECLARE WORD UAF_ENCRYPT_LENGTH		! LENGTH OF UAF_ENCRYPT
	DECLARE WORD UAF_FLAGS_LENGTH		! LENGTH OF UAF FLAGS
	DECLARE WORD UAF_PWD_DATE_LENGTH	! LENGTH OF UAF_PWD_DATE
	DECLARE WORD UAF_PWD_LENGTH		! LENGTH OF UAF_PWD
	DECLARE WORD UAF_SALT_LENGTH		! LENGTH OF UAF_SALT
	DECLARE UAIBUF UAIITEM			! EQUATE $GETUAI RECORD

	MAP (AUSER)	STRING USERNAME = 12%	! USERNAME READ IN

	MAP (GETUAI)	LONG UAF_FLAGS,		! UAF FLAGS VIA $GETUAI	&
			LONG UAF_SALT,		! PASSWORD SALT		&
			LONG UAF_PWD(1%),	! PRIMARY PASSWORD	&
			LONG UAF_ENCRYPT,	! PRIMARY PW ENCRYPTION	&
			LONG UAF_PWD_DATE(1%)	! PRIMARY PW CHANGE DATE

	MAP (TRNLNM)	STRING LOG_NAME = 255%	! LOGICAL NAME FROM $TRNLNM

	! ---------------------------------------------------------
	! ----- FOLLOWING FLAG BITS ARE TURNED ON IF ENABLED: -----
	! ----- FLAGS(0%): -----
	! -----		BIT 0 = DISCTLY -----
	! -----		BIT 1 = DEFCLI -----
	! -----		BIT 2 = LOCKPWD -----
	! -----		BIT 3 = CAPTIVE -----
	! -----		BIT 4 = DISACNT -----
	! -----		BIT 5 = DISWELCOME -----
	! -----		BIT 6 = DISNEWMAIL -----
	! -----		BIT 7 = DISMAIL -----
	! ----- FLAGS(1%): -----
	! -----		BIT 0 = GENPWD -----
	! -----		BIT 1 = PWD_EXPIRED -----
	! -----		BIT 2 = PWD2_EXPIRED -----
	! -----		BIT 3 = AUDIT -----
	! -----		BIT 4 = DISREPORT -----
	! -----		BIT 5 = DISRECONNECT -----
	! -----		BIT 6 = AUTOLOGIN -----
	! --------------------------------------------------------------

	MAP (UAF)	STRING UAF_REC = 1412%

	MAP (UAF)	STRING FILL = 4%,				&
			! ----- USER_NAME IS THE PRIMARY KEY -----	&
			! ----- (NO DUPLICATES, NO CHANGES) -----	&
			STRING USER_NAME = 32%,		! ALJTB		&
			STRING FILL = 304%,				&
			LONG PASSWORD(1%),				&
			STRING FILL = 10%,				&
			WORD RANDOM_PASSWORD_SEED,			&
			BYTE ENCRYPTION_ALGORITHM,			&
			STRING FILL = 19%,				&
			LONG DATE_OF_PASSWORD_CHANGE(1%), ! CLUNKS	&
			STRING FILL = 80%,				&
			BYTE FLAGS(3%)

	EXTERNAL SUB LIB$STOP(LONG BY VALUE)	! STOP PROGRAM
	EXTERNAL LONG FUNCTION SYS$EXIT		! EXIT PROCESS WITH STATUS
	EXTERNAL LONG FUNCTION SYS$GETUAI	! GET UAF INFORMATION
	EXTERNAL LONG FUNCTION SYS$TRNLNM	! TRANSLATE LOGICAL NAME

	! ----- LOCAL FUNCTION TO READ A SPECIFIC UAF RECORD -----
	DEF LONG READ_MATCHING_UAF_RECORD
		ERROR_LINE = "READ MATCHING UAF RECORD"
		READ_MATCHING_UAF_RECORD = FALSE! ASSUME ERROR STATUS
		ON ERROR GOTO READ_MATCHING_UAF_RECORD_ERROR

		GET #1%, KEY #0% EQ USER_NAME

		! ----- IGNORE THIS UAF RECORD IF DISACNT (DISUSER) FLAG -----
		! ----- BIT IS SET -----
		IF (FLAGS(0%) AND 16%) = 16% THEN
			%IF %DEBUG <> 0% %THEN
				PRINT "DEBUG>DISUSER flag is set for";	&
					" this user on node "; NODE_NAME
			%END %IF
			UNLOCK #1%
			EXIT DEF
		END IF

		%IF %DEBUG <> 0% %THEN
			PRINT "DEBUG>***** This User exists in the";	&
				" UAF on node "; NODE_NAME; " *****"
		%END %IF
		READ_MATCHING_UAF_RECORD = TRUE	! RETURN SUCCESS STATUS
		EXIT DEF

	 READ_MATCHING_UAF_RECORD_ERROR:

		IF ERR = BUCKET_LOCKED THEN
			SLEEP 1%
			RESUME
		END IF
		RESUME READ_MATCHING_UAF_RECORD_EXIT IF ERR = REC_NOT_FOUND
		ON ERROR GO BACK

	 READ_MATCHING_UAF_RECORD_EXIT:

		%IF %DEBUG <> 0% %THEN
			PRINT "DEBUG>??????????????????????????????";	&
				"???????????????????????????????????????????"
			PRINT "DEBUG>????? This User DOES NOT exist";	&
				" in the UAF on node "; NODE_NAME; " ?????"
			PRINT "DEBUG>??????????????????????????????";	&
				"???????????????????????????????????????????"
		%END %IF

	END DEF

	! ----- GET NAME OF THIS NODE -----
	TRNITEM::BUFFER_LENGTH1		= 255%	! STORE DATA FOR $TRNLNM
	TRNITEM::ITEM_CODE1		= LNM$_STRING
	TRNITEM::BUFFER_ADDRESS1	= LOC(LOG_NAME)
	TRNITEM::RETURN_LENGTH_ADDRESS1	= LOC(LOG_LENGTH)
	TRNITEM::LIST_TERMINATOR	= 0%

	! ----- TRANSLATE SYS$NODE: LOGICAL NAME -----
	ERROR_LINE = "$TRNLNM"
	SYS_STATUS = SYS$TRNLNM(, "LNM$DCL_LOGICAL", "SYS$NODE", , TRNITEM)
	SELECT SYS_STATUS
	CASE SS$_NOLOGNAM		! IF NO LOGICAL EQUIVALENT:
		SYS_STATUS = SS$_NORMAL	! CLEAR SYS_STATUS ERROR CONDITION
		PRINT
		PRINT "TRANSFER_PWD_TO_NODE ERROR - NO LOGICAL NAME";	&
			" FOR SYS$NODE"
		PRINT "Notify your VAX System Manager"; BEL
		CALL SYS$EXIT(ERROR_WITH_NO_PUTMSG BY VALUE)
	CASE SS$_NORMAL
		! ----- EXTRACT LOGICAL NAME -----
		IF LOG_LENGTH > 1% THEN
			! ----- STORE NODE NAME AS name:: -----
			THIS_NODE = LEFT(LOG_NAME, LOG_LENGTH)
		ELSE
			PRINT
			PRINT "TRANSFER_PWD_TO_NODE ERROR -";		&
				" INVALID LOGICAL NAME"
			PRINT "Notify your VAX System Manager"; BEL
			CALL SYS$EXIT(ERROR_WITH_NO_PUTMSG BY VALUE)
		END IF
	CASE ELSE
		PRINT
		PRINT "TRANSFER_PWD_TO_NODE:TRNLNM ERROR: "; SYS_STATUS
		PRINT "Notify your VAX System Manager"; BEL
		CALL LIB$STOP(SYS_STATUS BY VALUE)
	END SELECT
	IF THIS_NODE = "" THEN
		PRINT
		PRINT "TRANSFER_PWD_TO_NODE ERROR: Can't Find Nodename"
		PRINT "Notify your VAX System Manager"; BEL
		! ----- RETURN ERROR STATUS -----
		CALL SYS$EXIT(ERROR_WITH_NO_PUTMSG BY VALUE)
	END IF
	%IF %DEBUG <> 0% %THEN
		PRINT "DEBUG>THIS_NODE="; THIS_NODE; "*"
	%END %IF

	UAIITEM::BUFFER_LENGTH1		= 4%	! STORE DATA FOR $GETUAI
	UAIITEM::ITEM_CODE1		= UAI$_FLAGS
	UAIITEM::BUFFER_ADDRESS1	= LOC(UAF_FLAGS)
	UAIITEM::RETURN_LENGTH_ADDRESS1	= LOC(UAF_FLAGS_LENGTH)
	UAIITEM::BUFFER_LENGTH2		= 4%
	UAIITEM::ITEM_CODE2		= UAI$_ENCRYPT
	UAIITEM::BUFFER_ADDRESS2	= LOC(UAF_ENCRYPT)
	UAIITEM::RETURN_LENGTH_ADDRESS2	= LOC(UAF_ENCRYPT_LENGTH)
	UAIITEM::BUFFER_LENGTH3		= 8%
	UAIITEM::ITEM_CODE3		= UAI$_PWD
	UAIITEM::BUFFER_ADDRESS3	= LOC(UAF_PWD(0%))
	UAIITEM::RETURN_LENGTH_ADDRESS3	= LOC(UAF_PWD_LENGTH)
	UAIITEM::BUFFER_LENGTH4		= 4%
	UAIITEM::ITEM_CODE4		= UAI$_SALT
	UAIITEM::BUFFER_ADDRESS4	= LOC(UAF_SALT)
	UAIITEM::RETURN_LENGTH_ADDRESS4	= LOC(UAF_SALT_LENGTH)
	UAIITEM::BUFFER_LENGTH5		= 8%
	UAIITEM::ITEM_CODE5		= UAI$_PWD_DATE
	UAIITEM::BUFFER_ADDRESS5	= LOC(UAF_PWD_DATE(0%))
	UAIITEM::RETURN_LENGTH_ADDRESS5	= LOC(UAF_PWD_DATE_LENGTH)
	UAIITEM::LIST_TERMINATOR	= 0%

	! ----- READ NODENAME FROM SYS$COMMAND: -----
	ERROR_LINE = "OPEN SYS$COMMAND:"
	OPEN "SYS$COMMAND:" AS FILE #1%, SEQUENTIAL

	PRINT #1%, "Enter Node Name (as node::)"

	ERROR_LINE = "READ NODENAME"
	LINPUT #1%, NODE_NAME
	ERROR_LINE = "AFTER READ NODENAME"
	CLOSE #1%				! CLOSE SYS$COMMAND:

	%IF %DEBUG <> 0% %THEN
		PRINT "DEBUG>Read Node Name: "; NODE_NAME
	%END %IF
	IF LEN(NODE_NAME) > 0% THEN
		IF RIGHT(NODE_NAME, LEN(NODE_NAME) - 1%) <> "::" THEN
			PRINT
			PRINT "%TRANSFER_PWD_TO_NODE Error:  ";		&
				"Invalid Node Name"
			! ----- RETURN ERROR STATUS -----
			CALL SYS$EXIT(ERROR_WITH_NO_PUTMSG BY VALUE)
		END IF
	END IF

	! ----- ERROR IF THIS NODE WAS SPECIFIED -----
	IF NODE_NAME = THIS_NODE THEN
		PRINT
		PRINT "%TRANSFER_PWD_TO_NODE Error:  Must be a Remote Node"
		! ----- RETURN ERROR STATUS -----
		CALL SYS$EXIT(ERROR_WITH_NO_PUTMSG BY VALUE)
	END IF

	! ----- OPEN THE SYSUAF.DAT FILE ON THE INDICATED NODE -----
	ERROR_LINE = "OPEN REMOTE NODE"

	TEMP_STRING = NODE_NAME + "SYS$SYSTEM:SYSUAF.DAT"
	%IF %DEBUG <> 0% %THEN
		PRINT "DEBUG>Opening "; TEMP_STRING
	%END %IF
	OPEN TEMP_STRING FOR INPUT AS FILE #1%,				&
		RECORDSIZE 1412%,					&
		ACCESS MODIFY,						&
		ALLOW MODIFY,						&
		INDEXED VARIABLE,					&
		MAP UAF,						&
		RECORDTYPE ANY

	WHILE TRUE
		ERROR_LINE = "READ USERNAME"
		LINPUT USERNAME
		ERROR_LINE = "AFTER READ USERNAME"

		ITERATE IF USERNAME = ""

		! ----- READ UAF RECORD FOR THIS USERNAME -----
		SYS_STATUS = SYS$GETUAI(, , USERNAME, UAIITEM, , , )
		IF SYS_STATUS <> SS$_NORMAL THEN
			PRINT
			PRINT "TRANSFER_PWD_TO_NODE GETUAI 2 ERROR: ";	&
				SYS_STATUS
			PRINT "Notify your VAX System Manager"; BEL
			CALL LIB$STOP(SYS_STATUS BY VALUE)
		END IF

		! ----- MAKE PASSWORD SALT A VALID WORD VALUE -----
		IF UAF_SALT < -32767% - 1% OR UAF_SALT > 65535% THEN
			PRINT
			PRINT "TRANSFER_PWD_TO_NODE ERROR: PW SALT";	&
				" OUT OF RANGE"; UAF_SALT
			PRINT "Notify your VAX System Manager"; BEL
			! ----- RETURN ERROR STATUS -----
			CALL SYS$EXIT(ERROR_WITH_NO_PUTMSG BY VALUE)
		END IF
		IF UAF_SALT > 32767% THEN
			UAF_SALT = UAF_SALT - 65536%
		END IF
		! ----- MAKE PASSWORD ENCRYPTION SEED A VALID BYTE VALUE -----
		IF UAF_ENCRYPT < -128% OR UAF_ENCRYPT > 255% THEN
			PRINT
			PRINT "TRANSFER_PWD_TO_NODE ERROR: PW ENCRYPT";	&
				" OUT OF RANGE"; UAF_ENCRYPT
			PRINT "Notify your VAX System Manager"; BEL
			! ----- RETURN ERROR STATUS -----
			CALL SYS$EXIT(ERROR_WITH_NO_PUTMSG BY VALUE)
		END IF
		IF UAF_ENCRYPT > 127% THEN
			UAF_ENCRYPT = UAF_ENCRYPT - 256%
		END IF

		! ----- SEE IF THIS USER HAS A UAF RECORD ON THE REMOTE -----
		! ----- NODE -----
		USER_NAME = USERNAME		! STORE PRIMARY KEY TO SEARCH
		IF READ_MATCHING_UAF_RECORD THEN
			! ----- TRANSFER PASSWORD DATA TO REMOTE UAF -----
			ERROR_LINE = "XFER PASSWORD"
			PASSWORD(0%) = UAF_PWD(0%)
			PASSWORD(1%) = UAF_PWD(1%)
			ERROR_LINE = "XFER RANDOM PASSWORD SEED"
			RANDOM_PASSWORD_SEED = UAF_SALT
			ERROR_LINE = "XFER ENCRYPTION ALGORITHM"
			ENCRYPTION_ALGORITHM = UAF_ENCRYPT
			ERROR_LINE = "XFER LAST CHANGE DATES"
			DATE_OF_PASSWORD_CHANGE(0%) = UAF_PWD_DATE(0%)
			DATE_OF_PASSWORD_CHANGE(1%) = UAF_PWD_DATE(1%)
			ERROR_LINE = "FIX FLAGS"
			! ----- TURN OFF ANY PWD_EXPIRED BIT -----
			FLAGS(1%) = FLAGS(1%) AND NOT 2%

			%IF %DEBUG = 2% %THEN
				PRINT "DEBUG>Would have updated Node ";	&
					NODE_NAME; "..."
				UNLOCK #1%
			%ELSE
				PRINT "Updating Node "; NODE_NAME; "..."
				UPDATE #1%
			%END %IF
		ELSE
			PRINT "%ERROR - This username is not on the";	&
				" Node: "; NODE_NAME + BEL
		END IF
	NEXT

 ERROR_ROUTINE:

	SAVE_ERR = ERR
	IF SAVE_ERR = BUCKET_LOCKED THEN
		SLEEP 1%
		RESUME
	END IF
	RESUME END_PROGRAM IF (ERROR_LINE = "READ NODENAME" OR		&
		ERROR_LINE = "READ USERNAME") AND SAVE_ERR = END_OF_FILE
	RESUME ERROR_PROCESSING

 ERROR_PROCESSING:

	ON ERROR GOTO 0				! DISABLE ERROR TRAPPING
	IF ERROR_LINE = "OPEN REMOTE NODE" THEN
		IF ERR = PROTECTION_VIOLATION THEN
			PRINT "TRANSFER_PWD_TO_NODE: Privilege";	&
				" violation while trying to open:"
			PRINT "                      "; TEMP_STRING
			PRINT "                      <Program Terminated>"; BEL
		END IF
	ELSE
		PRINT
		PRINT "Unexpected error"; SAVE_ERR;			&
			"in TRANSFER_PWD_TO_NODE"; BEL
		PRINT "After Error Line: "; ERROR_LINE
		PRINT "Notify your VAX System Manager"; BEL
		PRINT "Username="; USERNAME
		PRINT "FLAGS(0%)="; FLAGS(0%)
		PRINT "UAF_SALT="; UAF_SALT
		PRINT "UAF_ENCRYPT="; UAF_ENCRYPT
		PRINT ERT$(SAVE_ERR)
	END IF
	! ----- RETURN ERROR STATUS -----
	CALL SYS$EXIT(ERROR_WITH_NO_PUTMSG BY VALUE)

 END_PROGRAM:

	END