Trailing-Edge
-
PDP-10 Archives
-
BB-5255D-BM
-
4-sources/nmailr.mac
There are 4 other files named nmailr.mac in the archive. Click here to see a list.
;<4.ARPA-UTILITIES>NMAILR.MAC.5, 4-Jan-80 09:48:00, EDIT BY R.ACE
;UPDATE COPYRIGHT DATES
;<4.ARPA-UTILITIES>NMAILR.MAC.4, 11-Oct-79 11:40:25, Edit by LCAMPBELL
; Update version and edit numbers for release 4
;<4.ARPA-UTILITIES>NMAILR.MAC.3, 10-Jul-79 05:32:29, EDIT BY R.ACE
;UPDATE COPYRIGHT NOTICE FOR RELEASE 4
;<COWER>NMAILR.MAC.2, 18-Aug-78 19:42:34, Edit by HESS
;TCO ???? - Fix randomness in DOTHIS (Looks in wrong place)
;<3A.ARPA-UTILITIES>NMAILR.MAC.8, 8-8-78 16:32:34, EDIT BY COWER
;WILL NOT PRINT HOST NAME/NUMBER MESSAGES ON FIRST PASS. CLEANED UP
;ALL THOSE SETOM WITH BLT
;<3.ARPA-UTILITIES>NMAILR.MAC.5, 14-Nov-77 10:21:39, EDIT BY CROSSLAND
;CORRECT COPYRIGHT NOTICE
;<3.ARPA-UTILITIES>NMAILR.MAC.4, 26-Oct-77 02:40:58, EDIT BY CROSSLAND
;UPDATE COPYRIGHT FOR RELEASE 3
;<3-UTILITIES>NMAILR.MAC.3, 30-Sep-77 11:13:00, EDIT BY CROSSLAND
;MAKE CHANGES FOR STRUCTURES
;GIVE 'LOCAL' ROUTINE ITS OWN LOCATION FOR SEND JFN SINCE IT
; MAY BE INVOKED AFTER FAILURE TO SEND VIA NETWORK AND IF IT
; STEPS ON SJFN AND SJFN CONTAINS A VALID JFN FOR A NET FILE THAT FILE
; WILL BE LEFT DANGLING
;CLOSIT NOW RETRIES FAILING CLOSF FOR NETWORK CONNECTIONS BECAUSE
; JUST ONE WON'T WORK IF FAR END BROKE THE CONNECTION
;AT DOIT LOAD SYSTEM DIRECTORY NUMBER INSTEAD OF 1
;<101B-SOURCES>NMAILR.MAC.2, 3-Apr-77 13:49:18, EDIT BY CROSSLAND
;SEND NOTIFICATION OF UNDELIVERABLE MAIL TO MAIL.TXT
;<A-SOURCES>NMAILR.MAC.6, 30-Dec-76 22:16:39, EDIT BY CROSSLAND
;CONVERT VERSION NUMBER TO DEC STYLE VERSION NUMBER
;<2MURPHY>MAILER.MAC.2, 16-Jul-76 17:20:24, EDIT BY MURPHY
;CHANGE STENEX TO MONSYM,MACSYM
;<SOURCES>MAILER.MAC;38 20-May-76 16:16:38 EDIT BY ULMER
; Add FTP reply code to QCODES for requeueing
;<SUSSMAN>MAILER.MAC;2 3-MAR-76 11:40:03 EDIT BY SUSSMAN
; Don't hold onto local net connections unless finished mail
; successfully.
;<SOURCES>MAILER.MAC;36 13-NOV-75 14:50:12 EDIT BY CLEMENTS
;<CLEMENTS>MAILER.MAC;36 13-NOV-75 14:03:00 EDIT BY CLEMENTS
; PARSE 951 FORWARDER REPLY AND DO IT LOCALLY
;<CLEMENTS>MAILER.MAC;35 12-NOV-75 17:49:45 EDIT BY CLEMENTS
; Subroutinize call to mail forwarder data base check
; Use it for mail to local host in case user isn't really local
;<SOURCES>MAILER.MAC;34 19-MAY-75 21:16:33 EDIT BY CLEMENTS
; NO CHANGES TO BINARY. JUST STANDARDIZE TYPING FORMAT.
;<SOURCES>MAILER.MAC;33 12-MAY-75 16:08:32 EDIT BY ULMER
; ADD EXTRA STATISTICS TAKING TO MAILER. ALLOW NON PRIVLEDGED
; USE TO TAKE STATISTICS. EXTRA STATISTICS ARE CPU TIME OF PROCESS,
; NUMBER OF MESSAGES AND NUMBER OF CHARACTERS PER HALF HOUR
; BLOCK PER DAY OF THE WEEK
;<SOURCES>MAILER.MAC;31 23-DEC-74 00:52:54 EDIT BY SUSSMAN
; IF CFORK FOR FORWARDING FAILS, REQUEUE, NOT UNDELIVERABLE
; NEVER ASK IF OK TO FORWARD - JUST GO AHEAD
; RE-GET LOCAL HOST # & NAME EACH TIME, NOT JUST AT START, SO SELF-
; CORRECTING IF WRONG (HAS HAPPENED THAT # OR NAME BAD)
;<SOURCES>MAILER.MAC;30 21-NOV-74 21:22:23 EDIT BY SUSSMAN
; USE "AT", NOT "^V@" IN NAKS.
; SUCCEED IN CLOSING FILES HAVING DATA ERROR STATUS.
; Don't add unnecessary <crlf> to net msg.
; Switch to select sending even local mail over net.
; Require user mailbox to be permanent, else don't recognize.
; Fix bug in forwarding confirmation.
; Writing of msg to net more efficient.
;<SOURCES>MAILER.MAC;29 20-AUG-74 20:53:16 EDIT BY SUSSMAN
; HANDLE OPNX23 FAILURE FOR MESSAGE FILE
;<SOURCES>MAILER.MAC;28 24-JUL-74 00:31:49 EDIT BY SUSSMAN
; WAIT TILL SYSTEM HAS DATE/TIME
; INCLUDE COLON IN TIME IN HEADER LINE TO MATCH FTPSRV, SNDMSG FORM
; ALWAYS PUT FLAG FIELD IN HEADER (SEE MAILER;23), NO NEWFRM FLAG
;<SOURCES>MAILER.MAC;27 16-JUL-74 16:23:00 EDIT BY SUSSMAN
; FIX PROBLEMS IN MAIL FORWARDING
;<SOURCES>MAILER.MAC;26 12-JUL-74 19:44:29 EDIT BY CLEMENTS
; IMPLEMENT MAIL FORWARDER USING MAILBOX.SAV
;<SOURCES>MAILER.MAC;25 5-JUL-74 10:38:27 EDIT BY SUSSMAN
; Queue NAKs that can't be delivered. Process these queued NAKs.
;<SOURCES>MAILER.MAC;24 2-JUL-74 14:58:10 EDIT BY SUSSMAN
; FIX AIC BITS
; RENAME (NOT DELETE) IF BAD FORMAT ADDRESS OR I/O ERR ON QUEUED FILE
; WHEEL MAILER KEEPS BINARY LOG IF "BLOGSW" ON
;<SOURCES>MAILER.MAC;23 29-JUN-74 16:33:04 EDIT BY SUSSMAN
; SIN/SOUT INSTEAD OF BIN/BOUT FOR LOCAL MAIL.
; ADD BIT FLAG FIELD TO MAIL FILE HEADER LINE IF "NEWFRM" FLAG ON.
; CENTRALIZE UNDELIVERABLE MAIL HANDLING.
;<SOURCES>MAILER.MAC;22 26-JUN-74 22:12:15 EDIT BY SUSSMAN
; FORCE FULL SCAN WHEN STARTED UP AND ONCE A DAY.
; IF NO FLAG FILE, CREATE IT.
; HANDLE CASES THAT WERE "JRST 4,." .
; POSTPONE FLAG FILE SETUP TILL AFTER PSI SYSTEM TURNED ON.
; PLUS SEVERAL OTHER (MINOR) CHANGES/FIXES
;<SOURCES>MAILER.MAC;21 18-JUN-74 14:54:47 EDIT BY SUSSMAN
; IF NO SUCH HOST, MAIL UNDELIVERABLE, NOT REQUEUED
; FIX HANDLING OF CERTAIN I/O ERRORS
;<SOURCES>MAILER.MAC;20 4-JUN-74 16:25:43 EDIT BY SUSSMAN
;<SOURCES>MAILER.MAC;20 3-JUN-74 17:12:16 EDIT BY SUSSMAN
; REFUSE TO DELIVER TO <SYSTEM>
; "TO" IN NAK HEADER
; REQUEUE ON ACCESS FAILURE FOR USER MAILBOX - FAIL IF ACCESS FAILURE
; FOR OTHER FILE
;<SOURCES>MAILER.MAC;19 4-MAY-74 11:49:27 EDIT BY SUSSMAN
; TYPE NAME OF DIRECTORY BEFORE PROCESS IT
; HANDLE MAIL TO FILES (NOT USER@HOST NAMES)
;<SOURCES>MAILER.MAC;18 26-APR-74 18:20:31 EDIT BY SUSSMAN
; Doing ICP - wait till connections fully open.
; In NAK, no dashes after header (match SNDMSG)
; Queue on FTP errors 401,436,452-454 - fail on others
; Don't send general delivery unless user says ok.
;<SOURCES>MAILER.MAC;17 22-FEB-74 17:34:24 EDIT BY SUSSMAN
; ADD ENTRY VECTOR AND VERSION INFO AFTER IT
;<SOURCES>MAILER.MAC;16 31-JAN-74 14:03:38 EDIT BY SUSSMAN
; RUN A TIMER DURING NET MESSAGE TRANSMISSION TO PREVENT
; INFINITE HANG
; FIX BUG - FAILURE TO RELEASE JFN AFTER RENAME - JFN'S
; ACCUMULATING AD INFINITUM.
; FIX BUG - AFTER RENAME, STOPS THIS DIRECTORY - BECAUSE
; RNAMF RELEASED INDEXABLE JFN
;<SOURCES>MAILER.MAC;15 29-JAN-74 15:10:00 EDIT BY SUSSMAN
; CHANGE FORM OF HEADER ON NEGATIVE ACKNOWLEDGE MESSAGE
;<SOURCES>MAILER.MAC;14 24-JAN-74 15:24:31 EDIT BY SUSSMAN
; TREAT "NET CONNECTION CLOSED" AS I/O ERROR (REQUEUE) NOT
; TOTAL FAILURE
; CHANGE OPEN MODE OF QUEUED MAIL FILE TO PREVENT SIMULTANEOUS
; ACCESS BY WHEEL AND NON-WHEEL MAILERS
;<SOURCES>MAILER.MAC;13 21-JAN-74 10:51:14 EDIT BY SUSSMAN
; DON'T DO CONNECTED DIRECTORY IF = LOGGED IN DIR.
; PRESERVE ACCOUNT AND PROTECTION WHEN RENAME UNDELIVERABLE FILE.
; IMPROVE AND FIX MESSAGES.
; CORRECT GTJFN BITS SO FINDS DELETED MESSAGE.TXT
; (FOR MAIL AND NAK).
;<TOMLINSON>MAILER.MAC;3 3-MAY-73 08:44:59 EDIT BY TOMLINSON
;<TOMLINSON>MAILER.MAC;2 3-MAY-73 08:43:41 EDIT BY TOMLINSON
;<TOMLINSON>MAILER.MAC;1 2-MAY-73 18:01:26 EDIT BY TOMLINSON
; INSTALLED FLAG FILE STUFF
;<SOURCES>MAILER.MAC;7 12-MAR-73 18:26:02 EDIT BY TOMLINSON
; MADE SUBSYSTEM, INSTALLED LOCAL, INSTALLED NAK
;<TOMLINSON>MAILER.MAC;5 12-MAR-73 16:24:38 EDIT BY TOMLINSON
;<SOURCES>MAILER.MAC;6 5-MAR-73 11:09:55 EDIT BY TOMLINSON
; FIXED GETAB BUG
;<SOURCES>MAILER.MAC;5 7-DEC-72 10:15:29 EDIT BY TOMLINSON
;<TOMLINSON>MAILER.MAC;2 7-DEC-72 09:44:36 EDIT BY TOMLINSON
;<TOMLINSON>MAILER.MAC;1 7-DEC-72 09:43:04 EDIT BY TOMLINSON
; INCREASED INTRVL, CONDITIONED RUNNING ON LOAD AVERAGE
;<SOURCES>MAILER.MAC;4 30-OCT-72 11:13:46 EDIT BY TOMLINSON
; MORE CLOSF FIXES
;<TOMLINSON>MAILER.MAC;2 30-OCT-72 10:51:47 EDIT BY TOMLINSON
;<TOMLINSON>MAILER.MAC;1 30-OCT-72 8:42:03 EDIT BY TOMLINSON
;<SOURCES>MAILER.MAC;3 25-OCT-72 18:46:03 EDIT BY CLEMENTS
;FIXED "HANGING TELNET CONN'S", EXTRA CLOSF'S
;<SOURCES>MAILER.MAC;2 12-OCT-72 0:29:02 EDIT BY TOMLINSON
; ADDED INTERRUPT STUFF
;<TOMLINSON>MAILER.MAC;5 12-OCT-72 0:19:00 EDIT BY TOMLINSON
;<TOMLINSON>MAILER.MAC;4 12-OCT-72 0:01:13 EDIT BY TOMLINSON
;<TOMLINSON>MAILER.MAC;3 11-OCT-72 23:59:39 EDIT BY TOMLINSON
;<TOMLINSON>MAILER.MAC;2 11-OCT-72 23:56:11 EDIT BY TOMLINSON
;<TOMLINSON>MAILER.MAC;1 11-OCT-72 23:53:59 EDIT BY TOMLINSON
;<SOURCES>MAILER.MAC;1 9-OCT-72 12:41:14 EDIT BY TOMLINSON
;<TOMLINSON>MAILER.MAC;19 9-OCT-72 12:41:01 EDIT BY TOMLINSON
;<TOMLINSON>MAILER.MAC;18 9-OCT-72 12:21:02 EDIT BY TOMLINSON
;<TOMLINSON>MAILER.MAC;16 9-OCT-72 12:19:12 EDIT BY TOMLINSON
;<TOMLINSON>MAILER.MAC;14 9-OCT-72 11:54:42 EDIT BY TOMLINSON
;<TOMLINSON>MAILER.MAC;13 9-OCT-72 11:39:43 EDIT BY TOMLINSON
;<TOMLINSON>MAILER.MAC;12 8-OCT-72 16:05:40 EDIT BY TOMLINSON
;<TOMLINSON>MAILER.MAC;11 8-OCT-72 14:00:37 EDIT BY TOMLINSON
;<TOMLINSON>MAILER.MAC;10 8-OCT-72 12:31:27 EDIT BY TOMLINSON
;<TOMLINSON>MAILER.MAC;9 8-OCT-72 11:37:28 EDIT BY TOMLINSON
;<TOMLINSON>MAILER.MAC;8 8-OCT-72 11:32:30 EDIT BY TOMLINSON
;<TOMLINSON>MAILER.MAC;7 8-OCT-72 11:18:12 EDIT BY TOMLINSON
;<TOMLINSON>MAILER.MAC;6 8-OCT-72 10:57:22 EDIT BY TOMLINSON
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (C) 1976,1977,1978,1979,1980 BY DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
TITLE NMAILR
SUBTTL R.S.TOMLINSON
SEARCH MONSYM,MACSYM
VWHO==0 ;LAST EDITED BY DEC
VMAJOR==4 ;MAJOR VERSION #
VMINOR==0 ;REVISION #
VEDIT==^D25 ;EDIT NUMBER
; NMAILR operates under sysjob and periodically attempts to
; distribute unsent mail left behind by sndmsg.
; Local mail is appended to message files, and remote mail
; is sent by ftp mail facility.
; Files are deleted after successful transmission.
; Ac's
F=0
A=1
B=2
C=3
D=4
T1=5
T2=6
P=17
FILCHR="*" ;CHAR SIGNALLING ADDRESS IS FILE, NOT USER
;FLAGS IN F
DONAKF==2000 ;on when delivering queued NAKs
FILEF==1000 ;FLAG MSG TO FILE, NOT USER
NCFRMF==200 ;CONFIRMATION NEEDED FOR GENL DELIVERY
NUMF==10
FRSTRY==2 ;On for first try at sending msg
;(so LOCAL knows whether net already tried)
NETFLG==1 ;On when sending over net, off for local
LPDL==40
IINTVL==^D10 ; INTERVAL BETWEEN RUNS (MINUTES)
MESSIZ==5000
;PAGES FOR MAPPING FILES
FLAGPG==100
;BINARY LOG PAGES
LPGMS==101 ;# MSGS SENT, BY SITE
LPGCS==102 ;# CHARS SENT, BY SITE
LPGUSR==103 ;USER FLAGS
LPGMST==105 ;# MSGS SENT BY TIME
LPGCST==106 ;# CHARS SENT BY TIME
;WINDOW PAGE INTO MAILBOX.SAV FORWARDER
FWDPAG==104
FWDADR==FWDPAG*1000
DEFINE CLOSE(JFN)<
MOVEI A,JFN
PUSHJ P,CLOSIT>
DEFINE ERRSET(WHERE)<
MOVEM A,FILERR
MOVEI A,WHERE
EXCH A,FILERR
MOVEM P,FILERP>
ENTVEC: JRST START ;START ADDRESS
JRST START ;REENTER ADDRESS
VRSION: <VWHO>B2+<VMAJOR>B11+<VMINOR>B17+VEDIT ;VERSION
START: RESET ; Reset the world
MOVEI A,400000 ;GET INITIAL RUN TIME
RUNTM
MOVEM A,IFRKTM
MOVE P,[IOWD LPDL,PDL] ; Set up stack
MOVSI A,(RC%EMO) ;GET PS:<SYSTEM>DIRECTORY NUMBER
HRROI B,[ASCIZ /PS:<SYSTEM>/]
RCDIR
MOVEM 3,SYSDNM
GJINF
JUMPL 4,[
MOVEI A,400000 ; DETACHED, TRY TO ENABLE
RPCAP
MOVE C,B
EPCAP
JRST STA1]
MOVEI A,101
MOVE B,[BYTE (2)0,1,1,1,1,1,1,2,1,2,2,1,1,2,1,1,1,1]
MOVE C,[BYTE (2)1,1,1,1,0,1,1,1,1,3,1,1,1,2]
SFCOC
STA1: MOVEI A,400000
RPCAP ; READ CAPABILITIES
TRNN C,600000 ; ENABLED WHEEL OR OPERATOR?
TDZA A,A ; NO
SETO A,
MOVEM A,WHEELF
ORCAM A,DBUGSW
MOVE A,A ;REPLACED SKIPN WHEELF CAP. TEST FOR LOG
SETZM BLOGSW ;NO BINARY LOG IF NON-WHEEL
SKIPN NOHOST
SETZM NOHOST
SETZM NXTFUL
SETZM MAXFUL
MOVE A,[INJFN,,INJFN+1]
SETOM INJFN
BLT A,INJFN+11 ;BLT THEM TO -1
ERRSET(ICRASH)
MOVEI A,400000
MOVE B,[XWD LEVTAB,CHNTAB]
SIR
EIR
MOVE B,[1B0!1B9!1B11!1B15]
AIC
GTAD ;SEE IF SYSTEM HAS DATE/TIME YET
JUMPG A,STA2 ;YES, GO AHEAD
HRROI A,[ASCIZ /
System has no date yet - will restart in 1 minute...
/]
SKIPE DBUGSW
PSOUT
MOVE A,[^D60000]
DISMS ;WAIT A MINUTE
JRST START ;AND START OVER
STA2: HRROI B,[ASCIZ /PS:<SYSTEM>MAILER.FLAGS.1;P777777/]
MOVSI A,(1B17) ; FILE OF BITS, ONE PER DIRECTORY. SET TO ONE TO RUN MAILER.
GTJFN
JRST [ MOVEM A,B
HRROI A,[ASCIZ /
***** MAILER CANNOT GET JFN FOR PS:<SYSTEM>MAILER.FLAGS.1
BECAUSE: /]
JRST MFERR ]
MOVEI B,1B19+1B20+1B25
OPENF
JRST [ MOVEM A,B
HRROI A,[ASCIZ /
***** MAILER CANNOT OPEN PS:<SYSTEM>MAILER.FLAGS.1
BECAUSE: /]
JRST MFERR ]
HRLZS A
MOVE B,[400000,,FLAGPG]
MOVSI C,140000
PMAP ;MAP PAGE, AND REFERENCE IT TO
MOVE D,FLAGPG*1000 ;FORCE ANY DATA ERROR
MOVSI A,(1B0)
CFORK
JRST [ MOVEM A,B
HRROI A,[ASCIZ /
***** MAILER CANNOT CREATE FORK
BECAUSE: /]
JRST MFERR ]
MOVEM A,TIMFRK
RPCAP ;MAKE SURE IT CAN SIGNAL WHEN DONE
TLO B,(1B9)
TLO C,(1B9)
EPCAP
MOVE A,[SIXBIT /LHOSTN/]
SYSGT
JUMPE B,[HRROI A,[ASCIZ /
***** MAILER CANNOT GET LOCAL HOST NUMBER FROM SYSTEM.
/]
JRST CRASH4]
MOVEM A,LHOSTN
MOVEI B,(A)
HRROI A,LHSTNM
CVHST
JRST [
HRROI A,[ASCIZ /
***** MAILER CANNOT GET LOCAL HOST NAME FROM SYSTEM.
/]
JRST CRASH4]
SKIPN WHEELF
JRST DOTHIS
JRST TOP
MFERR: PSOUT
MOVEI A,101
HRLI B,400000 ;ERROR CODE IS IN RH(B) ALREADY
SETZ C,
ERSTR
JFCL
JFCL
JRST CRASH3
TOP: HRROI A,[ASCIZ /
AWAKENED.../]
SKIPE DBUGSW
PSOUT
MOVE A,[SIXBIT /SYSTAT/]
SYSGT
MOVE A,B
HRLI A,15
GETAB
SETZ A,
MOVEM A,C ;SAVE LOAD AVERAGE IN C
TIME
IDIV A,B ;CONVERT TO SEC THEN TO MS
IMULI A,^D1000 ;IN CASE NOT IN MS ALREADY
CAMG A,NXTFUL ; FORCE RUNNING AFTER ONE DAY
JRST DOIT
CAML A,MAXFUL
JRST FULSCN ;MAX TIME ELAPSED, MUST DO FULL SCAN
CAML C,MAXLOD
JRST DOIT
FULSCN: ADD A,FULINT
MOVEM A,NXTFUL ; NEXT COMPLETE SCAN ATTEMPT
SUB A,FULINT
ADD A,MAXINT
MOVEM A,MAXFUL
HRROI A,[ASCIZ /
Full scan/]
SKIPE DBUGSW
PSOUT
MOVEI A,1 ; START WITH USER 1
DOITAL: PUSH P,A
HLL A,SYSDNM ;GET STRUCTURE NUMBER
PUSHJ P,DOONE ; DO THIS ONE
JFCL ; IGNORE SUCCESS
POP P,A
CAMG A,LSTUSR
AOJA A,DOITAL
JRST WAIT
DOIT: MOVE A,SYSDNM ;BACKGROUND SHOULD CHECK SYSTEM
PUSHJ P,DOONE ;FOR FTP SERVER STUFF
JFCL
MOVSI D,-1000
DOITLP: MOVE A,FLAGPG*1000(D)
EDOITL: JFFO A,DOIT1
AOBJN D,DOITLP
JRST WAIT
DOIT1: PUSH P,A ; SAVE BITS
HRRZ A,D ; GET WORD OFFSET
IMULI A,^D36 ; 36 BITS PER WORD
ADD A,B ; ADD IN BIT OFFSET
MOVSI C,400000
MOVNS B
ROT C,0(B) ; GET A BIT FOR THIS ONE
ANDCAM C,FLAGPG*1000(D) ; CLEAR BIT IN FLAG PAGE
ANDCAM C,0(P) ; AND IN THE WORD
PUSH P,D
HLL A,SYSDNM ;GET STRUCTURE NUMBER
PUSHJ P,DOONE
POP P,D ; RESTORE INDEX
POP P,A ; RESTORE JFFO WORD
JRST EDOITL
DOTHIS: GJINF
TLO A,040000 ;MAKE DIRECTORY #
PUSHJ P,DOONE
JFCL
GJINF
TLO A,040000 ;MAKE DIRECTORY #
CAMN A,B
JRST DOHALT
MOVE A,B
PUSHJ P,DOONE
JFCL
DOHALT: CLOSE(MYRJFN) ;CLOSE TELNET CONNECTIONS TO SELF, IF ANY
CLOSE(MYSJFN)
HALTF
JRST DOTHIS
DOONE: MOVEM A,XUSER
MOVE B,XUSER
HRROI A,XUSNAM
DIRST ;GET USER NAME
POPJ P, ;NO SUCH USER
PUSHJ P,OPNBLG ;OPEN&MAP BINARY LOG IF APPROPRIATE
TRO F,DONAKF ;Do queued NAKs
PUSHJ P,DOPROG
TRZ F,DONAKF ;Do regular queued mail
PUSHJ P,DOPROG
POPJ P, ;Done with this user
DOPROG: MOVE A,[POINT 7,FILNAM]
HRROI B,XUSNAM
SETZ C,
SOUT
HRROI B,[ASCIZ /[--UNSENT-MAIL--].*.*/]
TRNE F,DONAKF
HRROI B,[ASCIZ /]--UNSENT-NEGATIVE-ACKNOWLEDGEMENT--[.*.*/]
SOUT
HRROI B,FILNAM
MOVSI A,(1B2+1B11+1B17)
GTJFN ; Get file group designator
JRST NOFILS ; Nothing to do
MOVEM A,INJFN ; Save it
HRROI A,[ASCIZ /
Queued mail from /]
TRNE F,DONAKF
HRROI A,[ASCIZ /
Acknowledgements for /]
SKIPE DBUGSW
PSOUT
HRROI A,XUSNAM
SKIPE DBUGSW
PSOUT
JRST LOOP
NOFILS: HRROI A,[ASCIZ /
No queued mail from /]
TRNE F,DONAKF
HRROI A,[ASCIZ /
No acknowledgements for /]
SKIPE DBUGSW
PSOUT
HRROI A,XUSNAM
SKIPE DBUGSW
PSOUT
POPJ P,
LOOP: ; Loop to here for each file
SETZM STRING
SETZM HOST
MOVEI A,5 ; COUNT TO DETECT LOOPS IN FORWARDING
MOVEM A,FWDCNT
HRROI A,[ASCIZ /
/]
SKIPE DBUGSW
PSOUT ; Footprints
MOVEI A,101
HRRZ B,INJFN
MOVSI C,100 ; Extension only, no punctuation
SKIPE DBUGSW
JFNS ; Print file extension
HRRZ A,INJFN
MOVE B,[7B5+1B19+1B20+1B27] ;DON'T CHANGE ACCESS DATES
OPENF ; Open it
JRST [ CAIN A,OPNX9
JRST NEXT ;BUSY
HRRZ A,INJFN
MOVE B,[7B5+1B19] ; 7 bit bytes, read
OPENF
JRST NEXT
JRST OPENED ]
OPENED: MOVE A,[SIXBIT /LHOSTN/]
SYSGT ;GET LOCAL HOST #
SKIPE B ;IGNORE FAILURE
MOVEM A,LHOSTN ;STORE IT IF SUCCESS
HRRZ B,LHOSTN ;NOW GET NAME
HRROI A,LHSTNM
CVHST
JFCL
TRO F,FRSTRY ;First try on this file
HRRZ A,INJFN
SETO B,
SFPTR
JFCL
RFPTR
JFCL
MOVEM B,FILLEN
SETZ B,
SFPTR
JFCL
TRNE F,DONAKF
JRST NAKADR
HRRZ A,INJFN
MOVE B,[1,,14]
MOVEI C,C
GTFDB ; GET WRITE DATE
GTAD ; AND NOW
ADD C,MAXQUE ; BEEN AROUND TOO LONG?
CAML A,C
JRST [ HRROI A,[ASCIZ / - not deliverable after 5 days/]
JRST UNDLV]
MOVE A,[POINT 7,STRING] ; Make a string here
HRRZ B,INJFN
MOVSI C,100
JFNS ; Of the extension
MOVE A,[POINT 7,STRING] ; Prepare to scan it
MOVE C,A ; COPY OF THE POINTER
FINDAT: ILDB B,A ; Get a character
CAIN B,"V"-100 ; If control-v
ILDB B,A ; SKIP IT
IDPB B,C ; COPY THE SCHARACTER
JUMPE B,NOAT ; If null, then improper form
CAIE B,"@" ; If at sign
JRST FINDAT ; Not...continue looking
SETZ B,
DPB B,C
MOVEM A,HOST ; Yes...here beginneth the host name
ILDB B,A ; See if the host name is null
JUMPE B,LOCAL ; If so, then local mail
JRST REMOTE
NOAT: HRROI A,[ASCIZ / - address has improper format/]
JRST UNDLV
NAKADR: MOVE A,[POINT 7,STRING] ;for NAK, address is directory
MOVE B,[POINT 7,XUSNAM] ; being processed
SETZ C,
SOUT
JRST LOCAL
; CHECK status o netword connection
CONCHK: GTSTS
TLNE B,(1B10) ;Must exist, be open
TLNN B,(1B0)
POPJ P,
TLNE B,(1B8+1B9) ;SHOULD BE NOT ERROR, NOT EOF
POPJ P,
GDSTS ;MAKE SURE CONNECTION IN OPND STATE
LDB C,[POINT 4,B,3]
CAIE C,7
POPJ P,
AOS 0(P)
POPJ P,
REMOTE: TRO F,NETFLG ;Flag doing net.
MOVE A,STIMER ;SET TIMER
MOVEM A,TIMERT
MOVE A,TIMFRK
MOVEI B,TIMER
MOVEM P,TIMERP
SFORK
RFORK
HRROI A,LHSTNM ;LOCAL MAIL?
CAME A,HOST
JRST DOICP ;NO, DO ICP AS USUAL
SKIPG A,MYRJFN ;LOCAL. IF HAVE CONNECTIONS
JRST DOICP ; TO SELF AND THEIR STATUS
PUSHJ P,CONCHK ; SEEMS OK, USE THEM. ELSO DO ICP.
JRST MYBAD
SKIPG A,MYSJFN
JRST MYBAD
PUSHJ P,CONCHK
JRST MYBAD
MOVE A,MYRJFN ;CONNECTIONS OK, USE THEM
MOVEM A,RJFN
MOVE A,MYSJFN
MOVEM A,SJFN
SETOM NETOK ;Don't re-use conns unless finish
JRST DOMAIL
MYBAD: CLOSE(MYRJFN) ;CONNECTIONS BAD, CLOSE THEM
CLOSE(MYSJFN)
DOICP: MOVE A,[POINT 7,FILNAM] ; Else remote. prepare to
HRROI B,[ASCIZ /NET:0./]; Make net file name
SETZ C,
SOUT
MOVE B,HOST ; Now for the host
SOUT
MOVN B,FTPSKT ; And now the foreign ftp socket
MOVEI C,10 ; In radix 8
NOUT
JFCL
HRROI B,[ASCIZ /;T/] ; Make JOB RELATED
SETZ C,
SOUT
MOVSI A,1 ; String, short form
HRROI B,FILNAM ; With the string we just made
GTJFN ; Get a jfn for that connection
JRST [ CAIE A,GJFX19 ; FAILS IF NO HOST OR IF IMP DOWN
JRST FAIL
HRROI A,[ASCIZ / - no such host/]
JRST UNDLV ]
MOVEM A,IJFN ; Save it
MOVE B,[40B5+1B19] ; 32-bit, read
OPENF ; Open it
JRST FAIL ; Can't do it. Host is down or ftp dead
ERRSET(FAIL)
BIN ; Get the foreign socket to use
MOVEM B,FSKT ; And save it
CLOSE(IJFN)
OPENIO: MOVE A,[POINT 7,FILNAM] ; Now make up the name for the io
HRROI B,[ASCIZ /NET:2./]
SETZ C, ; Connections. 2 = 0+2
SOUT
MOVE B,HOST ; And the foreign host
SOUT
MOVN B,FSKT ; And -socket
MOVEI C,10
NOUT
JFCL
HRROI B,[ASCIZ /;T/] ; Make JOB RELATED
SETZ C,
SOUT
HRROI B,FILNAM
MOVSI A,1 ; String short form
GTJFN ; Get jfn for sending
JRST FAIL ; Can't do it now
MOVEM A,SJFN ; Save jfn
MOVSI A,1 ; String short form again
HRROI B,FILNAM ; Same string will work
GTJFN ; To get jfn for receive
JRST FAIL ; Not likely
MOVEM A,RJFN ; Save it
MOVE B,[10B5+6B9+1B19] ; 8-bit, read
OPENF ; Open receive
JRST FAIL ; Can't, maybe host went down
MOVE A,SJFN ; And the send
MOVE B,[10B5+5B9+1B20] ; 8-bit, buffered, wait, write
OPENF
JRST FAIL
HRROI A,[ASCIZ /, FTP ok/]
SKIPE DBUGSW
PSOUT ; Footprint
PUSHJ P,WAITOK ; Get a response line from ftp
JRST FAIL ; Negative response received
HRROI A,LHSTNM ;IF TALKING TO SELF
CAME A,HOST ; HOLD ON TO CONNECTIONS
JRST DOMAIL ;NOT SELF, GO ON
MOVE A,RJFN
MOVEM A,MYRJFN
MOVE A,SJFN
MOVEM A,MYSJFN
SETOM NETOK
DOMAIL: TRZ F,NCFRMF
REMAIL: MOVE A,SJFN ; Give mail <user> command
HRROI B,[ASCIZ /MAIL /]
SETZ C,
SOUT ; Say "mail "
HRROI B,STRING
SOUT ; Now say "<user>"
HRROI B,[ASCIZ /
/]
SOUT ; And terminate with crlf
MOVEI B,21
MTOPR ; Send off the buffer
WAT1: PUSHJ P,WAITOK ; Get response
JRST WATFAI
CAMN C,GENDLV ;GENERAL DELIVERY?
JRST [ SKIPN DBUGSW
JRST WATFA2
HRROI A,REPLY
PSOUT
TRO F,NCFRMF
JRST WAT1]
CAMN C,FWDDLV ; Offer of forwarding service?
JRST FWDDIV ; YES, GO PARSE IT AND REDIRECT MAIL.
CAME C,USEROK ; Was this a positive acknowledge
JRST WAT1 ; No, get another
WAT2: TRNE F,NCFRMF
JRST [ HRROI B,[ASCIZ / - not sending via general delivery/]
HRROI A,[ASCIZ /Is general delivery OK for this user? /]
JRST CFRMQ]
WATMRG: HRROI A,[ASCIZ /, mail allowed/]
SKIPE DBUGSW
PSOUT ; Footprint
MOVE A,SJFN
GDSTS
MOVEM C,HSTNUM ;HOST NUMBER
MOVE A,TIMFRK
FFORK
MOVE A,LTIMER ;SET TIMER
MOVEM A,TIMERT
MOVE A,TIMFRK
MOVEI B,TIMER
SFORK
RFORK
MOVE B,FILLEN
MOVEM B,NCHARS
CPYLP: SKIPG C,FILLEN ;Copy mail fromfile to net.
JRST EOF ;No chars left.
CAILE C,MESSIZ ;If more than a bufferful,
MOVEI C,MESSIZ ; take only a bufferful now.
MOVE B,FILLEN ;Subtract from # remaining chars
SUB B,C
MOVEM B,FILLEN
PUSH P,C ;Save # chars to copy
SETZ D, ;Will terminate on nulls
HRROI B,MESSAG ;Will read from file to MESSAG
ERRSET(DEL1) ;DEL1 if I/O err on input file
CPYLP2: HRRZ A,INJFN ;Loop fills buff, flushing nulls
JUMPE C,CPYLP4 ;Done all the chars
SIN ;Read in chars up to null.
LDB A,B ;Stopped by a null?
JUMPN A,CPYLP4 ;No, done reading this buff.
SOS NCHARS ;Yes, flush the null.
SOS 0(P) ;Decrement char counts (both
MOVE A,B ; (total and this buff) and
BKJFN ;Back up buff ptr
JFCL
MOVEM A,B
JRST CPYLP2 ;Then continue reading.
CPYLP4: POP P,C ;Filled a buff, get # chars to
HRROI B,MESSAG ; write out.
ERRSET(FAIL) ;FAIL if I/O er writing to net.
CPYLP6: JUMPE C,CPYLP ;If wrote all, continue read
MOVE A,SJFN ;Will write to net
MOVEI D,12 ;Stop at linefeeds
SOUT
PUSH P,B ;Save buff ptr & remaining chars
PUSH P,C
CHKRSP: MOVE A,RJFN ; Check for any responses
SIBE
SKIPA
JRST [ POP P,C ; No response, continue
POP P,B
JRST CPYLP6 ]
PUSHJ P,WAITOK ; Response. get it
JRST [ SUB P,[XWD 2,2] ; Ftp decided to reject
JRST FTPERR]
JRST CHKRSP ; Flush all responses before continuing
CFRMQ: PUSH P,A
MOVE A,TIMFRK
FFORK
MOVE A,[POINT 7,REPLY]
SETZ C,
SOUT
POP P,A
PSOUT
MOVEI A,100
RFMOD
TRO B,77B23
SFMOD
PBIN
CAIE A,"Y"
CAIN A,"y"
JRST WATMRG
CAIE A,"N"
CAIN A,"n"
JRST WATFA2
JRST WAT2
FWDDIV: HRROI A,REPLY
SKIPE DBUGSW
PSOUT
SOSG FWDCNT ;TOO MANY INDIRECTIONS?
JRST FWDLUP ;YES. QUIT. SOMEONE'S IN A LOOP.
MOVE A,[440700,,REPLY] ;SEE IF IT'S THE STANDARD TENEX TEXT
MOVE B,[440700,,[ASCIZ / MAIL WILL BE FORWARDED TO /]]
PUSHJ P,STRCMP ;COMPARE STRINGS
JRST WAT1 ;NOT THE STANDARD STRING. SEND MAIL.
MOVE B,[440700,,FWDNAM] ;OK, GET THE NAME STRING
MOVEI T2,^D40 ;LENGTH OF A NAME
FWDDV1: ILDB T1,A ;CHAR FROM SERVER
IDPB T1,B ;TO NAME STORAGE
CAIE T1," " ;PROBABLE END OF FIELD
SOJG T2,FWDDV1 ;NO, LOOP TO SPACE
JUMPLE T2,WAT1 ;NAME TOO LONG. TRY SENDING IT.
MOVEI T1,0 ;TERMINATE NAME
DPB T1,B ; ..
MOVE B,[440700,,[ASCIZ /AT /]]
PUSHJ P,STRCMP ;CONTINUE CHECKING REPLY
JRST WAT1 ;NOT THE RIGHT TEXT
MOVE B,[440700,,FWDHST] ;COLLECT SITE NAME
MOVEI T2,^D40 ;WHICH MAIL SHOULD GO TO
FWDDV2: ILDB T1,A
IDPB T1,B
CAILE T1,40 ;END OF LINE?
SOJG T2,FWDDV2
JUMPLE T2,WAT1 ;JUMP IF TEXT TOO LONG
MOVEI T1,0 ;TERMINATE SITENAME STRING
DPB T1,B
MOVE A,[440700,,FWDHST]
MOVEM A,HOST ;HERE'S WHERE TO SEND IT NEXT
MOVE A,[FWDNAM,,STRING] ;AND THE USER NAME THERE
BLT A,STRING+7
PUSHJ P,TNCLOS ;CLOSE THE CURRENT CONNECTION
HRROI A,[ASCIZ /, connecting to /]
SKIPE DBUGSW
PSOUT
HRROI A,FWDHST
SKIPE DBUGSW
PSOUT
JRST REMOTE ;AND GO DO A NEW ICP
FWDLUP: HRROI A,[ASCIZ /, too many forwarding steps/]
SKIPE DBUGSW
PSOUT
JRST FAIL
STRCMP: ILDB T2,B
JUMPE T2,CPOPJ1 ;JUMP IF STRINGS MATCH THRU NULL
ILDB T1,A
CAIL T1,"A"+40
CAILE T1,"Z"+40
SKIPA
TRZ T1,40
CAMN T1,T2
JRST STRCMP
POPJ P,0 ;NON SKIP IF STRINGS DIFFER.
WATFAI: CAMN C,NEDLOG ; Need login?
JRST MITMUL ; Must be multics
FTPERR: HRLZ D,MNQCOD
JUMPGE D,WATFA2
WATMRL: CAMN C,QCODES(D)
JRST FAIL
AOBJN D,WATMRL
WATFA2: HRROI A,REPLY
WATFA3: PUSH P,A
PUSHJ P,TNCLOS ;CLOSE THE TELNET CONNECTION TO THE HOST
POP P,A
JRST UNDLV
MITMUL: HRROI B,[ASCIZ /USER NETML
/]
PUSHJ P,SWTOK
JFCL
HRROI A,[ASCIZ / - Multics idiosyncrasy/]
CAME C,NEDPAS
JRST WATFA3
HRROI B,[ASCIZ /PASS NETML
/]
PUSHJ P,SWTOK
JFCL
HRROI A,[ASCIZ / - Multics idiosyncrasy/]
CAME C,LOGOK
JRST WATFA3
JRST REMAIL
EOF: ERRSET(FAIL)
MOVE A,SJFN ; End of input
SETZ C,
SKIPG NCHARS ;Output a <crlf> if last char sent
JRST EOF2 ; wasn't linefeed. If no chars, no crlf
LDB D,B ;Get last char sent
CAIN D,12 ;Lf?
JRST EOF2 ;Yes.
HRROI B,[ASCIZ /
/]
SOUT ;No lf, put one out.
EOF2: HRROI B,[ASCIZ /.
/]
SOUT ; Output terminating period
MOVEI B,21
MTOPR ; And send whatever is left behind
WATDUN: PUSHJ P,WAITOK ; Get a response
JRST FTPERR ; Rejection
CAME C,MAILOK ; Positive acknowledge?
JRST WATDUN ; No...get another response
HRROI A,[ASCIZ /, sent ok/]
SKIPE DBUGSW
PSOUT ; Footprint
MOVE A,RJFN ;If talking to own site
CAMN A,MYRJFN ; mark connection as OK to keep
SETZM NETOK
PUSHJ P,BLOG ;BINARY LOG INFO
PUSHJ P,TNCLOS ; CLOSE THE TELNET CONNECTIONS,
DELETE: HRRZ A,INJFN
DELF ; Delete the source
JFCL
HRROI A,[ASCIZ /, deleted/]
SKIPE DBUGSW
PSOUT ; Footprint
JRST NEXTOK
RENAME: HRROI B,[ASCIZ \/UNDELIVERABLE-MAIL/\] ;MAKE A NEW FILE NAME TO
PUSHJ P,GETFIL ;SAVE THE MESSAGE TEXT OF FAILED MAIL
JRST RNFAIL
MOVEM A,NEWJFN
HRRZ A,INJFN ;CLOSE SO CAN RENAME,
HRLI A,400000 ;BUT DONT RELEASE JFN
CLOSF
JRST RNFAIL
MOVE A,[440700,,FILNAM] ;GET A FRESH JFN FOR THE
HRRZ B,INJFN ;FILE TO BE RENAMED. RNAMF
MOVE C,[011110,,1] ;RELEASE THE SOURCE JFN -
JFNS ;DONT WANT IT TO RELEASE
MOVE A,[1B2+1B17] ;THE INDEXABLE ONE.
HRROI B,FILNAM
GTJFN
JRST RNFAIL
MOVEM A,OLDJFN
MOVE A,OLDJFN
MOVE B,NEWJFN
RNAMF
JRST RNFAIL
MOVE A,B
RLJFN
JFCL
HRROI A,[ASCIZ /, RENAMED/]
SKIPE DBUGSW
PSOUT
JRST NEXTOK
RNFAIL: CLOSE(OLDJFN)
CLOSE(NEWJFN)
JRST DELETE
; GTJFN a file having name from B; directory, extension, protection,
; account from input file (INJFN)
; return +1 if fail, +2 if succeed, error code or JFN in A.
GETFIL: PUSH P,B
MOVE A,[440700,,FILNAM]
HRRZ B,INJFN
MOVE C,[110000,,1] ;USER NAME
JFNS
POP P,B
MOVEI C,0
SOUT
HRRZ B,INJFN
MOVE C,[000101,,100001] ;EXTENSION,PROTECTION,ACCOUNT
JFNS
MOVSI A,400001
HRROI B,FILNAM
GTJFN
POPJ P,
AOS 0(P)
POPJ P,
UNDLV: PUSH P,A ;SAVE ERROR MESSAGE
SKIPE DBUGSW ;TYPE IT IF APPROPRIATE
PSOUT
POP P,A ;RESTORE ERROR MESSAGE
TRNE F,DONAKF
JRST NEXT1 ;Don't NAK for NAKs !
PUSHJ P,NAK ;SEND IT AS NAK
JRST RENAME ;RENAME QUEUED FILE
NEXT: MOVE A,XUSER
PUSHJ P,SETBIT ; UNSUCCESSFUL, SET FLAG BIT FOR LATER
NEXT1: HRROI A,[ASCIZ /, requeued/]
SKIPE DBUGSW
PSOUT
NEXTOK: ERRSET(ICRASH)
PUSHJ P,TNCLOS
MOVEI A,"."
SKIPE DBUGSW
PBOUT ; Footprint
HRRZ A,INJFN
GTSTS
HRLI A,(1B0)
SKIPGE B ; If file is open
CLOSF ; Close it
JFCL
MOVE A,INJFN
GNJFN ; Get to next file of this group
POPJ P, ; DONE, TRY NEXT DIR
JRST LOOP ; Another. handle it
TNCLOS: MOVE A,TIMFRK ;CLOSE NET CONNECTIONS IF ANY
FFORK
MOVE A,MYRJFN ;IF RCV JFN IS TO SELF,
CAME A,RJFN
JRST TNCL1
SKIPN NETOK ; Ok to reuse?
JRST [ SETOM RJFN ;yes, pretend none so won't close
JRST TNCL1 ] ; and MYRJFN will remain valid
SETOM MYRJFN ;No, close & erase MYRJFN
TNCL1: CLOSE(RJFN)
MOVE A,MYSJFN ;SAME FOR SEND JFN
CAME A,SJFN
JRST TNCL2
SKIPN NETOK
JRST [ SETOM SJFN
JRST TNCL2 ]
SETOM MYSJFN
TNCL2: CLOSE(SJFN)
CLOSE(IJFN)
POPJ P,
SETBIT: PUSHJ P,BITWRD
IORM C,FLAGPG*1000(A)
POPJ P,
;ACCEPT IN 1 A (USER) NUMBER
;RETURN IN 1 A WORD NUMBER AND IN 3 A MASK TO SELECT
; THE CORRESPONDING (TO THE USER NUMBER) BIT
BITWRD: HRRZS A ;USE ONLY RIGHT HALF
IDIVI A,^D36
MOVSI C,400000
MOVNS B
ROT C,(B)
POPJ P,
DEL1: HRROI A,[ASCIZ / - queued file has data error/]
JRST UNDLV
NAK: PUSH P,A
MOVE A,[POINT 7,MESSAG]
HRROI B,[ASCIZ /Date: /]
SETZ C,
SOUT
SETO B,
MOVE C,[1B5+1B7+1B10+1B12+1B13] ;FORM "29 JAN 1974 1200-EDT"
ODTIM
HRROI B,[ASCIZ /
To: /]
SETZ C,
SOUT
HRROI B,XUSNAM
SOUT
HRROI B,[ASCIZ /
From: Mailer
Mail for /]
SETZ C,
SOUT
SKIPN STRING ;ADR PLACED IN STRING YET?
JRST NAK2 ;NO, MUST GET FROM FILE NAME
HRROI B,STRING ;YES, GET FROM STRING
SOUT
SKIPN B,HOST ;SEPARATE HOST NAME?
JRST NAK4 ;NO, DONE
ILDB D,B ;IS HOST NAME NULL?
JUMPE D,NAK4 ;IF SO, DONE
HRROI D,LHSTNM ;IF LOCAL, ALSO SKIP HOST NAME
CAMN D,HOST
JRST NAK4
HRROI B,[ASCIZ / at /]
SOUT
MOVE B,HOST ;ADD HOST
SOUT
JRST NAK4 ;NOW DONE
NAK2: HRRZ B,INJFN
MOVSI C,(BYTE (3)0,0,0,1)
JFNS
NAK4: HRROI B,[ASCIZ / not deliverable because:
/]
SETZ C,
SOUT
POP P,B
SOUT
HRROI B,[ASCIZ /
------
/]
SOUT
PUSH P,A
IBP 0(P)
HRRZ B,A
SUBI B,MESSAG
IMULI B,5
PUSH P,B
LDB A,[POINT 6,A,5]
MOVNS A
ADDI A,44
IDIVI A,7
ADDM A,0(P)
MOVE A,XUSER
CAMN A,SYSDNM ;DON'T NAK TO SYSEM
JRST NNAK
MOVE A,-1(P)
HRRZ B,INJFN
MOVE C,[1B5+1B35]
JFNS
HRROI B,[ASCIZ /MAIL.TXT.1/]
SETZ C,
SOUT
MOVE B,-1(P)
MOVSI A,(1B0+1B2+1B8+1B17)
GTJFN
JRST NNAK ; CAN'T NAK
MOVEM A,-1(P)
MOVE B,[XWD 1,1] ;If alleged mail file not permanent,
MOVEI C,C ; pretend didn't exist.
GTFDB
TDNN C,[1B1]
JRST NAKERR
MOVE B,[7B5+1B22] ; APPEND
OPENF
NAKERR: JRST [ MOVE A,-1(P)
RLJFN
JFCL
JRST NNAK]
MOVE B,0(P) ;NUMBER OF CHARS IN MSG
PUSHJ P,HEADER ;WRITE HEADER LINE
NAKOUT: HRROI B,MESSAG
MOVN C,0(P)
SOUT
CLOSF
JFCL
NAKDON: SUB P,[2,,2]
POPJ P,
; Can't deliver the NAK now - queue it.
NNAK: HRROI B,[ASCIZ /]--UNSENT-NEGATIVE-ACKNOWLEDGEMENT--[/]
PUSHJ P,GETFIL
JRST NAKDON
MOVEM A,-1(P) ;SAVE JFN
MOVE B,[7B5+1B22] ;APPEND, 7-BIT BYTES
OPENF
JRST [ MOVE A,-1(P)
RLJFN
JFCL
JRST NAKDON ]
MOVE A,XUSER ;SET FLAG
PUSHJ P,SETBIT
MOVE A,-1(P) ;JFN AGAIN
JRST NAKOUT ;WRITE OUT THE MESSAGE
LOCAL: TRZ F,NETFLG ;Flag not doing net
ERRSET(FAIL)
TRZ F,FILEF ;ASSUME TO USER, NOT NAMED FILE
MOVE B,[POINT 7,STRING] ;IF 1ST CHAR IS FILCHR,
ILDB C,B ; THEN ADRESS IS FILE, NOT USER
CAIE C,FILCHR
JRST LOCUSR ;USER
TRO F,FILEF ;TO NAMED FILE, NOT USER MAILBOX
SKIPE WHEELF
JRST [ HRROI A,[ASCIZ /Must be non-wheel to deliver messages to files./]
SKIPE DBUGSW
PSOUT
JRST NEXT1]
HRROI A,FILNAM ;COMPOSE FILE NAME
ILDB C,B ;IF NO DIRECTORY, PUT IT IN
CAIE C,"<"
JRST [ HRRZ B,INJFN
MOVE C,[1B5+1B35]
JFNS
JRST .+1 ]
MOVE B,[POINT 7,STRING,6] ;SKIP FILCHR
SETZ C,
SOUT
MOVE A,[1B2+1B17]
JRST LOCJFN
LOCUSR: MOVSI A,(RC%EMO) ;REFUSE SEND TO SYSTEM
HRROI B,STRING
SETZM RUSER
RCDIR
ERJMP LOCUS2 ;SYNTAX ERROR
TXNE A,<RC%NOM!RC%AMB> ;NO MATCH OR AMBIGIOUS
JRST LOCUS2 ;YES DONT SAVE DIRECTORY NUMBER
MOVEM C,RUSER
CAMN C,SYSDNM
JRST [ HRROI A,[ASCIZ / - won't send to SYSTEM/]
JRST UNDLV ]
LOCUS2: SKIPN ALLNET ;Supposed to do local mail via net?
JRST LOCUS4 ;No. Do directly.
TRNE F,DONAKF ;Also do NAKs directly.
JRST LOCUS4
TRZN F,FRSTRY ;First try?
JRST LOCUS4 ;No. Already tried net. Do directly.
HRROI A,LHSTNM ;Go via net. Set host name to local host
MOVEM A,HOST
PUSHJ P,FWDQ ;SEE IF LOCAL USER IS REALLY ELSEWHERE
JRST REMOTE ;NOT IN DATABASE. TRY NET.
JRST REMOTE ;FORWARDER FAILED. TRY NET, LET IT FWD
; IF NECESSARY
JRST REMOTE ;DATABASE AGREES IT'S AT THIS SITE.
HRROI A,FWDHST ;IT'S SOMEWHERE ELSE. UPDATE SITE
MOVEM A,HOST ; ..
MOVSI A,FWDNAM ;AND NAME OF MAILBOX AT FWDED SITE
HRRI A,STRING ; TO NAME USER BY "MAIL XXX" CMD
BLT A,STRING+7 ; ..
JRST REMOTE
LOCUS4: MOVE A,[POINT 7,FILNAM]
HRROI B,[ASCIZ /PS:</]
SETZ C,
SOUT
HRROI B,STRING
SETZ C,
SOUT
HRROI B,[ASCIZ />MAIL.TXT.1/]
SOUT
MOVSI A,(1B0+1B2+1B8+1B17)
LOCJFN: HRROI B,FILNAM
GTJFN
LOCJFX: JRST [ TRNE F,FILEF ;TO FILE, OR USER?
JRST NLFILE ;TO FILE WHICH ISN'T THERE.
CAIE A,GJFX35 ;TO USER. ACCESS PROBLEM?
JRST NLMFIL ;TO USER AND NO ACCESS PROBLEM
JRST NEXT] ;TO USER AND ACCESS PROBLEM
MOVEM A,LSJFN
TRNE F,FILEF ;To user?
JRST LOCJF2 ;No, to file, OK.
MOVE B,[XWD 1,1] ;To user. User mailboxes must be
MOVEI C,C ; permanent files.
GTFDB
TDNE C,[1B1]
JRST LOCJF2 ;Permanent, OK
CLOSE(LSJFN) ;To user, not permanent.
MOVEI A,GJFX24 ;Pretend didn't find file.
JRST LOCJFX
LOCJF2: MOVE B,[7B5+1B22]
OPENF
JRST [ PUSH P,A
CLOSE(LSJFN)
POP P,A
CAIE A,OPNX6 ;ACCESS PROBLEM?
CAIN A,OPNX23
TRNN F,FILEF ;ACCESS PROBLEM. TO FILE, OR USER?
JRST NEXT ;TO USER OR NOT ACCESS PROBLEM
HRROI A,[ASCIZ / - no access to file/]
JRST UNDLV ] ;TO FILE AND ACCESS PROBLEM
MOVE A,LSJFN
MOVE B,FILLEN
MOVEM B,NCHARS
PUSHJ P,HEADER
SLP1: SKIPG C,FILLEN ;NUMBER OF BYTES LEFT
JRST ESLP1 ;NO BYTES LEFT
CAILE C,MESSIZ ;CAN IT FIT IN STRING AREA?
MOVEI C,MESSIZ ;NO, ONLY FILL UP STRING AREA
MOVNS C ;NEG OF # OF BYTES
ADDM C,FILLEN ;UPDATE # OF BYTES LEFT IN FILE
ERRSET(DEL1) ;GO TO DEL1 IF DATA ERR ON INPUT
HRRZ A,INJFN ;READ IN BYTES
HRROI B,MESSAG
PUSH P,C
SIN
POP P,C
ERRSET(FAIL) ;GO TO FAIL IF DATA ERR ON OUTPUT
MOVE A,LSJFN ;WRITE OUT BYTES
HRROI B,MESSAG
SOUT
JRST SLP1
ESLP1: CLOSE(LSJFN)
ERRSET(ICRASH)
HRROI A,[ASCIZ /, sent ok/]
SKIPE DBUGSW
PSOUT
SETZM HSTNUM ;LOCAL HOST
TRNN F,FILEF!DONAKF
PUSHJ P,BLOG ;BINARY LOG INFO IF NOT NAK AND NOT TO FILE
JRST DELETE
NLFILE: HRROI A,[ASCIZ / - no message file/]
JRST UNDLV
HEADER: PUSH P,B ;NUMBER OF CHARS IN MSG
SETO B,
MOVE C,[1B13] ;TIME ZONE
ODTIM
MOVEI B,","
BOUT
POP P,B
MOVEI C,12
NOUT
JFCL
MOVEI B,";" ;ADD BIT FLAGS
BOUT
SETZ B,
MOVE C,[1B2+1B3+^D12B17+^D8]
NOUT ;BASE 8, 12 COLUMNS, LEADING 0-FILLED
JFCL
HRROI B,[ASCIZ /
/]
SETZ C,
SOUT
POPJ P,
TIMOUT: HRROI A,[ASCIZ /, timed-out/]
JRST FAIL1
FAIL: MOVE A,TIMFRK
FFORK
SKIPGE ALLNET ;If just did net and local stuff being
TRNN F,NETFLG ; sent by net, may get 2nd chance.
JRST FAIL0 ;Else just fail
HRROI A,LHSTNM ;Just did net. Was host local?
CAME A,HOST
JRST FAIL0 ;No, really net, fail.
;Just did local file via net and failed.
;Since ALLNET<0, try directly
HRRZ A,INJFN ;Re-get file length
SETO B, ;And set file ptr back to start
SFPTR
JFCL
RFPTR
JFCL
MOVEM B,FILLEN
SETZ B,
SFPTR
JFCL
JRST LOCAL
FAIL0: HRROI A,[ASCIZ /, failed/]
FAIL1: SKIPE DBUGSW
PSOUT ; Footprint
JRST NEXT
;SUBROUTINE TO CHECK FORWARDING DATA BASE FOR A LOCAL USER
; NAME IN "STRING". IF SO, PUT PLACE TO FWD TO IN FWDNAM AND FWDHST.
;0 SKIP RETURN SAYS NOT IN DATABASE OR NO DATABASE EXISTS OR NO FWD PROG
;1 SKIP RETURN SAYS PROGRAM DIDN'T RUN OR CFORK FAILED
;2 SKIP RETURN SAYS IT'S IN DATABASE BUT AT THIS SITE UNDER SAME NAME
;3 SKIP RETURN SAYS IT RAN AND NEW ADDR IS SET UP
FWDQ: MOVSI A,100001 ;SEE IF MAILBOX.EXE IS AROUND
HRROI B,[ASCIZ /SYS:MAILBOX.EXE/]
GTJFN
POPJ P,0 ;NO.
PUSH P,A ;YES. SAVE JFN
MOVSI A,(1B1) ;GET A FORK TO PUT PROG IN
CFORK
JRST MFWDX2 ;CAN'T MAKE A FORK
PUSH P,A ;SAVE THE FORK HANDLE
HRL A,0(P) ;FORK
HRR A,-1(P) ;FILE
GET ;TRY TO GET PROGRAM IN
HRLZ A,0(P) ;OK, NOW WINDOW ITS 0TH PAGE
MOVE B,[400000,,FWDPAG] ;HERE
MOVSI C,140000 ;RD WRT ACCESS
PMAP
MOVE A,[440700,,FWDADR+140] ;FEED IT THE USER DESIRED
MOVE B,[440700,,STRING]
MOVEI C,^D40 ;LENGTH LIMIT
MOVEI D,0
SOUT
MOVE A,0(P) ;FORK HANDLE
MOVEI B,1 ;FLAG USER AT LOCAL SITE IS WHAT WE WANT
MOVEM B,FWDACS+1
MOVEI B,FWDACS
SFACS
MOVEI B,2 ;WHERE TO START INFERIOR
SFRKV
NLMF0: WFORK ;WAIT FOR IT TO RUN
RFSTS ;SEE IF IT FINISHED AT HALTF
HLRZ A,A ;STATE CODE
CAIE A,2 ;VOLUTARY HALT?
JRST MFWDX3 ;NO
MOVE A,0(P) ;OK, GET FORK HANDLE AGAIN
MOVEI B,FWDACS ;GET RESULT AC
RFACS
SKIPG FWDACS+1 ;SUCCESS?
JRST MFWDX3 ;NO.
MOVSI A,FWDADR+140 ;YES. COPY THE ANSWERS OUT OF INF FORK
HRRI A,FWDNAM ; TO STORAGE IN THIS FORK
BLT A,FWDNAM+7 ; ..
MOVSI A,FWDADR+150
HRRI A,FWDHST
BLT A,FWDHST+7
MOVE A,[440700,,LHSTNM] ;NOW MAKE SURE IT ISN'T JUST THE
MOVE B,[440700,,FWDHST] ;SAME PLACE WE ALREADY LOST ON.
MOVEI C,50 ;NAMELY, SAME NAME, THIS SITE.
MLFWQ2: ILDB T1,A ;CHECK SITE
ILDB T2,B
CAME T1,T2
JRST FWDGUD ;OK. SITE NAME DIFFERENT. FORWARD IT
JUMPE T1,MLFWQ1 ;MATCHED THRU SITE. GO CHK NAME.
SOJG C,MLFWQ2
JRST MFWDX3 ;STRANGE, HOST NAME TOO LONG
MLFWQ1: MOVE A,[440700,,STRING] ;SEE IF A DIFFERENT USER NAME
MOVE B,[440700,,FWDNAM]
MOVEI C,50
MLFWQ4: ILDB T1,A
ILDB T2,B
CAME T1,T2
JRST FWDGUD ;GOOD. DIFFERENT NAME. USE IT.
JUMPE T1,FWDSAM ;SAME HOST AND NAME.
SOJG C,MLFWQ4
JRST MFWDX3 ;NAME TOO LONG
FWDSAM: HRROI A,LHSTNM ;SAME NAME AND HOST. SET STRING PTR
MOVEM A,HOST ;FOR LATER CHECK FOR LOCAL-NESS
PUSHJ P,FWDDSC ;DISCARD THE FORWARDER FORK.
JRST CPOPJ2 ;AND GIVE SPECIFIC RETURN FOR SAME.
MFWDX3: PUSHJ P,FWDDSC ;DISCARD THE INFERIOR FORK
JRST CPOPJ1 ;GIVE 1 SKIP = "I DUNNO"
MFWDX2: POP P,A
RLJFN
JFCL
JRST CPOPJ1 ;GIVE 1 SKIP RETURN
FWDGUD: PUSHJ P,FWDDSC ;IT'S THERE. SUCCESS. DISCARD INF FRK
CPOPJ3: AOS 0(P) ;3 SKIP RETURN
CPOPJ2: AOS 0(P) ;2 SKIP RETURN
CPOPJ1: AOS 0(P) ;1 SKIP RETURN
CPOPJ: POPJ P,0 ;RETURN
FWDDSC: POP P,C ;SAVE INNERMOST RETURN
POP P,A ;FORK
KFORK
MOVE A,0(P) ;FILE
HRLI A,(1B0)
CLOSF
JFCL
POP P,A
RLJFN
JFCL
JRST 0(C) ;RETURN FROM FWDDSC
;HERE IF THERE IS NO LOCAL MAILBOX FOR A LOCAL NAMED FILE
NLMFIL: PUSHJ P,FWDQ ;SEE IF FORWARDER KNOWS WHERE IT IS
JRST FORWRD ;NO FORWARDER PROGRAM. TRY NET ANYWAY.
JRST FRWDX6 ;FORWARDER FAILED TO COMPLETE
JRST FORWRD ;IT'S IN DATABASE AND SAME NAME, SITE.
FORWRD: MOVE A,[440700,,FILNAM] ;MAKE NAME FOR NEW FORWARDING FILE
HRRZ B,INJFN ; COPY FROM INPUT FILE
MOVE C,[010000,,1] ;DIRECTORY AND NAME
JFNS
HRROI B,[ASCIZ /[--UNSENT-MAIL--]./]
MOVEI C,0
SOUT
HRROI B,FWDNAM ;FORWARDING NAME
SOUT
MOVEI B,"V"&37 ;QUOTE
BOUT
MOVEI B,"@" ;ATSIGN BETWEEN NAME AND HOST
BOUT
HRROI B,FWDHST ;FOREIGN HOST
SOUT
HRRZ B,INJFN ;AND TACK ON PROT AND ACCT
MOVE C,[1,,100001]
JFNS ;FROM INPUT FILE
HRROI B,FILNAM
MOVSI A,400001 ;OUTPUT FILE FOR NEW NAME
GTJFN
JRST FRWDX1
MOVEM A,NEWJFN
HRRZ A,INJFN
HRLI A,(1B0)
CLOSF ;CLOSE INPUT FILE BUT KEEP JFN
JRST FRWDX2
MOVE A,[440700,,FILNAM] ;AND GET ANOTHER JFN FOR IT,
HRRZ B,INJFN ;NON-INDEXABLE
MOVE C,[011110,,1]
JFNS
MOVSI A,100001
HRROI B,FILNAM
GTJFN
JRST FRWDX3
MOVEM A,OLDJFN
MOVE B,NEWJFN
RNAMF
JRST FRWDX4
SKIPN DBUGSW ;WANT TRACKS TYPED?
JRST FRWD3 ;NO
PUSH P,B ;YES. SAVE NAME
HRROI A,[ASCIZ /, forwarding to /]
PSOUT
MOVEI A,101
HRRZ B,0(P)
MOVSI C,100
JFNS
POP P,B
FRWD3: MOVE A,B
RLJFN
JFCL
JRST NEXT
FRWDX1: FRWDX2: FRWDX3:
JSP A,FRWDXX
ASCIZ / - no message file, can't create new forwarding file/
FRWDX4: JSP A,FRWDXX
ASCIZ / - no message file, can't rename to new forwarding file/
FRWDX6: HRROI A,[ASCIZ /, can't create forwarding fork/]
SKIPE DBUGSW
PSOUT
JRST FAIL ;RE-QUEUE IT
FRWDXX: HRLI A,440700
JRST UNDLV
WAIT: SETOM INJFN ; FOR CONSISTENCY. CLOSED AFTER GNJFN
CLOSE(MYRJFN) ;CLOSE TELNET CONN TO SELF
CLOSE(MYSJFN)
HRROI A,[ASCIZ /
Waiting.../]
SKIPE DBUGSW
PSOUT ; Footprint
MOVE A,INTRVL
DISMS ; Wait that long
JRST TOP ; Then try again
; Close a file
CLOSIT: PUSH P,B
PUSH P,A
SKIPG A,@0(P)
JRST CLOSID
SETOM CLOSCT ;USED TO COUNT CLOSF FAILURES
CLOSI2: GTSTS ;IF FILE HAS DATA ERROR,
TLZE B,(1B9) ; MUST RESET STATUS ELSE
STSTS ; WON'T BE ABLE CLOSE
MOVE A,@0(P)
CLOSF
JRST CLOSER ; CHECK ON ERROR IN CLOSF
CLOSI3: RLJFN ; And release
JFCL
CLOSID: SETOM @0(P)
POP P,A
POP P,B
POPJ P,
;HERE ON ERROR IN CLOSF FROM ABOVE
CLOSER: MOVE B,A ;SAVE THE ERROR CODE
MOVE A,@0(P) ;GET BACK JFN
CAIN B,CLSX1 ;FILE NOT OPEN?
JRST CLOSI3 ;YES, JUST RELEASE JFN
PUSH P,C ;SAVE AC 3
DVCHR ;GET DEVICE CHARACTERISTICS
POP P,C ;RESTORE 3
MOVE A,@0(P) ;RESTORE JFN
TLC B,16 ;NETWORK?
TLNE B,77
JRST CLOSI3 ;NO
AOSN CLOSCT ;YES, FIRST ATTEMPT TO CLOSE?
JRST CLOSI2 ;YES, TRY AGAIN
;CAN'T CLOSE NETWORK FILE, REPORT TO ERRTTY
PUSH P,C ;SAVE AC3 AGAIN
HRROI A,[ASCIZ /
***** MAILER FAILED TO CLOSE NETWORK FILE /]
PSOUT
MOVEI A,101
MOVE B,@-1(P) ;THE JFN
SETZ C,
JFNS
HRROI A,[ASCIZ /
DUE TO THE FOLLOWING ERROR: /]
PSOUT
MOVEI A,101
HRLOI B,400000
SETZ C,
ERSTR
JFCL
JFCL
HRROI A,[ASCIZ /*****
/]
PSOUT
POP P,C
JRST CLOSID
; SEND STRING AND WAIT OK
SWTOK: MOVE A,SJFN
SETZ C,
SOUT
MOVEI B,21
MTOPR
JRST WAITOK
; Wait for response
WAITOK: MOVE A,RJFN
TRZ F,NUMF ; Flag no input yet
SETZ C,
NINLP: BIN ; Private nin
EXCH A,B
SKIPE DBUGS2 ;SEE DIALOGUE?
PBOUT ;YES
EXCH A,B
CAIL B,200 ; 'cause we have to flush
JRST NINLP ; These creatures
CAIG B,"9"
CAIGE B,"0"
JRST NINDUN ; Done on non digit
TRO F,NUMF ; Signal digit seen
IMULI C,^D10
ADDI C,-"0"(B)
JRST NINLP
NINDUN: SKIPA D,[POINT 7,REPLY]
NINDU1: BIN ; Skip to end of line
JUMPE B,[HRROI B,[ASCIZ / NET CONNECTION CLOSED
/]
MOVEI C,0
MOVE A,D
SOUT
MOVEI A,400000
MOVSI B,(1B11)
IIC ;INTERRUPT ON CHANNEL 11
HALTF ]
IDPB B,D
EXCH A,B
SKIPE DBUGS2 ;SEE DIALOGUE?
PBOUT
EXCH A,B
CAIE B,12
JRST NINDU1 ; No end of line yet
REPEAT 0,<
TRNN F,NUMF
JRST WAITOK
>
SETZ B,
IDPB B,D
CAIL C,^D400 ; Below negative response range
CAIL C,^D600 ; Or above it?
AOS 0(P) ; Yes, not a bad response...skip
POPJ P,
;BINARY LOG STUFF
;OPEN AND MAP THE FILE
OPNBLG: SKIPN BLOGSW ;IF NOT LOGGING, JUST RETURN
POPJ P,
ERRSET(BLGERR) ;HANDLE I/O ERROR ON LOG FILE
SETO B, ;CALCULATE VERSION NUMBER BASED ON
MOVSI D,(1B0+1B2+0B17) ; GMT DATE (MMYY)
ODCNV
SKIPG BLGJFN ;HAVE LOG FILE ALREADY?
JRST OPNBL2 ;NO, OPEN ONE
CAMN B,BLGDAT ;YES, IS IT CURRENT?
JRST OPNBL4 ;YES, CURRENT, ALL DONE
PUSH P,B ;NOT CURRENT - SAVE DATE
SETO A, ;UNMAP LOG PAGES
MOVE B,[400000,,LPGMS]
PMAP
HRRI B,LPGCS
PMAP
HRRI B,LPGUSR
PMAP
HRRI B,LPGMST
PMAP
HRRI B,LPGCST
PMAP
CLOSE (BLGJFN) ;CLOSE OLD LOG FILE
POP P,B ;RESTORE DATE
OPNBL2: MOVEM B,BLGDAT ;SAVE DATE
HRRZ A,B ;MONTH
AOS A
IMULI A,^D100
HLRZ B,B ;YEAR
IDIVI B,^D100
ADD A,C ;VERSION NUMBER
TDO A,[1B17] ;SHORT FORM GTJFN
HRROI B,[ASCIZ /PS:<SYSTEM>MAIL.BLOG/]
GTJFN
JRST BLGERR
MOVEM A,BLGJFN ;SAVE JFN IN CASE ERROR
MOVE B,[1B19+1B20+1B25] ;READ, WRITE, THAWED
OPENF
JRST BLGERR
HRLZS A ;MAP PAGE 0 OF FILE
MOVE B,[400000,,LPGMS]
MOVSI C,140000
PMAP
HRRI A,2 ;MAP PAGE 2 OF FILE
HRRI B,LPGCS
PMAP
HRRI A,4 ;MAP PAGE 4 OF FILE
HRRI B,LPGUSR
PMAP
HRRI A,5
HRRI B,LPGMST
PMAP
HRRI A,6
HRRI B,LPGCST
PMAP
MOVE A,LPGMS*1000 ;REFERENCE EACH PAGE TO FORCE
MOVE A,LPGCS*1000 ; TRANSFER FROM DISK, HENCE I/O
MOVE A,LPGUSR*1000 ; ERRORS IF ANY
MOVE A,LPGMST*1000
MOVE A,LPGCST*1000
OPNBL4: ERRSET(ICRASH)
POPJ P,
;HERE FOR GTJFN OR OPENF FAILURE ON BINARY LOG OR I/O ERROR ON IT
BLGERR: ERRSET(ICRASH)
SETZM BLOGSW ;DON'T LOG
CLOSE(BLGJFN) ;CLOSE/RELEASE JFN
HRROI A,[ASCIZ /
***** MAILER CANNOT DO BINARY LOGGING ON PS:<SYSTEM>MAIL.BLOG
BECAUSE: /]
PSOUT
MOVEI A,101
HRLOI B,400000 ;MOST RECENT ERROR
SETZ C,
ERSTR
JFCL
JFCL
POPJ P,
;RECORD INFO ON MESSAGE JUST SENT IN BINARY LOG
BLOG: SKIPN BLOGSW ;IF NOT LOGGING, JUST RETURN
POPJ P,
MOVE A,HSTNUM ;HOST SENT TO
MOVE B,NCHARS ;NUMBER OF CHARS SENT
AOS LPGMS*1000(A) ;INCREMENT # MSGS TO THAT HOST
ADDM B,LPGCS*1000(A) ;ADD TO # CHARS TO THAT HOST
JUMPN A,BLOG2 ;SKIP IF NON-LOCAL
MOVE A,RUSER ;LOCAL - SET BIT FOR RECIPIENT
PUSHJ P,BITWRD ;CALCULATE WHICH WORD AND BIT
IORM C,LPGUSR*1000+200(A) ;SET BIT
BLOG2: MOVE A,XUSER ;SET BIT FOR SENDER
PUSHJ P,BITWRD
IORM C,LPGUSR*1000(A)
SETO B, ;GET DAY AND TIME FROM 00:00
MOVSI D,(1B0+1B2+0B17)
ODCNV
MOVE A,C ;SAVE DAY OF WEEK IN RH
HRL A,D ;AND TIME SINCE 00:00 IN LH
MOVEM A,MLTIMT
HLRZ A,A
IDIVI A,^D<60*30>
HRRZ D,MLTIMT
IMULI D,^D48
ADD D,A
MOVE A,NCHARS
ADDM A,LPGCST*1000(D)
AOS A,LPGMST*1000(D)
MOVEI A,400000
RUNTM
SUB A,IFRKTM
ADDM A,<LPGMST*1000 + 777>
MOVEM A,IFRKTM
POPJ P,
INTRVL: ^D<IINTVL*60000> ; Interval of operation
MAXQUE: 5,,0 ; Undeliverable after 5 days
STIMER: ^D<5*60000> ; SHORT TIME-OUT TIME
LTIMER: ^D<60*60000> ;LONG TIME-OUT TIME
LSTUSR: 2000
USEROK: ^D350 ; Response if mail is allowed
NEDLOG: ^D504
NEDPAS: ^D330
LOGOK: ^D230
MAILOK: ^D256 ; Response if mail is accepted
GENDLV: ^D950 ;GENERAL DELIVERY
FWDDLV: ^D951 ;MAIL WILL BE FORWARDED
FTPSKT: 3 ; Ftp socket number
MAXLOD: 2.0
FULINT: ^D<6*60*60*1000> ;INTERVAL BETWEEN ATTEMPTS AT FULL SCAN
MAXINT: ^D<24*60*60*1000> ;MAXIMUM INTERVAL BETWEEN FULL SCANS
QCODES: ^D401 ;FT ERR CODES IMPLYING QUEUEING
^D436
^D452
^D453
^D454
^D434
MNQCOD: -6 ;NEW OF NUMBER OF QCODES
; INTERRUPT STUFF
LEVTAB: RETPC1
RETPC2
RETPC3
CHNTAB: 3,,TIMINT
REPEAT 8,<0>
XWD 1,CRASH
0
XWD 2,IOERR
REPEAT 3,<0>
XWD 1,CRASH
REPEAT ^D19,<0>
ICRASH: HRROI A,[ASCIZ %
***** MAILER I/O ERROR AT %]
PSOUT
HRRZ B,IOERPC
JRST CRASH2
CRASH: HRROI A,[ASCIZ /
***** MAILER CRASHED AT /]
PSOUT
HRRZ B,RETPC1
CRASH2: MOVEI A,101
MOVEI C,10
NOUT
JFCL
CRASH3: HRROI A,[ASCIZ /...RESTART
/]
CRASH4: SKIPE NOHOST
PSOUT
AOS NOHOST
MOVE A,[^D300000]
DISMS
JRST START
IOERR: MOVE P,RETPC2 ;REMEMBER RETURN ADDRESS
MOVEM P,IOERPC
MOVE P,FILERR
HRLI P,10000
MOVEM P,RETPC2
MOVEI P,ICRASH
MOVEM P,FILERR
MOVE P,FILERP
DEBRK
TIMINT: MOVE P,TIMERP
MOVE A,[10000,,TIMOUT]
MOVEM A,RETPC3
DEBRK
TIMER: MOVE A,TIMERT
DISMS
MOVEI A,777777
MOVSI B,(1B0)
IIC
HALTF
LIT
;LOC <.+777>/1000*1000 ;START DATA ON NEXT PAGE
ALLNET: -1 ;Non-zero to send even local mail over net.
; If <0, will do local directly if fails over net.
; If >0, won't do local directly - requeue if net fail
BLOGSW: 1 ;NON-ZERO FOR WHEEL MAILER TO KEEP BINARY LOG
DBUGSW: 0 ; Non-zero for debugging
DBUGS2: 0 ; NON-ZERO TO SEE NET DIALOGUE ON TTY
DBUGS3: 0 ;NON-ZERO TO SEE MESSAGE WHILE SENT OVER NET
PAT:
PATCH: BLOCK 400
; Variables
NETOK: BLOCK 1 ; Flag whether local net conns reusable
BLGDAT: BLOCK 1 ;MONTH,,YEAR BINARY LOG OPENED
SYSDNM: BLOCK 1 ;DIRECTORY NUMBER OF PS:<SYSTEM>
TIMERT: BLOCK 1 ;TIMER INTERVAL
RETPC1: BLOCK 1
RETPC2: BLOCK 1
RETPC3: BLOCK 1
IOERPC: BLOCK 1 ;RETURN PC FROM LAST I/O ERROR INTERRUPT
FILLEN: BLOCK 1
IFRKTM: BLOCK 1 ;#STARTING RUN TIME
MLTIMT: BLOCK 1 ; SAVE DATE-TIME
NCHARS: BLOCK 1 ;# CHARS IN MSG
XUSER: BLOCK 1 ;USER SENDING MAIL
RUSER: BLOCK 1 ;USER RECEIVING (LOCAL) MAIL
XUSNAM: BLOCK 10 ;name of XUSER
WHEELF: BLOCK 1
NOHOST: BLOCK 1
NXTFUL: BLOCK 1 ;NEXT TIME TO TRY FULL SCAN
MAXFUL: BLOCK 1 ;MAX TIME TO TRY FULL SCAN
TIMERP: BLOCK 1
FILERR: BLOCK 1
FILERP: BLOCK 1
TIMFRK: BLOCK 1
LHOSTN: BLOCK 1 ;LOCAL HOST NUMBER
LHSTNM: BLOCK 10 ;LOCAL HOST NAME
FWDACS: BLOCK 20 ;AC STORAGE FOR MAILBOX.SAV INF FORK
FWDNAM: BLOCK 10 ;NAME FORWARDER GAVE BACK
FWDHST: BLOCK 10 ;HOST NAME FORWARDER GAVE BACK
FWDCNT: BLOCK 1 ;COUNTER IN CASE FORWARDING LOOPS
HSTNUM: BLOCK 1 ;FOREIGN HOST NUMBER
HOST: BLOCK 1 ; String pointer to foreign host
INJFN: BLOCK 1 ; Jfn of mail files designator
IJFN: BLOCK 1 ; Icp jfn
RJFN: BLOCK 1 ; Send jfn
SJFN: BLOCK 1 ; Receive jfn
MYRJFN: BLOCK 1 ;SEND JFN TO SELF
MYSJFN: BLOCK 1 ;RECEIVE JFN TO SELF
NEWJFN: BLOCK 1 ;JFN FOR NEW FILE NAME FOR RENAME
OLDJFN: BLOCK 1 ;JFN FOR OLD FILE NAME FOR RENAME
BLGJFN: BLOCK 1 ;BINARY LOG JFN
LSJFN: BLOCK 1 ;JFN FOR LOCAL SEND
FSKT: BLOCK 1 ; Foreign socket to use for send/recv
CLOSCT: BLOCK 1 ;USED TO COUNT CLOSF FAILURES
REPLY: BLOCK 100
FILNAM: BLOCK 100 ; Used to compose file name strings
PDL: BLOCK LPDL ; Stack
STRING: BLOCK 20 ;For address strings
MESSAG: BLOCK MESSIZ/5 ;For message buffer and NAK composition
END <3,,ENTVEC>