;********************************************************************** ; ; MAILOP.M68 - MAIL OPERATOR ; ; Written by: Dave Heyliger - AMUS Staff ; ; Purpose: allows the SYSOP to define EMAIL users etc. ; ; The following functions are provided: ; 1) A (add) a user to the current list of EMAIL users ; 2) D (delete) a user from the current list ; 3) C (change) a user password ; 4) L (list users on file, including passwords) ; 5) I (initialize mail system - DO THIS ONLY ONCE!) ; 6) Q (quit) from this program ; ;********************************************************************* SEARCH SYS ;grab the regulars SEARCH SYSSYM SEARCH TRM .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 PRTTAB AA,BB ;PRINT TAB (#,#) PUSH D1 ;black box MOVB #AA,D1 ;get row LSLW D1,#10 ;move it to MSB MOVB #BB,D1 ;get column TCRT ;tab POP D1 ;black box ENDM DEFINE ONEKEY ;makes KBD only accept one key (D1 holds it) PUSH A6 ;"black box" JOBIDX A6 ;get JCB pointer MOV JOBTRM(A6),A6 ;A6 holds pointer to TSW ORW #T$IMI,@A6 ;set "one key" for KBD (D1 will hold char.) POP A6 ;restore original ENDM DEFINE MLTKEY ;multiple keystrokes on KBD call (A2 pointer) PUSH A6 ;"black box" PUSH D4 JOBIDX A6 MOV JOBTRM(A6),A6 ;A6 holds pointer to TSW MOVW #T$IMI,D4 ;we will complement this value COMW D4 ;to set up the AND so as to ANDW D4,@A6 ;turn off the T$IMI bit (back to normal mode) POP D4 ;restore originals POP A6 ENDM 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!PH$OPR ;must be in OPR: account GETIMP IMPSIZ,A3 ;A3 dedicated variable pointer ;repeat the following loop til Quit.... CALL SCREEN ;generate option screen TOP: PRTTAB 13.,1 ;tab here CALL GETINP ;get operator input BR TOP ;and repeat til Quit BYEBYE: EXIT ;come here on Quit ;SETUP SCREEN Subroutine - sets up options for the SYSOP ; on entry: MAILOP called from AMOS dot ; on exit : Options listed to the screen ;------------------------------------------------------- SCREEN: PRTTAB -1,0 ;clear the screen CRLF CRLF TYPECR < EMAIL OPERATOR FUNCTIONS:> CRLF TYPECR < A - Add user> TYPECR < D - Delete user> TYPECR < C - Change user password> TYPECR < L - List users on file> TYPECR < I - Initialize mail system> TYPECR < Q - Quit> CRLF TYPE < Option: > RTN ;GET INPUT - only A, D, C, L, I, or Q allowed ; on entry: Options listed to the screen ; on exit : Option selected and acted upon ;----------------------------------------------- GETINP: PRTTAB 12.,17. ;tab here CLRLIN ;erase to end of screen ONEKEY ;need just one key KBD ;prompt CTRLC BYEBYE ;if ^C, get out no questions MLTKEY ;back to multiple keys UCS ;upper case the input CMPB D1,#15 ;just a CR? JEQ ERROP ;yup, scold ;see if sysop wants to Add a user CMPB D1,#'A ;ADD? BNE DELOP ;nope, maybe Del ERASE ;erase to end of screen CALL GETNAM ;yup, get user name CALL GETPAS ;and get password CALL ADDNAM ;update .DAT file RTN ;see if sysop wants to Delete a user DELOP: CMPB D1,#'D ;DEL? BNE CHGOP ;nope, maybe Change ERASE ;erase to end of screen LEA A1,DELMSG ;point to delete message CALL GETNAM ;yup, get user name CALL DELNAM ;and delete them RTN ;see if sysop wants to Change user's password CHGOP: CMPB D1,#'C ;CHANGE? BNE LSTUSR ;nope, maybe list ERASE ;erase to end of screen LEA A1,CHGMSG ;point to change message CALL GETNAM ;yup, get the name CALL GETPAS ;and the password CALL MODIFY ;and modify RTN ;see if List is the option LSTUSR: CMPB D1,#'L ;LIST? BNE INITOP ;nope, maybe initialize CALL LSTNAM ;list all names on file RTN ;see if Initialize is the option INITOP: CMPB D1,#'I ;INITIALIZE BNE QUITOP ;nope, probably quit ERASE ;erase to end of screen CALL EFILE ;create EMAIL.USR, EMAIL.DAT RTN ;see if option chose was Quit QUITOP: CMPB D1,#'Q ;QUIT? BNE ERROP ;nope, no more possibilites PRTTAB -1,0 ;yup, clear screen EXIT ;and quit ;didn't choose valid option ERROP: MOV #7,D1 ;get a bell TTY ;ding user who is dingy! RTN ;GET NAME Subroutine - moves a name into NAME variable ; on entry: user chose Add option ; on exit: name is in PACKed format in the NAME(A3) variable ;------------------------------------------------------------------ GETNAM: PRTTAB 13.,0 ;tab here ERASE ;erase to end of screen PRTTAB 14.,9. ;tab here TYPE 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 14.,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 16.,9. ;tab here TYPE 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 16.,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 ;ADD NAME Subroutine - Adds the new name and password to EMAIL.USR file ; on entry: Add was the chosen option ; on exit : user added to EMAIL.USR iff no duplicates ;----------------------------------------------------------------------- ADDNAM: CALL FILINI ;initialize EMAIL.USR LOOKUP @A4 ;is DSK0:EMAIL.USR[7,2] there? BNE NOUSR ;nope, error CALL FNDUSR ;yup, search for user etc ;if A1 points to 0, then space else full or user found! CMP @A1,#0 ;must be 0 to place user in BEQ NNFND ;it is, no name found, AOK CMP D4,#0 ;file full? BNE E1 ;nope, user on file error ;BOX:EMAIL.USR full, report LEA A1,ERR2 ;yup, file full error CALL EO ;error out RTN ;and return ;user found, report E1: LEA A1,ERR1 ;user on file error CALL EO ;bell them RTN ;and return NNFND: CALL FNDSPT ;find the spot to add user CALL PLACE ;place user in correct loc. RTN ;and return ;come here if BOX:EMAIL.USR does not exist NOUSR: CRLF ;nope - error TYPECR < ?DSK0:EMAIL.USR[7,2] does not exist.> TYPECR < You must use MAILOP's "I" selection.> RTN ;and return ;DELETE USER Subroutine - finds a user and deletes them ; on entry: user chose Delete option ; on exit: user NAME and PASS are zeroed in BOX:EMAIL.USR ;--------------------------------------------------------------- DELNAM: CALL FILINI ;initialize EMAIL.USR LOOKUP @A4 ;is DSK0:EMAIL.USR[7,2] there? JNE NOUSR ;nope, error CALL FNDUSR ;A1 points to user found ;A1 points to user to be deleted, see if user really found CMP D4,#0 ;user not found anywhere on 0 BNE GOTUSR ;not 0, got the user ;user not found, report error LEA A1,ERR3 ;user not on file error CALL EO ;error out RTN ;user found, clear out their NAME and PASSword GOTUSR: CLR NAME(A3) ;clear name CLR PASS(A3) ;and password CALL PLACE ;write changes RTN ;and return ;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? JNE 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 ;LIST NAME Subroutine - lists all users on file ; on entry: List was the chosen option ; on exit: User ^C'ed or all names/passwords listed to screen ;-------------------------------------------------------------------- LSTNAM: PRTTAB -1,0 ;clear screen CRLF TYPECR < EMAIL USER LIST> CRLF CALL FILINI ;initialize EMAIL.USR LOOKUP @A4 ;search for it JNE NOUSR ;not found - error ;open BOX:EMAIL.USR, record # blocks, read 1st block OPENR @A4 ;open random file for proc READ @A4 ;read the 1st block MOV IDDB+D.WRK(A3),D4 ;D4 holds number of blocks CLR D2 ;who counter ;point A1 to block read, 20 users/block listed.... LN: MOV IDDB+D.BUF(A3),A1 ;A1 points to buffer area MOV #20.,D3 ;look 20 times per block SCNAME: CMP @A1,#0 ;found a name? JEQ NXTNAM ;nope, try again ;name found, see if screen full INC D2 ;counter = counter + 1 CMP D2,#20. ;20 users out? BNE N20 ;screen full, provide screen control TYPE KBD CTRLC BYEBYE CLR D2 PRTTAB -1,0 CRLF TYPECR < EMAIL USER LIST> CRLF ;not up to 20 users out yet, type em out (A1 points to user) N20: TYPE < > ;tab over LEA A2,ASCBUF(A3) ;point to ascii buffer PUSH A2 ;save start location UNPACK ;get name in ASCII UNPACK CLRB @A2 ;end string w/null POP A2 ;retrieve start location TTYL @A2 ;type it out TYPE < (> ;tab over, type "(" LEA A2,ASCBUF(A3) ;point to buffer space PUSH A2 ;save start location UNPACK ;create password in ASCII UNPACK CLRB @A2 ;end string w/null POP A2 ;retrieve start location TTYL @A2 ;type it out TYPECR ) ;type ")" ADD #16.,A1 ;bypass stats BR DECD3 ;stats found, don't inc A1 ;slot empty, bypass total slot variable NXTNAM: ADD #24.,A1 ;point to next user ;count users and blocks, adjust accordingly... DECD3: DEC D3 ;one less scan to do BEQ GNB ;if 0 get next block JMP SCNAME ;else SCan for NAME ;another block done, get next block GNB: DEC D4 ;one less block to search BEQ ALLOUT ;if 0 all names out INC IDDB+D.REC(A3) ;point to next block READ @A4 ;read next block JMP LN ;search again ;all blocks out, time to quit ALLOUT: CLOSE @A4 ;close file and return CRLF TYPE KBD CTRLC BYEBYE CALL SCREEN ;generate screen RTN ;and return ;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 ;EFILE Subroutine - creates EMAIL.USR and EMAIL.DAT ; on entry: User chose Initialize ; on exit: BOX:EMAIL.DAT, BOX:EMAIL.USR created and initialized ;---------------------------------------------------------------------- EFILE: PRTTAB 13.,1 ;tab here CALL FILINI ;see if BOX:EMAIL.USR there LOOKUP @A4 ;there? BNE 10$ ;nope MOV #7,D1 ;yup, bell TTY ;beep! TYPECR < ?EMAIL.USR already exists - I don't think you want to do this!!> RTN ;and return ;looks ok from here..... 10$: CRLF TYPECR < EMAIL file creation utility> CRLF TYPECR < Creates EMAIL.USR, EMAIL.DAT, and EMAIL.SYS> CRLF CRLF TYPE < Estimated maximum number of users (multiples of 20): > CLR D1 ;clear count for GTDEC KBD ;get input CTRLC BYEBYE ;^C Quits ;save count, create files one by one.... PUSH D1 ;save count CRLF ;screen control TYPE < Working, please wait...> ;oooo! POP D1 ;retrieve count GTDEC ;get the number of users (dec) ;take the number and divide by 20. This is number for EMAIL.USR DIV D1,#20. ;divide by 20 AND #^H0FFFF,D1 ;clear high word CMP D1,#0 ;is it zero? BNE MAKUSR ;nope MOV #1,D1 ;yup, need at least one block MAKUSR: PUSH D1 ;save number of users/20 MOVW #[EMA],ODDB+D.FIL(A3) ;move in BOX:EMAIL.USR MOVW #[IL ],ODDB+D.FIL+2(A3) MOVW #[USR],ODDB+D.EXT(A3) MOVW #[DSK],ODDB+D.DEV(A3) MOVW #0,ODDB+D.DRV(A3) MOVW #3402,ODDB+D.PPN(A3) LEA A4,ODDB(A3) ;point to DDB INIT @A4 ;initialize LOOKUP @A4 ;exist? BNE MU2 ;nope, make it CRLF ;yup, error! MOV #7,D1 ;get a bell TTY ;beep! TYPECR < ?EMAIL.USR already exists man! Don't destroy your hard work.> POP D1 ;adjust stack RTN ;and return ;BOX:EMAIL.USR not found, make it and initialize EMAIL.DAT block #'s MU2: MOV D1,ODDB+D.ARG(A3) ;number of blocks to reserve DSKCTG @A4 ;allocate contiguous file ;open new file and produce EMAIL.DAT record block numbers etc... OPENR @A4 ;open it for random process CLR D4 ;EMAIL.DAT record counter USRIPT: READ @A4 ;get a block MOV ODDB+D.BUF(A3),A1 ;get buffer pointer MOV #20.,D3 ;do the following 20 times: CLRUSR: CLR (A1)+ ;clear the name CLR (A1)+ ;clear the password MOVW D4,(A1)+ ;set the record number CLRW (A1)+ ;clear semaphore CLR (A1)+ ;clear 3 JOBIDX's CLR (A1)+ CLR (A1)+ INC D4 ;generate next record number DEC D3 ;decrement loop counter BNE CLRUSR ;block done, finish block with 0's MOV #10,D5 ;clear out the rest of the blk 10$: CLR (A1)+ ;write a "0" DEC D5 ;one less to do BNE 10$ ;if first block, store size of file at offset 508. WRTBLK: CMP D1,ODDB+D.WRK(A3) ;if D1 = D.ARG BNE D1DARG ;(nope), not first block SUB #4,A1 ;point to last byte in block MOV D1,@A1 ;store block count ;write block, get next block if nec... D1DARG: WRITE @A4 DEC D1 ;decrement block count BEQ USRDON ;if count = 0 then .USR done INC ODDB+D.REC(A3) ;else get next block number BR USRIPT ;and repeat ;all done w/ BOX:EMAIL.USR, time for BOX:EMAIL.DAT USRDON: CLOSE @A4 ;EMAIL.USR is closed ;fancy screen control! MAKDAT: TYPE . MOV @SP,D1 ;get block count MUL D1,#20. ;20 blocks per 1 block .USR MOVW #[DAT],ODDB+D.EXT(A3) ;now make BOX:EMAIL.DAT INIT @A4 LOOKUP @A4 ;there? BNE M3 ;nope, make it ;BOX:EMAIL.DAT there, you don't want to destroy it, do you? CRLF MOV #7,D1 ;get a bell TTY ;beep TYPECR < ?EMAIL.DAT already exists! You really don't want to do this, do you?!!> POP D1 ;adjust stack RTN ;and return ;not there, create it M3: MOV D1,ODDB+D.ARG(A3) ;move number of blocks here DSKCTG @A4 ;make it ;open the file, read each block... OPENR @A4 ;open it for random process 5$: READ @A4 ;get a block MOV ODDB+D.BUF(A3),A1 ;get buffer pointer ;for each block, clear the block to nulls MOV #128.,D3 ;do the following 128 times: 10$: CLR (A1)+ ;clear the block DEC D3 ;decrement counter BNE 10$ ;still more to clear ;block all nulls, write block, get next block if there WRITE @A4 DEC D1 ;decrement block count BEQ 20$ ;if count = 0 then .DAT done INC ODDB+D.REC(A3) ;else get next block number BR 5$ ;and repeat ;finally, make a "dummy" system file that may be LOADed via SYSTEM 20$: LEA A4,ODDB(A3) ;point to DDB MOVW #[SYS],ODDB+D.EXT(A3) ;now make BOX:EMAIL.SYS INIT @A4 ;create buffer space LOOKUP @A4 ;there? BNE M4 ;nope, make it ;BOX:EMAIL.SYS already there, don't destroy it! CRLF MOV #7,D1 ;get a bell TTY ;beep! TYPECR < ?EMAIL.SYS already exists! Let's not destroy it, ok?> POP D1 ;adjust stack RTN ;open the file, need one more block than EMAIL.USR for "pointer junk" M4: OPENO @A4 POP D4 ;get block count INC D4 ;take into account pointers ;need an extra block (bummer) ;now just make the file all nulls BL: CLR D1 ;here is the null MOV #255.,D3 ;do 510 times (255 *2) CLRWRD: FILOTW @A4 ;clear word in block DEC D3 ;one less word to clear BEQ NXTSYS ;0 = next .sys block to clear BR CLRWRD ;else clear next word ;get the next block, do it again NXTSYS: DEC D4 ;one less block to do BEQ SYSDON ;done with the file BR BL ;clear next block ;all done, time to close SYSDON: CLOSE @A4 ;file created CRLF RTN EXIT: 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 .