PROGRAM MAIL C CCC TSX+ MAIL SYSTEM VERSION 1.14 CCC C**************************************************************************** CCC CCC COPYRIGHT C 1986/1987 by M.P. MARAK, CONCORDIA UNIVERSITY CCC CCC This program may be copied, altered, or modified in any manner, with CCC the inclusion of the above COPYRIGHT notice. CCC CCC The author would appreciate notification of any changes, improvements, CCC or bugs found, by writing or by BITNET, at the addresses listed below. CCC C**************************************************************************** CCC CCC JAN /87 CCC CCC MIKE MARAK / (with help from DAVID GAUDINE) CCC LOYOLA EMC LAB CCC DEPARTMENT OF ELECTRICAL and COMPUTER ENGINEERING CCC LOYOLA CAMPUS, CONCORDIA UNIVERSITY CCC ROOM AD-532 CCC 7141 SHERBROOKE ST. W. CCC MONTREAL, CANADA CCC H4B 1R6 CCC (514) 848-3118 CCC CCC BITNET ADDRESS (NETNORTH) : MUFFY@CONU1 CCC C**************************************************************************** CCC CCC (D) indicates distribution sent to DECUS CCC Bn indicates BUG number CCC CCC B3 V1.14 Nov/23/87 Changed the CALL SCCA in WMAIL. V1.13 allowed CCC ^C-ing before the channel was closed or, CCC during a WRITE-TO-ALL, after sending the CCC message to the first user. CCC V1.13 Aug/21/87 (D) Add a PRINT MESSAGE option (print to unit 6). CCC V1.12 Aug/18/87 Fix up V1.11. Set JSW to UC for response. CCC Put ALERT message in a DATA statement. Get CCC rid of compiler warning message for WMAIL. CCC V1.11 Aug/13/87 Add an option to inform the destination user CCC (if logged on) that a message has just been CCC sent to him CCC V1.10 Aug/11/87 Change the output of the message date from CCC "11/ 8/87" to "11-Aug-87" CCC V1.9B Jun/18/87 Change the output of the message time from CCC " 9: 6: 6" to " 9:06:06" CCC V1.9A Jun/16/87 Allow only privileged users to use option 'A'. CCC V1.9 Jun/15/87 Add an option 'A' to allow sending messages CCC to ALL users. CCC V1.8 Jun/ 4/87 Add an option 'M' to allow users to only CCC see how many messages there are. CCC V1.7 Jun/ 2/87 If a user has mail, inform them how many CCC messages there are. CCC B2 V1.6 Apr/13/87 Clear the ACCESS byte in IOFSET(1) and the CCC MARK FOR DELETE bit (200) to allow a CCC user to read mail on a line when deleting on CCC another line. This will allow for only CCC 127 messages. CCC V1.5 Apr/ 4/87 Change MAIL SENT messages CCC B1 V1.4 Mar/19/87 (D) WUNAME initialized to NULLS in WMAIL CCC V1.3 FEB 87 (D) Change the logic for running from either CCC LOGON or COMMAND FILE. Now allows options on CCC command (MAIL [COMMAND] ) line CCC V1.2A FEB 87 Clean up of source file. Change TYPE to WRITE CCC V1.2 FEB 87 Put the directory in encrypted format CCC V1.1 FEB 87 Add encryption (IOFSET(J)=-IOFSET(J)) to CCC messages CCC V1.0 DEC 86 - FEB 87 First version C**************************************************************************** CCC CCC This program implements an online mail system under TSX+. CCC 1 - Send mail to another user CCC 2 - Read their mail CCC 3 - Delete any letters CCC This program offers some security by only allowing users to read CCC mail in their own mailbox. (This can be bypassed by using the CCC NAME program) CCC Security is also provided by simple encryption (I=-I) of the mail CCC file (SY:MAIL.XXX), both directory and messages. CCC CCC The postoffice is a file (SY:MAIL.XXX) set up as follows CCC BLOCK 0 DIRECTORY CCC BLOCK 1 DIRECTORY CCC BLOCK 2 DIRECTORY CCC BLOCK 3 - 7 BOX 1 CCC BLOCK 8 - 12 BOX 2 CCC BLOCK 13 - 17 BOX 3 CCC BLOCK 18 - 22 BOX 4 CCC ........ CCC BLOCK 94 - 98 BOX 19 CCC CCC The directory is set up as: CCC USERNAME 12 BYTES ! 0 - 12 ASCII TSX USER NAME CCC OFFSET 1 WORD ! 14 *** NEVER ALTER THIS VALUE CCC NULL 1 WORD ! 16 RESERVED CCC CCC The mailfile should be created using POSTMN, which will also CCC ADD/LIST/DELETE USERNAMES. It will also create a proper sized CCC mailfile for the number of users requested CCC CCC Using this setup, there is enough space for 19 mailboxes, CCC although the directory has space for 96 entries. This setup CCC allows for easily extending the size of the mail file (MAIL.XXX). CCC Each user is allocated 5 blocks for their mail. CCC CCC Each message is limited to 1000 bytes, including many control char. CCC CCC USERNAMES MUST BE THE SAME FORMAT AS TSX LOGON NAMES CCC CCC A user whose USERNAME is not in the mail directory will be advised CCC of this when trying to read mail. However, writing mail will work, CCC provided the destination USERNAME exists in the directory. If not, CCC the user is informed of such. CCC CCC Only one user at a time may write (update/delete/add) to a specific CCC mailbox at one time. This provides some access control on each CCC mailbox. CCC CCC The occasions for running MAIL are: CCC 1 - On logging on to the system, MAIL checks for any CCC mail in the users mailbox. If there is mail, it CCC asks if the user wants to read the mail, else CCC the program exits. CCC 2 - If the user wants to send another user a message. The CCC program tests for mail. If there is any, it asks if CCC read or send. If there is no mail, it asks only if CCC send. CCC 3 - If the user wants to read and/or delete their messages, CCC the program tests for mail. If there is any, it asks CCC if read. If read, it lists and/or deletes the messages CCC 4 - If a user wants to see how many messages there are in CCC their mailbox. CCC CCC MAIL MUST BE RUN FROM A COMMAND FILE. Suppose the mail program is CCC SY:MAILX.SAV. For LOGON, the USER'S STARTUP-FILE should contain CCC CCC ^(@SY:MAIL.COM L CCC CCC The command file (SY:MAIL.COM) should be CCC CCC R MAILX CCC ^1 CCC CCC To envoke MAIL, the user simply types "MAIL [OPTIONAL COMMAND]". CCC If no command is entered, MAIL executes normally, first checking CCC for mail and then asking if read or send. CCC If an "L" is entered, MAIL assumes that this is a LOGON, allowing CCC only reading of mail. CCC If an "R" is entered, MAIL assumes that there is mail to be read, CCC and starts to print messages. CCC If an "S" is entered, MAIL assumes that the user wants to send CCC mail to another user. This allows writing messages to multiple CCC users (by putting the message in a file). CCC If an 'M' is entered, MAIL will tell the user only how many messages CCC there are. CCC If an 'A' is entered, MAIL will allow a privileged user to send CCC a message to all users. CCC CCC The current options are: CCC MAIL Run MAIL in standard mode CCC MAIL R Read mail (assumes there is mail) CCC MAIL S Send mail to a user CCC MAIL L Run MAIL in LOGON mode CCC MAIL M Run MAIL to see how many messages CCC MAIL A Run MAIL to send a message to all users CCC C**************************************************************************** CCC C INTEGER*2 ILIN,IERR,ISTS,IRET,ICTIM,ICHAR,IOFSET(1280) INTEGER*2 IMBLK, IMNO, INEXT, IMEND, IPUT, ICHAN, IPOS LOGICAL*1 A(2560), WUNAME(12), RUNAME(12), WTMAIL(81), INPUT LOGICAL*1 MBUF(1000) LOGICAL UNAME, LOGON, MAIL, DELETE, ALL C EQUIVALENCE (IOFSET, A(1)) C COMMON /MAIL1/ILIN, IERR, ISTS, IRET, ICTIM, ICHAR, + UNAME, IMBLK, LOGON, IMNO,INEXT,IMEND, MAIL, IPUT, + ICHAN, DELETE, IPOS, ALL COMMON /MAIL2/A, WUNAME, RUNAME, WTMAIL, INPUT, MBUF CCC C**************************************************************************** CCC DATA MBUF/1000*"0/ DATA MAIL/.FALSE./ ! Assume no mail DATA LOGON/.FALSE./ ! Assume not just loggon on DATA DELETE/.FALSE./ ! Assume no deletes DATA ALL/.FALSE./ ! Assume no write to ALL users DATA ICHAN/-1/ CCC C**************************************************************************** C INTEGER*2 FNAM(4) ! MAILFILE NAME C C**************************************************************************** C CCC Check if mail is started from LOGON or USER (MAIL) C CALL GTLIN(WTMAIL) ! LOGON ? (=L) IF(WTMAIL(1).NE.'L') GO TO 60 ! NOT RUN DURING LOGON LOGON =.TRUE. ! THIS IS RUN FROM LOGON CALL SCCA(ICFLG) ! INHIBIT ^C ABORTS FOR NOW C CCC Get the mailfile name and check if the postoffice is open. C 60 CALL FILE(FNAM) ! FIND THE MAILFILE NAME CALL OPENMF(.FALSE.,0,FNAM) ! OPEN IT FOR R/W C CCC Get this LINE NUMBER, USERNAME, and LINE TYPE (P/V/D) C ILIN=ITSLIN() ! What is this LINE NUMBER CALL GTUNAM(RUNAME) ! and USER NAME CALL ILNSTS(ILIN,ISTS,IERR) ! LINE TYPE ( P V D ) ISTS=(ISTS.AND."7) ! MASK OUT IF(LOGON.AND.(ISTS.NE.0)) ! NOTHING IF LOGON ON + GO TO 998 ! VIRTUAL LINE C 101 IF(.NOT.LOGON) WRITE(7,800) ! INTRO MESSAGE (IF NOT LOGON) C CCC We now know if the user has just logged on, and if there is mail. CCC Now perform the appropriate action. C 400 IF(WTMAIL(1).EQ.'S') GO TO 111 ! Direct WRITE 405 IF(WTMAIL(1).EQ.'A') GO TO 500 ! WRITE to ALL 410 CALL TEST ! Check if MAIL and return here 420 IF(WTMAIL(1).EQ.'M') GO TO 998 ! How many messages only 430 IF((MAIL).AND.(WTMAIL(1) ! Direct READ (MAIL) + .EQ.'R')) GO TO 701 ! 440 IF((.NOT.MAIL).AND. ! Direct READ (NO MAIL) + (WTMAIL(1).EQ.'R')) GO TO 998 ! 450 IF((.NOT.MAIL).AND.(LOGON)) ! NO MAIL AND LOGON + GO TO 998 ! 460 IF(MAIL) GO TO 700 ! MAIL (READ?) 470 IF((.NOT.LOGON).AND. ! NO MAIL AND NOT LOGON + (.NOT.MAIL)) GO TO 110 ! C CCC See if the user wants to read his/her mail (only if has MAIL) C 700 WRITE(7,801) ! READ MAIL ? CALL GETIN IF (INPUT.NE.'Y') GO TO 110 701 CALL RMAIL ! Now open the letters C CCC See if the user wants to send any mail (only if not LOGON) C 110 IF(LOGON) GO TO 998 ! IF LOGON, NO WRITES WRITE(7,802) ! SEND MAIL ? CALL GETIN IF (INPUT.NE.'Y') GO TO 120 111 CALL WMAIL ! Send something C CV1.9A CCC We want to send mail to ALL users C 500 ALL=.TRUE. ! Set the ALL flag to .TRUE. CALL ILNSTS(ILIN,ISTS,IERR) ! Is user privileged ? ISTS=(ISTS.AND."200) ! Mask out IF (ISTS.EQ."200) CALL WMAIL ! Only a privileged user can write WRITE(7,806) ! Send a message to anyone else GO TO 998 C 120 WRITE(7,804) ! NOTHING MESSAGE C 998 WRITE(7,805) ! EXIT C CALL EXIT C 800 FORMAT('0',' MAIL V1.14 LOYOLA EMC LAB',/) 801 FORMAT(' Do you want to read your mail? (Y or N) [N] ',$) 802 FORMAT(' Do you want to send mail? (Y or N) [N] ',$) 804 FORMAT('0',' Quiet day at the post office') 805 FORMAT(' ') 806 FORMAT(' ',' Sorry - You''re not allowed to write to all users') C END CCC C*************************************************************************** CCC SUBROUTINE GETIN C INTEGER*2 ILIN,IERR,ISTS,IRET,ICTIM,ICHAR,IOFSET(1280) INTEGER*2 IMBLK, IMNO, INEXT, IMEND, IPUT, ICHAN, IPOS LOGICAL*1 A(2560), WUNAME(12), RUNAME(12), WTMAIL(81), INPUT LOGICAL*1 MBUF(1000) LOGICAL UNAME, LOGON, MAIL, DELETE, ALL C EQUIVALENCE (IOFSET, A) C COMMON /MAIL1/ILIN, IERR, ISTS, IRET, ICTIM, ICHAR, + UNAME, IMBLK, LOGON, IMNO,INEXT,IMEND, MAIL, IPUT, + ICHAN, DELETE, IPOS, ALL COMMON /MAIL2/A, WUNAME, RUNAME, WTMAIL, INPUT, MBUF CCC C**************************************************************************** CCC C C Get a character from the tty C 800 READ(5,100,END=31,ERR=30) WTMAIL WTMAIL(81)="0 CALL TRIM(WTMAIL) ! REMOVE TRAILING BLANKS INPUT=WTMAIL(1) ! SAVE THE FIRST INPUT RETURN C 30 WRITE(7,101) GO TO 800 31 WRITE(7,102) GO TO 800 C 100 FORMAT(81A1) 101 FORMAT(' ',' INPUT ERROR - RETYPE LINE') 102 FORMAT(' ',' DO NOT USE ^Z - RETYPE LINE') C END CCC C*************************************************************************** CCC SUBROUTINE TEST CCC CCC This routine will check if there is mail or not, and inform the user of CCC how many messages there are in their mailbox CCC INTEGER*2 ILIN,IERR,ISTS,IRET,ICTIM,ICHAR,IOFSET(1280) INTEGER*2 IMBLK, IMNO, INEXT, IMEND, IPUT, ICHAN, IPOS LOGICAL*1 A(2560), WUNAME(12), RUNAME(12), WTMAIL(81), INPUT LOGICAL*1 MBUF(1000) LOGICAL UNAME, LOGON, MAIL, DELETE, ALL C EQUIVALENCE (IOFSET, A) C COMMON /MAIL1/ILIN, IERR, ISTS, IRET, ICTIM, ICHAR, + UNAME, IMBLK, LOGON, IMNO,INEXT,IMEND, MAIL, IPUT, + ICHAN, DELETE, IPOS, ALL COMMON /MAIL2/A, WUNAME, RUNAME, WTMAIL, INPUT, MBUF C C**************************************************************************** C DO 10 J=1,12 ! Put RUNAME into WUNAME WUNAME(J)=RUNAME(J) ! 10 CONTINUE DO 11 J=12,1,-1 ! CONVERT THE TRAILING SPACES IF(RUNAME(J).NE."40) GO TO 12 ! FROM 'RUNAME' TO 11 WUNAME(J)= "0 ! TRAILING NULLS 12 CONTINUE CALL CHKDIR ! CHECK THE MAIL DIRECTORY TO C ! VERIFY THIS USER EXISTS C C Read the first block of the mail file. If there is amy mail, IOFSET(1) C will be 1, otherwise it will be 0. C IMNO=1 ! MESSAGE NUMBER INEXT=1 ! WHERE NEXT MESSAGE IS CALL RDBLK(1) ! READ THE FIRST BLOCK CB2 IF (IOFSET(1).NE.IMNO) GO TO 999 ! ANY MAIL IOFSET=1 IF ((IOFSET(1).AND."177).NE.IMNO) GO TO 999 ! ANY MAIL IOFSET=1 MAIL=.TRUE. ! SET MAIL TO TRUE C C There is mail to be read. Now find out how many messages there are. C INEXT=1 ! Start with 1 message CALL RDBLK(5) ! Read the entire file DO 40 J=1,1280 ! Assume 1280 messages IF (IOFSET(INEXT).EQ.0) GO TO 997 ! End of messages IMNO=J ! Bump the message counter CALL FNDNXT ! Else find the next message 40 CONTINUE C 997 WRITE(7,803) IMNO ! MAIL and how many messages RETURN ! GO BACK FOR MORE 999 WRITE(7,802) ! NO MAIL RETURN C 802 FORMAT('0',' You have no mail ',/) 803 FORMAT('0',' You have ',I3,' messages in your mailbox',/) C END CCC C*************************************************************************** CCC SUBROUTINE RMAIL CCC CCC This routine allows a user to read their mail file CCC INTEGER*2 ILIN,IERR,ISTS,IRET,ICTIM,ICHAR,IOFSET(1280) INTEGER*2 IMBLK, IMNO, INEXT, IMEND, IPUT, ICHAN, IPOS LOGICAL*1 A(2560), WUNAME(12), RUNAME(12), WTMAIL(81), INPUT LOGICAL*1 MBUF(1000) LOGICAL UNAME, LOGON, MAIL, DELETE, ALL C EQUIVALENCE (IOFSET, A) C COMMON /MAIL1/ILIN, IERR, ISTS, IRET, ICTIM, ICHAR, + UNAME, IMBLK, LOGON, IMNO,INEXT,IMEND, MAIL, IPUT, + ICHAN, DELETE, IPOS, ALL COMMON /MAIL2/A, WUNAME, RUNAME, WTMAIL, INPUT, MBUF C C**************************************************************************** C LOGICAL*1 CIMIN(2), CISEC(2), MMM(36), PBUF(82), TOP(71) INTEGER*2 PCNTR LOGICAL ACSFLG C DATA ACSFLG/.FALSE./ ! ACCESS FLAG DATA MMM/'J','A','N','F','E','B','M','A','R','A','P','R', + 'M','A','Y','J','U','N','J','U','L','A','U','G', + 'S','E','P','O','C','T','N','O','V','D','E','C'/ DATA PBUF/82*"0/ DATA TOP/71*'*'/ CCC C**************************************************************************** CCC C Read the mail file starting at IMBLK. Remember that the first 10 decimal C words of each message are header, not mail. Since we want WORDS, not BYTES, C use OFFSET for the first 10 decimal words. The block pointer (IMBLK) is C returned by CHKDIR C IMNO=1 ! MESSAGE NUMBER INEXT=1 ! WHERE NEXT MESSAGE IS CALL RDBLK(5) ! READ THE MAIL C C The entire mail file (5 blocks) is read into the user buffer [A(2560)]. C Mail starts on a word boundry, so the end of each mail message has 1 or 2 C null (000) bytes. The next mail message starts on the next word. The header C for each message is 10 words. C 30 IF (INEXT.GT.1280) GO TO 998 ! Only room for 1280 words C CB2 IF (IOFSET(INEXT).NE.IMNO) GO TO 998 ! End of messages IF ((IOFSET(INEXT).AND."177).NE.IMNO) GO TO 998 ! End of messages C IMDATE=IOFSET(INEXT+1) ! GET THE DATE WORD IYY=(IMDATE.AND."37)+72 ! CONVERT THE RT11 DATE IDD=(IMDATE.AND."1740)/32 ! WORD TO YY/MM/DD IMM=(IMDATE.AND."36000)/1024 ! IN NUMBERS C CALL CVTTIM(IOFSET(INEXT+2),IHRS,IMIN,ISEC,ITCK) ! TIME IN RT FORMAT DO 13 J=9,20 WUNAME(J-8)=A(J+((INEXT-1)*2)) IF (WUNAME(J-8).EQ."0) WUNAME(J-8)="40 13 CONTINUE CV1.9B ENCODE(2,900,CIMIN)IMIN ENCODE(2,900,CISEC)ISEC IF(CIMIN(1).EQ.' ')CIMIN(1)='0' IF(CISEC(1).EQ.' ')CISEC(1)='0' C WRITE(7,705) TOP WRITE(7,800) (IOFSET(INEXT).AND."177),IDD, + (MMM(IM),IM=IMM*3-2,IMM*3,1),IYY, + IHRS,CIMIN,CISEC,(WUNAME(J),J=1,12) DO 14 J=(((INEXT-1)*2)+21),2560 ! List the message ITMP=J ! until there is a NULL IF(A(J).EQ."0) GO TO 15 ! (EOF) WRITE(7,701) A(J) 14 CONTINUE 15 WRITE(7,700) CCC CCC End of current message CCC 32 WRITE(7,702) ! DELETE, NEXT, or PRINT CALL GETIN ! Get something IF (INPUT.EQ.'P') GO TO 40 ! P for print IF (INPUT.NE.'D') GO TO 31 ! Is it a 'D' ? IF(.NOT.ACSFLG) CALL ACCESS ! GET EXCLUSIVE ACCESS ACSFLG=.TRUE. IOFSET(INEXT)=(IOFSET(INEXT).OR."200) ! MARK FOR DELETE DELETE=.TRUE. ! SHOW FILES TO DELETE 31 INEXT=((ITMP+1)/2)+1 ! GET POINTER FOR NEXT IMEND=ITMP IMNO=IMNO+1 ! NEXT MESSAGE NUMBER GO TO 30 C 998 IF (.NOT.DELETE) GO TO 996 ! IF MESSAGES TO CALL DELMSG ! DELETE C 996 WRITE(7,801) ! NO MORE MAIL CALL EXIT C CV1.13 40 WRITE(6,705) TOP WRITE(6,800) (IOFSET(INEXT).AND."177),IDD, + (MMM(IM),IM=IMM*3-2,IMM*3,1),IYY, + IHRS,CIMIN,CISEC,(WUNAME(J),J=1,12) WRITE(6,704) DO 44 L=1,82 44 PBUF(L)="0 ! INIT the buffer PCNTR=1 DO 41 J=(((INEXT-1)*2)+21),2560 ! PRINT the message ITMP=J ! until there is a NULL PBUF(PCNTR)=A(J) ! Save message in PBUF PCNTR=PCNTR+1 ! Increment counter IF(A(J).EQ."0) GO TO 42 ! EOF IF(A(J).NE."12) GO TO 41 ! from WRITE(6,703) PBUF ! Print a buffer DO 43 L=1,82 43 PBUF(L)="0 ! INIT the buffer PCNTR=1 ! Reset counter 41 CONTINUE 42 WRITE(6,703) PBUF ! Print last line WRITE(6,700) ! and flush the buffer GO TO 31 C 800 FORMAT(' ',/,' MESSAGE#',I3,' POSTED ',I2,'-',3A1,'-',I2,' ', + I2,':',2A1,':',2A1,' FROM USER: ',12A1,/) 801 FORMAT(' ',/,' No more mail',/) 705 FORMAT(' ',71A1) 704 FORMAT(' ') 703 FORMAT('+',82A1) 702 FORMAT(' ',/,' NEXT MESSAGE , ', + ' DELETE MESSAGE , ', + ' PRINT MESSAGE

',$) 701 FORMAT(' ',1A1,$) 700 FORMAT(' ',/) 900 FORMAT(I2) C END CCC C************************************************************************** CCC SUBROUTINE WMAIL C INTEGER*2 ILIN,IERR,ISTS,IRET,ICTIM,ICHAR,IOFSET(1280) INTEGER*2 IMBLK, IMNO, INEXT, IMEND, IPUT, ICHAN, IPOS LOGICAL*1 A(2560), WUNAME(12), RUNAME(12), WTMAIL(81), INPUT LOGICAL*1 MBUF(1000) LOGICAL UNAME, LOGON, MAIL, DELETE, ALL C EQUIVALENCE (IOFSET, A) C COMMON /MAIL1/ILIN, IERR, ISTS, IRET, ICTIM, ICHAR, + UNAME, IMBLK, LOGON, IMNO,INEXT,IMEND, MAIL, IPUT, + ICHAN, DELETE, IPOS, ALL COMMON /MAIL2/A, WUNAME, RUNAME, WTMAIL, INPUT, MBUF CCC C**************************************************************************** LOGICAL*1 IYNAME(12), ALERT(20) INTEGER*2 ILINE C DATA ALERT/"15,"12,"7,'Y','o','u',' ','h','a','v','e',' ', + 'm','a','i','l',"7,"15,"12,"0/ C**************************************************************************** CCC C C This routine allows a user to write mail to another user C CCC CCC Get the USERNAMEs of the sender and receiver, and make sure the CCC receiver has a mailbox to put the mail into. Will flag the NULL user. CCC IF (ALL) GO TO 21 ! If writing to ALL, skip this 19 WRITE (7,10) DO 18 J=1,12 ! BUG #1 18 WUNAME(J)="0 ! Initialize the NAME CALL GTLIN(WUNAME) ! GET THE USERNAME IF(WUNAME(1).NE."0) GO TO 20 ! NULL USER? WRITE(7,11) ! REPORT ERROR GO TO 19 ! AND TRY AGAIN CCC CCC Check the directory to verify the destination user, and get the message CCC that is to be written into the mail file. CCC CCC We must have exclusive access to the mail file. That is, only one CCC user may write (update) the mail file at one time. Once we have CCC access, we can do the actual write. CCC CCC Try to get ACCESS to the mail file. When the request for access has been CCC granted. we can update the mail file. ACCESS will read all 5 blocks for CCC a fresh copy. Then clear the access byte ( A(2)=0 ). Put the new CCC message into the mail file, and finally write the new, updated mail CCC file to disk. CCC C 20 CALL CHKDIR ! Check directory for valid user 21 CALL GETMSG ! Get the new message 22 WRITE(7,800) ! MAIL BEING PROCESSED message C 23 IF (ALL) WRITE(7,802) ! WRITE TO ALL message C DO 29 J=1,(256*2*3),16 ! 3 directory blocks (96 TIMES) IF (.NOT.ALL) GO TO 30 ! Skip this if not write to ALL IMBLK=0 ! Start at block 0 CALL RDBLK(3) ! Read 3 blocks IF(A(J).EQ."0) GO TO 29 ! No entry here - go to next one IMBLK=IOFSET((J-1)/2+7) ! Write at this address C 30 CALL ACCESS ! WAIT FOR ACCESS C C A(2)=0 ! SHOW THAT ACCESS IS CLEAR CALL PUTMSG ! PUT THE NEW MESSAGE INTO THE FILE CALL WTBLK(5) ! WRITE THE UPDATED FILE CB3 CALL SCCA ! OK TO ^C NOW IF(.NOT.ALL) GO TO 31 ! Exit the DO LOOP 29 CONTINUE C 31 CALL ICLOSE(ICHAN) CALL IFREEC(ICHAN) ! FREE THE CHANNEL WRITE(7,801) ! MAIL SENT message C V1.14 CALL SCCA ! OK TO ^C NOW C C V1.11 C Ask if you wish to inform the destination user of mail C IF (ALL) GO TO 50 ! Skip this if WRITE TO ALL CALL IPOKE("44,"137777.AND.IPEEK("44)) ! Disable LC input WRITE(7,803) ! Ask if INFORM CALL GETIN IF (INPUT.NE.'Y') GO TO 50 DO 40 J=1,100 ! Do for all possible lines ILINE=J ! Save the line number CALL GTJBNM(ILINE,IYNAME,IERR)! Get the line name C IF (IERR.EQ.2) GO TO 49 ! End of lines - user not logged on IF (IERR.EQ.0) GO TO 40 ! Line not logged on - try again DO 41 K=12,1,-1 ! Clear trailing blanks IF(IYNAME(K).NE."40) GO TO 42 ! First non-blank - quit IF(IYNAME(K).EQ."40) IYNAME(K)="0 41 CONTINUE 42 DO 43 K=1,12 ! Is it a match ? IF(WUNAME(K).NE.IYNAME(K)) GO TO 40 ! Not this line - try again 43 CONTINUE CALL TRMMSG(ILINE,ALERT) ! Send the destination user a message GO TO 50 40 CONTINUE 49 WRITE(7,804) C 50 CALL EXIT ! BYE BYE C C 10 FORMAT(' ',' Enter the USERNAME you wish to send mail to : ',$) 11 FORMAT(' ',' Cannot send mail to the NULL USER. Try again.') 800 FORMAT(' ',/,' Please wait - your mail is being processed',$) 801 FORMAT(' ',/,' Your mail has been sent.',/) 802 FORMAT(' ',/,' Writing to all users - please wait',$) 803 FORMAT(' ',/,' Do you want to alert the user of your message (Y ', + 'or N) [N] ',$) 804 FORMAT(' ',/,' Sorry, the user is not logged on ',/) C END CCC C************************************************************************** CCC SUBROUTINE CHKDIR C INTEGER*2 ILIN,IERR,ISTS,IRET,ICTIM,ICHAR,IOFSET(1280) INTEGER*2 IMBLK, IMNO, INEXT, IMEND, IPUT, ICHAN, IPOS LOGICAL*1 A(2560), WUNAME(12), RUNAME(12), WTMAIL(81), INPUT LOGICAL*1 MBUF(1000) LOGICAL UNAME, LOGON, MAIL, DELETE, ALL C EQUIVALENCE (IOFSET, A) C COMMON /MAIL1/ILIN, IERR, ISTS, IRET, ICTIM, ICHAR, + UNAME, IMBLK, LOGON, IMNO,INEXT,IMEND, MAIL, IPUT, + ICHAN, DELETE, IPOS, ALL COMMON /MAIL2/A, WUNAME, RUNAME, WTMAIL, INPUT, MBUF CCC C**************************************************************************** CCC C C This routine verifies that the requested username exists in the mail C directory, and finds the starting block for the requested USERNAME C in the file MAIL.XXX C UNAME=.FALSE. C DO 12 IBLOCK=1,3 ! SCAN THE DIRECTORY IMBLK=IBLOCK-1 ! BLOCKS 1,2,3 CALL RDBLK(1) ! READ a directory C DO 10 J=1,512,16 DO 11 K=1,12 ! Scan each USERNAME IF (WUNAME(K).NE.A(J-1+K)) GO TO 10 ! A match 11 CONTINUE UNAME=.TRUE. ! USERNAME FOUND IMBLK=IOFSET(((J-1)/2)+7) ! GET THE BLOCK # GO TO 13 10 CONTINUE 12 CONTINUE ! NEXT DIR. BLOCK IF (UNAME) GO TO 13 ! NAME FOUND - RETURN WRITE(7,800) ! NAME NOT FOUND - CALL EXIT ! EXIT C 13 CONTINUE RETURN C 800 FORMAT('0',' USERNAME NOT FOUND - PLEASE SEE THE ', + 'POSTMASTER TO ALLOCATE THIS USER A MAILBOX',/) C END CCC C**************************************************************************** CCC SUBROUTINE DELMSG CCC CCC Delete a message from the mail file, and then squeeze the file CCC INTEGER*2 ILIN,IERR,ISTS,IRET,ICTIM,ICHAR,IOFSET(1280) INTEGER*2 IMBLK, IMNO, INEXT, IMEND, IPUT, ICHAN, IPOS LOGICAL*1 A(2560), WUNAME(12), RUNAME(12), WTMAIL(81), INPUT LOGICAL*1 MBUF(1000) LOGICAL UNAME, LOGON, MAIL, DELETE, ALL C EQUIVALENCE (IOFSET, A(1)) C COMMON /MAIL1/ILIN, IERR, ISTS, IRET, ICTIM, ICHAR, + UNAME, IMBLK, LOGON, IMNO,INEXT,IMEND, MAIL, IPUT, + ICHAN, DELETE, IPOS, ALL COMMON /MAIL2/A, WUNAME, RUNAME, WTMAIL, INPUT, MBUF CCC C**************************************************************************** CCC C IMNO=0 ! MESSAGE NUMBER INEXT=1 ! MESSAGE POINTER IOFSET(1280)="0 ! LAST NULL A(2)="0 ! CLEAR ACCESS C DO 10 J=1,1280 ! ASSUME 1280 MESSAGES 11 IF(A(INEXT*2-1).EQ.0) GO TO 30 ! =0 END OF FILE IF(A(INEXT*2-1).GT.0) GO TO 20 ! >0 DO NOT DELETE ITMP=INEXT ! <0 DELETE THIS MESSAGE CALL FNDNXT ! GET NEXT MESSAGE DO 12 K=ITMP,1280 ! CURRENT POSITION TO EOF IOFSET(K)=IOFSET(INEXT) ! SQUEEZE FILE INEXT=INEXT+1 IF(INEXT.LT.1280) GO TO 12 INEXT=1280 12 CONTINUE INEXT=ITMP ! RESTORE POINTER GO TO 11 ! CHECK NEXT MESSAGE FOR DELETE 20 CALL FNDNXT ! GET NEXT MESSAGE 10 CONTINUE CCC CCC All the 'DELETES' have been done on the mail file, and it has been CCC SQUEEZED. Now the message numbers must be updated, as the undeleted CCC messages still have their old message numbers. CCC 30 INEXT=1 ! START AT FIRST MESSAGE DO 40 IMNO=1,1280 ! ASSUME 1280 MESSAGES IF(IOFSET(INEXT).EQ.0) GO TO 50 ! 0 -> END IOFSET(INEXT)=IMNO ! NEW MESSAGE NUMBER CALL FNDNXT ! GET NEXT MESSAGE 40 CONTINUE CCC CCC We can now write the updated message file back to disk CCC 50 CALL WTBLK(5) ! OK TO WRITE UPDATED FILE C RETURN END CCC C**************************************************************************** CCC SUBROUTINE PUTMSG CCC CCC Put a message into the mail file CCC INTEGER*2 ILIN,IERR,ISTS,IRET,ICTIM,ICHAR,IOFSET(1280) INTEGER*2 IMBLK, IMNO, INEXT, IMEND, IPUT, ICHAN, IPOS LOGICAL*1 A(2560), WUNAME(12), RUNAME(12), WTMAIL(81), INPUT LOGICAL*1 MBUF(1000) LOGICAL UNAME, LOGON, MAIL, DELETE, ALL C EQUIVALENCE (IOFSET, A(1)) C COMMON /MAIL1/ILIN, IERR, ISTS, IRET, ICTIM, ICHAR, + UNAME, IMBLK, LOGON, IMNO,INEXT,IMEND, MAIL, IPUT, + ICHAN, DELETE, IPOS, ALL COMMON /MAIL2/A, WUNAME, RUNAME, WTMAIL, INPUT, MBUF CCC C**************************************************************************** CCC C C Search through the mail file, counting each message. When the last message C is found, start putting in the new message. C IMNO=0 INEXT=1 C C Start searching at position 1. If the first word of each header is not C equal to the message number (IMNO, which is incremented for each pass), C we now know where to put the new message. (starting at INEXT) C DO 10 J=1,1280 IMNO=IMNO+1 IF ( IOFSET(INEXT).NE.IMNO) GO TO 11 ! Current end of file found CALL FNDNXT ! End not here Try again 10 CONTINUE C C The position to write the message is found. First write the 10 word header C ( MESS#/DATE/TIMEH/TIMEL/6*USERNAME), and then the message (bytes). C 11 IOFSET(INEXT)=IMNO ! NEW MESSAGE CALL IDATE(IMM,IDD,IYY) ! GET TODAY'S DATE IOFSET(INEXT+1)=(IMM*1024)+(IDD*32)+(IYY-72) ! DATE (RT format) CALL GTIM(IOFSET(INEXT+2)) ! TIMEH/TIMEL DO 13 J=9,20 ! A(J+((INEXT-1)*2))=RUNAME(J-8) ! 6*USERNAME 13 CONTINUE ! C ISTART=(21+((INEXT-1)*2)) ! WHERE TO START SAVING BUFF. C DO 30 J=1,IPUT ! UPDATE THE MAIL FILE A(ISTART)=MBUF(J) ISTART=ISTART+1 IF (ISTART.GE.2559) GO TO 40 IF(MBUF(J).EQ."0) GO TO 50 30 CONTINUE C 50 DO 51 J=ISTART,2560 ! ZERO OUT THE REST OF THE A(J)="0 ! MAIL FILE 51 CONTINUE C RETURN C 40 A(2560)="0 WRITE(7,800) RETURN C 800 FORMAT(' ',' USER MAILBOX FULL') C END CCC C**************************************************************************** CCC SUBROUTINE FNDNXT CCC CCC Find the next mail message position CCC INTEGER*2 ILIN,IERR,ISTS,IRET,ICTIM,ICHAR,IOFSET(1280) INTEGER*2 IMBLK, IMNO, INEXT, IMEND, IPUT, ICHAN, IPOS LOGICAL*1 A(2560), WUNAME(12), RUNAME(12), WTMAIL(81), INPUT LOGICAL*1 MBUF(1000) LOGICAL UNAME, LOGON, MAIL, DELETE, ALL C EQUIVALENCE (IOFSET, A(1)) C COMMON /MAIL1/ILIN, IERR, ISTS, IRET, ICTIM, ICHAR, + UNAME, IMBLK, LOGON, IMNO,INEXT,IMEND, MAIL, IPUT, + ICHAN, DELETE, IPOS, ALL COMMON /MAIL2/A, WUNAME, RUNAME, WTMAIL, INPUT, MBUF CCC C**************************************************************************** CCC C C Search the entire mail file, starting at offset 21 from pointer INEXT. C When the mail file contains a null ("0), we are at the end of the current C message. INEXT now points to the where the next message starts. C DO 10 J=(((INEXT-1)*2)+21),2560 ITMP=J IF (A(J).EQ."0) GO TO 11 ! End of current message ? 10 CONTINUE C 11 INEXT=((ITMP+1)/2)+1 ! Pointer for next message RETURN END CCC C**************************************************************************** CCC SUBROUTINE GETMSG CCC CCC Get and store the mew message CCC INTEGER*2 ILIN,IERR,ISTS,IRET,ICTIM,ICHAR,IOFSET(1280) INTEGER*2 IMBLK, IMNO, INEXT, IMEND, IPUT, ICHAN, IPOS LOGICAL*1 A(2560), WUNAME(12), RUNAME(12), WTMAIL(81), INPUT LOGICAL*1 MBUF(1000) LOGICAL UNAME, LOGON, MAIL, DELETE, ALL C EQUIVALENCE (IOFSET, A(1)) C COMMON /MAIL1/ILIN, IERR, ISTS, IRET, ICTIM, ICHAR, + UNAME, IMBLK, LOGON, IMNO,INEXT,IMEND, MAIL, IPUT, + ICHAN, DELETE, IPOS, ALL COMMON /MAIL2/A, WUNAME, RUNAME, WTMAIL, INPUT, MBUF CCC C**************************************************************************** CCC WRITE(7,800) ! INPUT MESSAGE CALL IPOKE("44,"40000.OR.IPEEK("44)) ! Lower Case enable IPUT=1 ! INPUT COUNTER C 15 WRITE(7,801) ! PROMPT CALL GETIN ! GET A LINE OF INPUT DO 16 J=1,80 IF (IPUT.GT.999) GO TO 40 ! INPUT BUFFER OVERFLOW IF (WTMAIL(J).EQ."4) GO TO 20 ! END OF MESSAGE IF (WTMAIL(J).EQ."0) GO TO 17 ! END OF LINE MBUF(IPUT)=WTMAIL(J) IPUT=IPUT+1 16 CONTINUE 17 MBUF(IPUT)="15 ! ADD A MBUF(IPUT+1)="12 IPUT=IPUT+2 ! BUMP THE POINTER IF (IPUT.GT.999) GO TO 40 ! INPUT BUFFER OVERFLOW GO TO 15 C 20 IF ((MOD(IPUT,2)).EQ.1) GO TO 21 ! WHERE IS LAST INPUT? MBUF(IPUT+2)="0 ! EVEN = 2 * "0 21 MBUF(IPUT+1)="0 ! ODD = 1 * "0 RETURN CC 40 WRITE(7,802) ! OVERFLOW MBUF(1000)="0 IPUT=1000 RETURN C 800 FORMAT(' ',' Enter lines of text. ', + 'Terminate message with ^D.') 801 FORMAT(' *',$) 802 FORMAT(' ',' WARNING - Input buffer overflow') C END CCC C***************************************************************************** CCC SUBROUTINE RDBLK(NBLK) CCC CCC Read the specified number of blocks of user mail file into memory CCC INTEGER*2 ILIN,IERR,ISTS,IRET,ICTIM,ICHAR,IOFSET(1280) INTEGER*2 IMBLK, IMNO, INEXT, IMEND, IPUT, ICHAN, IPOS LOGICAL*1 A(2560), WUNAME(12), RUNAME(12), WTMAIL(81), INPUT LOGICAL*1 MBUF(1000) LOGICAL UNAME, LOGON, MAIL, DELETE, ALL C EQUIVALENCE (IOFSET, A(1)) C COMMON /MAIL1/ILIN, IERR, ISTS, IRET, ICTIM, ICHAR, + UNAME, IMBLK, LOGON, IMNO,INEXT,IMEND, MAIL, IPUT, + ICHAN, DELETE, IPOS, ALL COMMON /MAIL2/A, WUNAME, RUNAME, WTMAIL, INPUT, MBUF CCC C**************************************************************************** CCC C ICODE=IREADW((256*NBLK),IOFSET,IMBLK,ICHAN) IF(ICODE.LT.0) GO TO 999 DO 10 J=1,256*NBLK ! IOFSET(J)=-(IOFSET(J)) ! UN-ENCRYPT 10 CONTINUE ! C RETURN C 999 WRITE(7,800) ICODE CALL EXIT C 800 FORMAT(' ',' ERROR READING MAIL FILE - ERRCODE=',I3,/) C END CCC C**************************************************************************** CCC SUBROUTINE WTBLK(NBLK) CCC CCC Write the specified number of blocks of the user mail file to disk CCC INTEGER*2 ILIN,IERR,ISTS,IRET,ICTIM,ICHAR,IOFSET(1280) INTEGER*2 IMBLK, IMNO, INEXT, IMEND, IPUT, ICHAN, IPOS LOGICAL*1 A(2560), WUNAME(12), RUNAME(12), WTMAIL(81), INPUT LOGICAL*1 MBUF(1000) LOGICAL UNAME, LOGON, MAIL, DELETE, ALL C EQUIVALENCE (IOFSET, A(1)) C COMMON /MAIL1/ILIN, IERR, ISTS, IRET, ICTIM, ICHAR, + UNAME, IMBLK, LOGON, IMNO,INEXT,IMEND, MAIL, IPUT, + ICHAN, DELETE, IPOS, ALL COMMON /MAIL2/A, WUNAME, RUNAME, WTMAIL, INPUT, MBUF CCC C**************************************************************************** CCC DO 10 J=1,256*NBLK ! IOFSET(J)=-(IOFSET(J)) ! ENCRYPT 10 CONTINUE ! C ICODE=IWRITW((256*NBLK),IOFSET,IMBLK,ICHAN) IF(ICODE.LT.0) GO TO 999 C RETURN C 999 WRITE(7,800) ICODE CALL EXIT C 800 FORMAT(' ',' ERROR WRITING MAIL FILE - ERRCODE=',I3,/) C END CCC C************************************************************************** CCC SUBROUTINE ACCESS C INTEGER*2 ILIN,IERR,ISTS,IRET,ICTIM,ICHAR,IOFSET(1280) INTEGER*2 IMBLK, IMNO, INEXT, IMEND, IPUT, ICHAN, IPOS LOGICAL*1 A(2560), WUNAME(12), RUNAME(12), WTMAIL(81), INPUT LOGICAL*1 MBUF(1000) LOGICAL UNAME, LOGON, MAIL, DELETE, ALL C BYTE B(2) EQUIVALENCE (ILIN, B) EQUIVALENCE (IOFSET, A) C COMMON /MAIL1/ILIN, IERR, ISTS, IRET, ICTIM, ICHAR, + UNAME, IMBLK, LOGON, IMNO,INEXT,IMEND, MAIL, IPUT, + ICHAN, DELETE, IPOS, ALL COMMON /MAIL2/A, WUNAME, RUNAME, WTMAIL, INPUT, MBUF CCC C**************************************************************************** CCC C C This routine requests exclusive access to write into the mail file C CCC CCC We must have exclusive access to the mail file. That is, only one CCC user may write (update) the mail file at one time. The following CCC procedure should resolve multiple requests to any one mail file. CCC CCC To do the actual write into the mail file (update it), the following CCC procedure must be done: CCC 1 - Read block 0 of the mail file, and check the high byte of the CCC word 0 ( A(2)). If the content of the byte is this user's line CCC number, we can procede with the actual update, as we have CCC access of this part of the mail file. [4] CCC 2 - If A(2) equal to 0 ( no access), we can go and request access CCC to the file. [] If A(2) is not 0, it must be another users CCC number. We must wait for them to release access, and then CCC try the procedure again. [1] CCC 3 - Since the access is clear (0), we can request access by setting CCC A(2) to our line number, writing block 0 of the mail file back CCC to disk, wait a second, and then reading block 0 to verifying CCC our request for access. [1] CCC 4 - The request for access has been granted. we can now make updates CCC on mail file. CCC 5 - Finally, read the entire mail file (5 blocks) (a fresh copy) CCC C 20 CALL RDBLK(1) ! READ BLOCK 0, TO FIRST CHECK ACCESS IF (A(2).EQ.B(1)) GO TO 30 ! IF OUR LINE #, OK TO UPDATE IF (A(2).EQ.0) GO TO 40 ! IF 0, OK TO REQUEST ACCESS WRITE(7,800) ! WAIT MESSAGE CALL ISLEEP(0,0,2,0) ! ACCESS IS DENIED. WAIT AND GO TO 20 ! TRY AGAIN C 40 CALL SCCA(IFLG) ! NO ^C ABORTS FROM HERE A(2)=B(1) ! OUR LINE # SHOWS ACCESS CALL WTBLK(1) ! WRITE FIRST BLOCK ON DISK CALL ISLEEP(0,0,2,0) ! WAIT GO TO 20 ! VERIFY ACCESS REQUEST C 30 CALL RDBLK(5) ! REREAD THE MAIL FILE FOR INSERTIONS C ! WHILE READING AND THEN DELETE RETURN ! WE NOW HAVE EXCLUSIVE ACCESS C 800 FORMAT(' ',/,' Please wait - another user has access to', + ' this mail box',$) C END CCC CCC C**************************************************************************** CCC SUBROUTINE OPENMF(NEW,IFSIZE,FNAM) CCC CCC Open the system mail file for R/W to the file CCC INTEGER*2 ILIN,IERR,ISTS,IRET,ICTIM,ICHAR,IOFSET(1280) INTEGER*2 IMBLK, IMNO, INEXT, IMEND, IPUT, ICHAN, IPOS LOGICAL*1 A(2560), WUNAME(12), RUNAME(12), WTMAIL(81), INPUT LOGICAL*1 MBUF(1000) LOGICAL UNAME, LOGON, MAIL, DELETE, ALL C EQUIVALENCE (IOFSET, A(1)) C COMMON /MAIL1/ILIN, IERR, ISTS, IRET, ICTIM, ICHAR, + UNAME, IMBLK, LOGON, IMNO,INEXT,IMEND, MAIL, IPUT, + ICHAN, DELETE, IPOS, ALL COMMON /MAIL2/A, WUNAME, RUNAME, WTMAIL, INPUT, MBUF CCC C**************************************************************************** C INTEGER*2 FNAM(4) ! SYSTEM MAIL FILE (RAD50) LOGICAL*1 OUTASC(12) ! ASCII FOR WRITES LOGICAL NEW C C**************************************************************************** C IF (ICHAN.GE.0) GO TO 10 ! CHANNEL ALLOCATED ? ICHAN=IGETC() ! OPEN A CHANNEL IF (ICHAN.LT.0) GO TO 80 ! NO CHANNEL ? IFCH=IFETCH(FNAM) ! LOAD HANDLER IF (IFCH.NE.0) GO TO 81 ! FETCH ERROR ? IF (.NOT.NEW) GO TO 2 I=IENTER(ICHAN,FNAM,IFSIZE) ! CREATE A NEW FILE RETURN ! 2 ILOOK=LOOKUP(ICHAN,FNAM) ! IF (ILOOK.LT.0) GO TO 82 ! LOOKUP ERROR ? C 10 RETURN ! ALL OK (so far) C 80 WRITE(7,801) ICHAN STOP 81 WRITE(7,811) IFCH STOP 82 WRITE(7,821) ILOOK STOP C 801 FORMAT('0',' NO CHANNEL AVAILABLE - ICHAN = ',I3,/) 811 FORMAT('0',' HANDLER FETCH ERROR - FETCH CODE = ',I3,/) 821 FORMAT('0',' LOOKUP ERROR = ',I3,' - MAILFILE SPECIFIED PROBABLY ', + 'NOT ON DISK',/,' CREATE THE MAILFILE FIRST AND CHECK THE FILE ', + 'SPECIFICATION IN ROUTINE "FILE.FOR"',/) C END