;**********************************************************************
;
; EMPASS	-	EMAIL PASSWORD utility
;
;                 Written by: Dave Heyliger - AMUS Staff
;
;       Purpose: allows user to modify their own password
;
;   NOTE: NEED AAA.M68 and assemble this file. It will create AAA.UNV
;
;*********************************************************************

	SEARCH 	SYS				;grab the regulars
	SEARCH	SYSSYM
	SEARCH	TRM
	SEARCH  AAA				;AAA.UNV from AMUS Network

	.OFINI
	.OFDEF	ODDB,D.DDB			;output file for .USR and .DAT
	.OFDEF	IDDB,D.DDB			;input file DDB
	.OFDEF	NAME,4				;PACKed user name buffer
	.OFDEF	PASS,4				;PACKed user password
	.OFDEF	ASCBUF,20.			;20 byte ascii buffer
	.OFDEF	RECORD,2			;octal block number of person
	.OFSIZ	IMPSIZ				;final size of memory space

DEFINE ERASE=PRTTAB -1,10.	;erase to end of screen
DEFINE CLRLIN=PRTTAB -1,9.	;erase to end of line

	;define a version number
	VMAJOR=1.				;original program by
	VMINOR=0				;Dave Heyliger - AMUS
	VEDIT=0

	PHDR	-1,0,PH$REE!PH$REU		;reentrant, reusable

	GETIMP	IMPSIZ,A3			;A3 dedicated variable pointer

	;start of program
START:	PRTTAB	-1,0				;clear the screen
	PRTTAB	4,20.				;tab here
	TYPECR	<AMUS EMAIL Password Modification Utility>
	CALL	GETNAM				;get their name
	NOECHO					;no echo of keystrokes
	CALL	GETPAS				;and their password
	CALL	FILINI				;get EMAIL.USR
	CALL	FNDUSR				;find the user
	CMM	4(A1),PASS(A3)			;user enter correct password?
	BEQ	10$				;yup
	MOV	#7,D1				;nope, get a bell
	TTY					;beep!
	TYPECR	<?User not found>
	EXIT

10$:	PRTTAB	20.,20.				;tab here
	MOV	#7,D1				;get a bell
	TTY					;Beep!
	TYPECR	<User found, time for a new password>
	CALL	GETPAS				;get new password
	CALL	MODIFY				;modify the password
	MOV	#7,D1				;get a bell
	TTY					;beep!
	PRTTAB	22.,1				;tab here
	TYPECR	<Your password's been changed on disk - rebooting will record change in memory.>
	EXIT


;GET NAME Subroutine - moves a name into the NAME variable
;	on entry: true
;	on exit:  name is in PACKed format in the NAME(A3) variable
;------------------------------------------------------------------
GETNAM:	PRTTAB	8.,9.				;tab here
	TYPE  	<Enter user name (up to 6 characters): >
TL:	CLRLIN					;erase to end of line

	;get keyboard input and parse
	KBD					;get the name
	CTRLC	BYEBYE				;out no questions
	LIN					;just a CR?
	BNE	NC				;nope, Name Character entered

	;must enter a "valid" name
NAMERR:	LEA	A1,ONESIX			;yup, get 1 to 6 message
	CALL	EO				;error out
	PRTTAB	8.,47.				;tab back to prompt
	BR	TL				;and try again

	;something entered, count the characters
NC:	PUSH	A2				;save pointer to start of name
	CLR	D4				;character counter
NXTCHR:	CMPB	@A2,#15				;CR yet?	
	BEQ	CHKNAM				;yup, do some name checks
	INC	A2				;nope, bypass this character
	INC	D4				;increment character count
	BR	NXTCHR				;get next character

	;see if 6 characters or less entered
CHKNAM:	CMP	D4,#7				;too many characters
	BLT	F6				;nope
	POP	A2				;yup, adjust stack
	BR	NAMERR				;and type out error

	;get name and pack it into NAME(A3)
F6:	CMP	D4,#6				;full six?
	BEQ	PAKNAM				;yup, pack freely brother!
	MOVB	#40,(A2)+			;nope, fill w/ spaces
	INC	D4				;increment character count
	BR	F6				;see if full six now
PAKNAM:	POP	A2				;point to start
	LEA	A1,NAME(A3)			;point to RAD50 name variable
	PACK					;pack the name
	PACK
	RTN					;and return

;GET PASSWORD Subroutine - get password into password variable
;	on entry: true
;	on exit:  user's password is in the PASS(A3) variable
;-------------------------------------------------------------
GETPAS:	PRTTAB	10.,9.				;tab here
	TYPE	<Enter user password (up to 6 characters): >
GP:	CLRLIN					;erase to end of screen

	;parse password input
	KBD					;get the password
	CTRLC	BYEBYE				;no questions
	LIN					;just a CR?
	BNE	PC				;nope, Password Character in

	;come here on bad passwords
PASSRR:	LEA	A1,ONESIX			;yup, get 1 to 6 message
	CALL	EO				;error out
	PRTTAB	10.,51.				;tab here
	BR	GP				;try again

	;something entered, count the characters
PC:	PUSH	A2				;save pointer to start of pass
	CLR	D4				;character counter
NXTCR:	CMPB	@A2,#15				;CR yet?	
	BEQ	CHKNM				;yup, do some name checks
	INC	A2				;nope, bypass this character
	INC	D4				;increment character count
	BR	NXTCR				;get next character

	;parse above work..
CHKNM:	CMP	D4,#7				;too many characters
	BLT	FULL6				;nope
	POP	A2				;yup, adjust stack
	BR	PASSRR				;and report error

	;PACK the password into PASS(A3)
FULL6:	CMP	D4,#6				;full six?
	BEQ	PAKPAS				;yup, pack freely brother!
	MOVB	#40,(A2)+			;nope, fill w/ spaces
	INC	D4				;increment character count
	BR	FULL6				;see if full six now
PAKPAS:	POP	A2				;point to start
	LEA	A1,PASS(A3)			;point to password variable
	PACK					;pack the password
	PACK
	RTN
	
;MODIFY Subroutine - modifies password of user on file if there
;	on entry: user chose Change option
;	on exit : user password changed iff user found
;---------------------------------------------------------------
MODIFY:	CALL	FILINI				;initialize EMAIL.USR
	LOOKUP	@A4				;is DSK0:EMAIL.USR[7,2] there?
	BNE	NOUSR				;nope, error
	CALL	FNDUSR				;A1 points to user found

	;see if BOX:EMAIL.USR comes up empty or NAME found
	CMP	D4,#0				;user not found anywhere on 0
	BNE	GU				;not 0, got the user	
	LEA	A1,ERR3				;user not on file error
	CALL	EO				;error out
	RTN

	;if user found, rewrite NAME and PASS
GU:	CALL	PLACE				;place in new password
	RTN					;and return

NOUSR:	CRLF					;crlf
	TYPECR	<	?DSK0:EMAIL.USR[7,2] does not exist.>
	EXIT


;FIND USER Subroutine - finds a user in EMAIL.USR
;	on entry: BOX:EMAIL.USR exists
;	on exit : if user found or no space, A1 points to the user - NOT 0!
;		  if user not found and space, A1 points to 0
;----------------------------------------------------------------------
FNDUSR:	OPENR	@A4				;open random file for proc.
	READ	@A4				;get the first block
	MOV	IDDB+D.WRK(A3),D4		;D4 holds total size in blocks

	;search for an empty slot in the random file via A1
SRCH:	MOV	IDDB+D.BUF(A3),A1		;A1 points to buffer area
	MOV	#20.,D3				;look 20 times per block
	LEA	A2,NAME(A3)			;point to packed name
FNDNAM:	CMM	@A2,@A1				;find name?
	BNE	NOMTCH				;nope, all ok still
	RTN					;found a name

	;each user occupies 24. decimal bytes, so bypass the user
NOMTCH:	DEC	D3				;one less scan to do
	BEQ	NXTBLK				;if zero, get next block
	ADD	#24.,A1				;else get next record
	BR	FNDNAM				;and search again

	;if the first block is full, read in next block (if present)
NXTBLK:	DEC	D4				;one less block to scan
	BEQ	HMMM				;0 = file full or no user fnd
	INC	IDDB+D.REC(A3)			;point to next block
	READ	@A4				;read next block
	BR	SRCH				;search again

	;file full baby, close it up, A1 not pointing to 0
HMMM:	CLOSE	@A4				;close random file
	RTN					;and return


;FIND SPOT Subroutine - find a spot in EMAIL.USR for update or...
;	on entry: BOX:EMAIL.USR not full, no dups for the user
;	on exit : A1 points to spot in block where user info may be added
;-------------------------------------------------------------------------
FNDSPT:	OPENR	@A4				;get first block again
	READ	@A4				;get the block
	MOV	IDDB+D.WRK(A3),D4		;D4 holds number of blocks

	;look for an empty slot (non linear)
ABUF:	MOV	IDDB+D.BUF(A3),A1		;A1 points to buffer area
	MOV	#20.,D3				;look 20 times per block
ES:	CMP	@A1,#0				;found the empty space?
	BNE	NEMPTY				;nope Not Empty yet
	RTN					;yup, found a spot (A1)

	;slot full, point to next slot
NEMPTY:	DEC	D3				;one less scan to do
	BEQ	NB2				;if 0 then try next block
	ADD	#24.,A1				;else point to next spot
	BR	ES				;and try again

	;block full, get next block - should be one there
NB2:	DEC	D4				;one less block
	BEQ	HMM2				;should NEVER be 0!!!
	INC	IDDB+D.REC(A3)			;point to next block
	READ	@A4				;read it
	BR	ABUF				;and scan again

HMM2:	TYPECR	<	WHOA!!! Major error dude! I can't find the next block!>
	EXIT

;PLACE Subroutine - place a user into EMAIL.USR file
;	on entry: A1 points to free slot in block of EMAIL.USR
;	on exit: User NAME, PASS, placed in free slot
;----------------------------------------------------------------
PLACE:	MOV	NAME(A3),(A1)+
	MOV	PASS(A3),(A1)+
	WRITE	@A4
	CLOSE	@A4
	RTN

;FILE INITIALIZATION Subroutine - inits DSK0:EMAIL.USR[7,2]
;	on entry: true
;	on exit:  BOX:EMAIL.USR initialized - ready for READ
;		  A4 pointer to DDB
;-----------------------------------------------------------
FILINI:	MOVW	#[EMA],IDDB+D.FIL(A3)		;set up index DDB (random file)
	MOVW	#[IL ],IDDB+D.FIL+2(A3)		;DSK0:EMAIL.USR[7,2]
	MOVW	#[USR],IDDB+D.EXT(A3)
	MOVW	#[DSK],IDDB+D.DEV(A3)
	MOVW	#0,IDDB+D.DRV(A3)
	MOVW	#3402,IDDB+D.PPN(A3)
	LEA	A4,IDDB(A3)			;point to input file
	INIT	@A4				;create block buffer space
	RTN					;and return

;ERROR OUT Subroutine - warns user of improper input
;	on entry: A1 points to "ERROR MESSAGE crlf0"
;	on exit:  error message typed to the screen on line 24
;-------------------------------------------------------------
EO:	PRTTAB	24.,30				;tab here
	MOV	#7,D1				;get a bell
	TTY					;beep
	TTYL	@A1				;type out specific err msg
	RTN					;and return

BYEBYE:	EXIT

DELMSG:	ASCII	/	EMAIL DELETE Routine/
	BYTE	15,12,0
	EVEN
CHGMSG:	ASCII	/	EMAIL CHANGE Routine/
	BYTE	15,12,0
	EVEN
ERR1:	ASCIZ	/	?User already exists/
ERR2:	ASCIZ	/	?EMAIL.USR full/
ERR3:	ASCIZ	/	?User not on file/
ONESIX:	ASCIZ	/	1 to 6 characters please!/
	END

.