PROGRAM MAIL 00001 IMPLICIT INTEGER (A-Z) 00018 PARAMETER MLUN=1,MSG=3,TTY=2 00019 PARAMETER READC=1,SENDC=2,HOLDC=3,ACKC=4,REMOVC=5 00020 PARAMETER CLEARC=6,FILEC=7,RPEATC=8,DELETC=9,HELPC=10 00021 PARAMETER REPLYC=11,USERC=12 00022 PARAMETER MAXCMD=13 00023 PARAMETER RECLEN=32 00024 PARAMETER BREAKC='>' 00025 LOGICAL*1 OVER,MATCH,NOMAIL,EOF 00026 INTEGER RECORD(RECLEN) 00027 INTEGER USER(4),TESTER(4),SENDNM(4) 00028 LOGICAL*1 DAT(9),TIM(8),USRNAM(12),FNAME(30),SNDNAM(12) 00029 LOGICAL*1 SUBJCT(72),LINE(72) 00030 REAL COMMND 00031 LOGICAL*1 CMMNDB(4) 00032 EQUIVALENCE (COMMND,CMMNDB) 00033 REAL CMMNDS(MAXCMD) 00034 OVER() = MENTNO.GT.NENTRY 00038 DATA CMMNDS(MAXCMD)/' '/ 00041 DATA CMMNDS(READC)/'READ'/,CMMNDS(SENDC)/'SEND'/ 00042 DATA CMMNDS(HOLDC)/'HOLD'/,CMMNDS(ACKC)/'ACKN'/, 00043 1 CMMNDS(REMOVC)/'RECE'/,CMMNDS(FILEC)/'FILE'/ 00044 DATA CMMNDS(RPEATC)/'REPE'/,CMMNDS(DELETC)/'DELE'/ 00045 DATA CMMNDS(HELPC)/'HELP'/,CMMNDS(REPLYC)/'REPL'/ 00046 DATA CMMNDS(USERC)/'USER'/ 00047 DATA CMMNDS(CLEARC)/'?!@+'/ 00048 101 FORMAT(A4) 00052 102 FORMAT(Q,72A1) 00053 CALL ASNLUN(TTY,'TI',0) 00055 CALL SETDEF 00056 CALL GETUSR(USRNAM) 00057 ASSIGN 32758 TO I32759 00058 GO TO 32759 00058 32758 ASSIGN 32756 TO I32757 00059 GO TO 32757 00059 32756 MATCH = .FALSE. 00060 DO 32755 I=1,4 00061 TESTER(I) = USER(I) 00061 32755 CONTINUE 00061 ASSIGN 32753 TO I32754 00062 GO TO 32754 00062 32753 IF(.NOT.(MATCH)) GO TO 32751 00063 WRITE(TTY,1) 00063 GO TO 32752 00063 32751 WRITE(TTY,2) 00064 32752 CONTINUE 00065 1 FORMAT('0<<< YOU HAVE MAIL >>>') 00065 2 FORMAT('0NO MAIL') 00066 EOF = .FALSE. 00067 GO TO 32749 00068 32750 IF(EOF) GO TO 32748 00068 32749 WRITE(TTY,3) 00069 3 FORMAT('$Command: (Type HELP for help) ') 00070 READ(TTY,101,END=999) COMMND 00071 ASSIGN 32746 TO I32747 00072 GO TO 32747 00072 32746 IF((READC).NE.(COMIND)) GO TO 32744 00074 ASSIGN 32742 TO I32743 00075 GO TO 32743 00075 32742 GO TO 32745 00077 32744 IF((SENDC).NE.(COMIND)) GO TO 32741 00077 ASSIGN 32739 TO I32740 00077 GO TO 32740 00077 32739 GO TO 32745 00078 32741 IF((CLEARC).NE.(COMIND)) GO TO 32738 00078 ASSIGN 32736 TO I32737 00078 GO TO 32737 00078 32736 GO TO 32745 00079 32738 IF((USERC).NE.(COMIND)) GO TO 32735 00079 ASSIGN 32733 TO I32734 00079 GO TO 32734 00079 32733 GO TO 32745 00080 32735 WRITE(TTY,4) 00080 32745 CONTINUE 00082 4 FORMAT(' Input "SEND","READ","USERS" or ^Z') 00082 IF(.TRUE.) GO TO 32732 00083 999 EOF = .TRUE. 00084 32732 GO TO 32750 00086 32748 CLOSE(UNIT=MLUN) 00087 CALL EXIT 00088 32737 CONTINUE 00090 ASSIGN 32731 TO I32757 00091 GO TO 32757 00091 32731 CLOSE (UNIT=MLUN,DISPOSE='DELETE') 00092 GO TO I32737 00093 32754 CONTINUE 00094 GO TO 32729 00095 32730 IF(MATCH .OR. OVER()) GO TO 32728 00095 32729 ASSIGN 32726 TO I32727 00096 GO TO 32727 00096 32726 ASSIGN 32724 TO I32725 00097 GO TO 32725 00097 32724 GO TO 32730 00098 32728 IF (OVER()) MATCH = .FALSE. 00099 GO TO I32754 00100 32725 CONTINUE 00101 MATCH = .TRUE. 00102 DO 32723 I=1,4 00103 IF (TESTER(I).NE.RECORD(ENTPTR+I)) MATCH = .FALSE. 00104 32723 CONTINUE 00105 GO TO I32725 00106 32759 CONTINUE 00107 CALL IRAD50(12,USRNAM,USER) 00107 GO TO I32759 00107 32722 CONTINUE 00108 CALL IRAD50(12,SNDNAM,SENDNM) 00108 GO TO I32722 00108 32721 CONTINUE 00109 ASSIGN 32719 TO I32720 00110 GO TO 32720 00110 32719 CLOSE(UNIT=MSG) 00111 OPEN (UNIT=MSG,TYPE='NEW',NAME=FNAME,CARRIAGECONTROL='LIST') 00112 ASSIGN 32717 TO I32718 00113 GO TO 32718 00113 32717 GO TO I32721 00114 32716 CONTINUE 00115 LINENO = 0 00116 32715 IF(.NOT.(.TRUE.)) GO TO 32714 00117 READ(MSG,102,END=99,ERR=99) N,LINE 00118 LINENO = LINENO+1 00119 IF((1).NE.(LINENO)) GO TO 32712 00121 DO 32711 I=1,12 00122 SNDNAM(I) = LINE(I) 00122 32711 CONTINUE 00122 WRITE(TTY,23) (LINE(I),I=1,N) 00123 23 FORMAT(' From: ',72A1) 00124 GO TO 32713 00126 32712 IF((2).NE.(LINENO)) GO TO 32710 00126 DO 32709 I=1,N 00127 SUBJCT(I) = LINE(I) 00128 32709 CONTINUE 00129 WRITE(TTY,21) (LINE(I),I=1,60) 00130 21 FORMAT(' Subject: ',60A1/) 00131 GO TO 32713 00133 32710 WRITE(TTY,22) LINE 00133 32713 CONTINUE 00135 22 FORMAT(' ',72A1) 00135 GO TO 32715 00136 32714 CONTINUE 00137 99 CONTINUE 00137 GO TO I32716 00138 32727 CONTINUE 00139 MENTNO = MENTNO+1 00140 IF(OVER()) GO TO 32708 00141 IF(.NOT.(NENTNO.GE.NPEREC)) GO TO 32706 00142 READ(MLUN'KEYVAR,END=1999) (RECORD(I),I=1,NWRDRC) 00143 1999 CONTINUE 00148 NENTNO = 1 00149 ENTPTR = 0 00150 GO TO 32707 00151 32706 ENTPTR = ENTPTR+ENTSIZ 00153 NENTNO = NENTNO+1 00154 32707 CONTINUE 00156 32708 GO TO I32727 00157 32734 CONTINUE 00158 ASSIGN 32704 TO I32705 00159 GO TO 32705 00159 32704 WRITE(2,72) 00160 72 FORMAT(/) 00161 DO 32703 J=1,NENTRY 00162 ASSIGN 32702 TO I32727 00163 GO TO 32727 00163 32702 CALL R50ASC(12,RECORD(ENTPTR+1),SNDNAM) 00164 71 FORMAT($,'+'12A1,3X) 00165 73 FORMAT('+'12A1/) 00166 IF(.NOT.(MOD(J,5).EQ.0)) GO TO 32700 00167 WRITE(2,73) SNDNAM 00167 GO TO 32701 00167 32700 WRITE(2,71) SNDNAM 00168 32701 CONTINUE 00169 32703 CONTINUE 00169 WRITE(2,72) 00170 GO TO I32734 00171 32720 CONTINUE 00172 ENCODE(20,31,FNAME) MENTNO 00173 31 FORMAT('DB0:[1,200]',I5,'.MSG') 00174 FNAML = 0 00175 DO 32699 I=1,20 00176 IF(FNAME(I).EQ.' ') GO TO 32698 00177 FNAML = FNAML+1 00178 FNAME(FNAML) = FNAME(I) 00179 32698 CONTINUE 00181 32699 CONTINUE 00181 FNAME(FNAML+1) = 0 00182 GO TO I32720 00183 32697 CONTINUE 00184 ASSIGN 32696 TO I32720 00185 GO TO 32720 00185 32696 CLOSE(UNIT=MSG) 00186 OPEN(UNIT=MSG,TYPE='OLD',NAME=FNAME,SHARED,ERR=6999) 00187 IF(.TRUE.) GO TO 32695 00188 6999 WRITE(TTY,61) 00189 61 FORMAT(' ERROR IN READING MESSAGE FILE - ENTRY WILL BE DELETED') 00190 ASSIGN 32693 TO I32694 00191 GO TO 32694 00191 32693 CONTINUE 00192 32695 GO TO I32697 00193 32757 CONTINUE 00194 2998 CLOSE(UNIT=MLUN) 00195 NWRDRC = 16 00196 NPEREC = 1 00197 OPEN (UNIT=MLUN,NAME='DB0:[1,200]MAILFILE.DAT',TYPE='OLD', 00198 1 ACCESS='DIRECT',FORM='UNFORMATTED',RECORDSIZE=NWRDRC/2, 00199 2 ASSOCIATEVARIABLE=KEYVAR,ERR=2999,SHARED) 00200 READ(MLUN'1) (RECORD(I),I=1,NWRDRC) 00201 ENTSIZ = NWRDRC/NPEREC 00202 NENTRY = RECORD(1) 00203 MENTNO = 0 00204 NENTNO = NPEREC+1 00205 IF(.TRUE.) GO TO 32692 00206 2999 CONTINUE 00207 OPEN (UNIT=MLUN,NAME='DB0:[1,200]MAILFILE.DAT',TYPE='NEW', 00208 1 ACCESS='DIRECT',FORM='UNFORMATTED',RECORDSIZE=NWRDRC/2, 00209 2 ASSOCIATEVARIABLE=KEYVAR,MAXREC=40) 00210 DO 32691 I=1,NWRDRC 00211 RECORD(I) = 0 00211 32691 CONTINUE 00211 WRITE(MLUN'1) (RECORD(I),I=1,NWRDRC) 00212 GO TO 2998 00213 32692 GO TO I32757 00215 32705 CONTINUE 00216 CLOSE(UNIT=MLUN) 00217 NWRDRC = 32 00218 OPEN (UNIT=MLUN,NAME='DB0:[1,100]PDSUPF.DAT',TYPE='OLD',SHARED, 00219 1READONLY,ACCESS='DIRECT',RECORDSIZE=16,ASSOCIATEVARIABLE=KEYVAR) 00220 READ(MLUN'1) (RECORD(I),I=1,NWRDRC) 00221 NENTRY = RECORD(2)-RECORD(1)+1 00222 NPEREC = 8 00223 ENTSIZ = 4 00224 NENTNO = NPEREC+1 00225 MENTNO = 0 00226 GO TO I32705 00227 32690 CONTINUE 00228 CLOSE(UNIT=MSG,DISPOSE='DELETE') 00229 ASSIGN 32689 TO I32722 00230 GO TO 32722 00230 32689 DO 32688 I=1,4 00231 RECORD(ENTPTR+I) = SENDNM(I) 00231 32688 CONTINUE 00231 IF(.NOT.(ENTSIZ.GT.4)) GO TO 32687 00232 DO 32686 I=5,ENTSIZ 00233 RECORD(ENTPTR+I) = 0 00233 32686 CONTINUE 00233 32687 ASSIGN 32684 TO I32685 00235 GO TO 32685 00235 32684 ASSIGN 32683 TO I32721 00236 GO TO 32721 00236 32683 WRITE(MSG,12) (SUBJCT(I),I=1,60) 00237 12 FORMAT(' Reply to:',60A1) 00238 GO TO I32690 00239 32743 CONTINUE 00241 ASSIGN 32682 TO I32757 00242 GO TO 32757 00242 32682 NOMAIL = .TRUE. 00243 32681 IF(OVER()) GO TO 32680 00244 DO 32679 I=1,4 00245 TESTER(I) = USER(I) 00245 32679 CONTINUE 00245 ASSIGN 32678 TO I32754 00246 GO TO 32754 00246 32678 IF(.NOT.(MATCH)) GO TO 32677 00247 NOMAIL = .FALSE. 00248 ASSIGN 32676 TO I32697 00249 GO TO 32697 00249 32676 ASSIGN 32675 TO I32716 00250 GO TO 32716 00250 32675 GO TO 32673 00251 32674 IF(MATCH) GO TO 32672 00251 32673 MATCH = .TRUE. 00252 WRITE(TTY,5) 00253 5 FORMAT('$Disposition? ') 00254 READ(TTY,101,END=999) COMMND 00255 ASSIGN 32671 TO I32747 00256 GO TO 32747 00256 32671 IF (COMIND.EQ.DELETC) COMIND = REMOVC 00257 IF((HOLDC).NE.(COMIND)) GO TO 32669 00259 CONTINUE 00259 GO TO 32670 00260 32669 IF((ACKC).NE.(COMIND)) GO TO 32668 00260 ASSIGN 32667 TO I32690 00261 GO TO 32690 00261 32667 WRITE(MSG,13) 00262 13 FORMAT(' Acknowledged') 00263 CLOSE (UNIT=MSG) 00264 GO TO 32670 00266 32668 IF((REMOVC).NE.(COMIND)) GO TO 32666 00266 CLOSE(UNIT=MSG,DISPOSE='DELETE') 00267 ASSIGN 32665 TO I32694 00268 GO TO 32694 00268 32665 GO TO 32670 00270 32666 IF((FILEC).NE.(COMIND)) GO TO 32664 00270 WRITE(TTY,14) 00271 14 FORMAT('$Copy to File: ') 00272 READ(2,102,END=999) N,FNAME 00273 FNAME(N+1) = 0 00274 CLOSE(UNIT=TTY) 00275 CALL ASNLUN(TTY,'SY',0) 00276 OPEN(UNIT=TTY,TYPE='NEW',NAME=FNAME,CARRIAGECONTROL='LIST') 00277 REWIND MSG 00278 ASSIGN 32663 TO I32716 00279 GO TO 32716 00279 32663 MATCH = .FALSE. 00280 CLOSE(UNIT=TTY) 00281 CALL ASNLUN(TTY,'TI',0) 00282 GO TO 32670 00284 32664 IF((RPEATC).NE.(COMIND)) GO TO 32662 00284 REWIND MSG 00285 ASSIGN 32661 TO I32716 00286 GO TO 32716 00286 32661 MATCH = .FALSE. 00287 GO TO 32670 00289 32662 IF((REPLYC).NE.(COMIND)) GO TO 32660 00289 ASSIGN 32659 TO I32690 00290 GO TO 32690 00290 32659 ASSIGN 32657 TO I32658 00291 GO TO 32658 00291 32657 GO TO 32670 00293 32660 WRITE(TTY,6) 00294 6 FORMAT(' Respond with "HOLD", "ACKN"owledge, "RECE"ived,'/ 00295 1 ' "FILE", "REPE"at, or ^Z') 00296 MATCH = .FALSE. 00297 32670 GO TO 32674 00300 32672 CONTINUE 00301 32677 GO TO 32681 00302 32680 IF (NOMAIL) WRITE(TTY,2) 00303 GO TO I32743 00304 32694 CONTINUE 00306 DO 32656 I=1,ENTSIZ 00307 RECORD(ENTPTR+I) = 0 00307 32656 CONTINUE 00307 ASSIGN 32655 TO I32685 00308 GO TO 32685 00308 32655 GO TO I32694 00309 32685 CONTINUE 00310 I = KEYVAR-1 00311 WRITE(MLUN'I) (RECORD(I),I=1,NWRDRC) 00312 GO TO I32685 00313 32747 CONTINUE 00314 COMIND = 0 00315 GO TO 32653 00316 32654 IF(COMIND.EQ.MAXCMD .OR. COMMND.EQ.CMMNDS(COMIND)) GO TO 32652 00316 32653 COMIND = COMIND+1 00317 GO TO 32654 00318 32652 GO TO I32747 00319 32740 CONTINUE 00321 WRITE(TTY,51) 00322 51 FORMAT('$To? ') 00323 READ(TTY,102,END=999) N,SNDNAM 00324 ASSIGN 32651 TO I32722 00325 GO TO 32722 00325 32651 DO 32650 I=1,4 00326 TESTER(I) = SENDNM(I) 00326 32650 CONTINUE 00326 ASSIGN 32649 TO I32705 00327 GO TO 32705 00327 32649 ASSIGN 32648 TO I32754 00328 GO TO 32754 00328 32648 IF(.NOT.(.NOT.MATCH)) GO TO 32646 00329 WRITE(TTY,52) 00330 52 FORMAT(' *** MAIL - Indicated user does not exist ***') 00331 GO TO 32647 00332 32646 WRITE(TTY,53) 00334 53 FORMAT('$Subject: ') 00335 READ(TTY,102,END=999) N,SUBJCT 00336 ASSIGN 32645 TO I32757 00337 GO TO 32757 00337 32645 DO 32644 I=1,4 00338 TESTER(I) = 0 00338 32644 CONTINUE 00338 ASSIGN 32643 TO I32754 00339 GO TO 32754 00339 32643 IF(.NOT.(OVER())) GO TO 32642 00340 IF(.NOT.(NENTNO.LT.NPEREC)) GO TO 32640 00341 ENTPTR = ENTPTR+ENTSIZ 00341 GO TO 32641 00341 32640 KEYVAR = KEYVAR+1 00343 NENTNO = 1 00344 ENTPTR = 0 00345 DO 32639 I=1,NWRDRC 00346 RECORD(I) = 0 00346 32639 CONTINUE 00346 32641 CONTINUE 00348 32642 ASSIGN 32638 TO I32721 00349 GO TO 32721 00349 32638 WRITE(MSG,54) SUBJCT 00350 54 FORMAT(72A1) 00351 ASSIGN 32637 TO I32658 00352 GO TO 32658 00352 32637 DO 32636 I=1,4 00353 RECORD(ENTPTR+I) = SENDNM(I) 00353 32636 CONTINUE 00353 IF(.NOT.(ENTSIZ.GT.4)) GO TO 32635 00354 DO 32634 I=5,ENTSIZ 00355 RECORD(ENTPTR+I) = 0 00355 32634 CONTINUE 00355 32635 ASSIGN 32633 TO I32685 00357 GO TO 32685 00357 32633 IF(.NOT.(MENTNO.GT.NENTRY)) GO TO 32632 00358 DO 32631 I=1,NWRDRC 00359 RECORD(I) = 0 00359 32631 CONTINUE 00359 RECORD(1) = MENTNO 00360 WRITE(MLUN'1) (RECORD(I),I=1,NWRDRC) 00361 32632 WRITE(2,56) SNDNAM 00363 56 FORMAT(' [',12A1,' - sent]'/) 00364 32647 GO TO I32740 00366 32658 CONTINUE 00367 WRITE(TTY,55) 00368 55 FORMAT(' Enter text of message. End with ^Z') 00369 32630 IF(.NOT.(.TRUE.)) GO TO 32629 00370 READ(TTY,102,END=599) N,LINE 00371 IF(.NOT.(LINE(1).EQ.BREAKC)) GO TO 32627 00372 DO 32626 I=1,4 00373 CMMNDB(I) = LINE(I+1) 00373 32626 CONTINUE 00373 ASSIGN 32625 TO I32747 00374 GO TO 32747 00374 32625 IF((FILEC).NE.(COMIND)) GO TO 32623 00376 WRITE(TTY,57) 00377 57 FORMAT('$Get message from file ') 00378 READ(TTY,102) N,FNAME 00379 FNAME(N+1) = 0 00380 CLOSE(UNIT=TTY) 00381 CALL ASNLUN(TTY,'SY',0) 00382 OPEN(UNIT=TTY,NAME=FNAME,TYPE='OLD',READONLY,SHARED,ERR=598) 00383 IF(.TRUE.) GO TO 32622 00384 598 CALL ASNLUN(TTY,'TI',0) 00385 32622 GO TO 32624 00388 32623 IF((RPEATC).NE.(COMIND)) GO TO 32621 00388 ASSIGN 32620 TO I32697 00389 GO TO 32697 00389 32620 ASSIGN 32619 TO I32716 00390 GO TO 32716 00390 32619 CLOSE(UNIT=MSG) 00391 OPEN(UNIT=MSG,NAME=FNAME,ACCESS='APPEND',TYPE='OLD') 00392 GO TO 32624 00394 32621 IF((HELPC).NE.(COMIND)) GO TO 32618 00394 WRITE(TTY,58) 00395 58 FORMAT(' "Break" commands are ">FILE" and ">REPEat"') 00396 59 FORMAT(' The character ">" as the first character in a line'/ 00397 1 ' indicates a special or "break" command to MAIL'/ 00398 2 ' For further information on this feature type ">HELP"') 00399 GO TO 32624 00401 32618 WRITE(TTY,59) 00401 32624 GO TO 32628 00403 32627 WRITE(MSG,54) LINE 00404 32628 GO TO 32630 00405 32629 CONTINUE 00406 599 CONTINUE 00406 CLOSE(UNIT=MSG) 00407 CLOSE(UNIT=TTY) 00408 CALL ASNLUN(TTY,'TI',0) 00409 GO TO I32658 00410 32718 CONTINUE 00411 CALL DATE(DAT) 00412 CALL TIME(TIM) 00413 WRITE(MSG,41) USRNAM,DAT,TIM 00414 41 FORMAT(12A1,20X,'Postmark: ',9A1,1X8A1) 00415 GO TO I32718 00416 END 00418