;**********************************************************************
;
; 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
