Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

; UPD ID= 4, SNARK:<5.ARPA-UTILITIES>NMAILR.MAC.7,   6-Dec-81 22:28:44 by PAETZOLD
;fix yet another large host number bug
;update version and copyright information
; UPD ID= 1547, SNARK:<5.ARPA-UTILITIES>NMAILR.MAC.6,  10-Feb-81 16:38:45 by LYONS
; FIX MORE LARGE HOST NUMBER BUGS
; UPD ID= 1546, SNARK:<5.ARPA-UTILITIES>NMAILR.MAC.5,  10-Feb-81 16:30:53 by LYONS
;fix long leader /large host number bugs
; UPD ID= 1142, SNARK:<5.ARPA-UTILITIES>NMAILR.MAC.4,   8-Oct-80 14:35:32 by LYONS
;allow nmailr to turn its privs on, even thou it does not need them
;<4.ARPA-UTILITIES>NMAILR.MAC.4, 11-Oct-79 11:40:25, Edit by LCAMPBELL
; Update version and edit numbers for release 4

;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, 1981 BY DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.


	TITLE NMAILR
	SUBTTL R.S.TOMLINSON
	SEARCH MONSYM,MACSYM

VWHO==0			;LAST EDITED BY DEC
VMAJOR==5		;MAJOR VERSION #
VMINOR==0		;REVISION #
VEDIT==^D27		;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,.FHSLF		;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,.FHSLF	; 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,.FHSLF
	RPCAP			; READ CAPABILITIES
	TRNN C,SC%WHL!SC%OPR	; ENABLED WHEEL OR OPERATOR?
	TDZA A,A		; NO
	SETO A,
	MOVEM A,WHEELF
	ORCAM A,DBUGSW
	MOVE C,B		; TURN ON ALL OUR PRIVS WE CAN
	MOVEI A,.FHSLF
	EPCAP			;DO IT
	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,.FHSLF
	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,[.FHSLF,,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
	MOVEI A,.GTHSZ		; HOST NUMBER FUNCTION OF GTHST
	GTHST			; GET OUR HOST NUMBER
	 ERJMP [ HRROI A,[ASCIZ /
***** MAILER CANNOT GET LOCAL HOST NUMBER FROM SYSTEM.
/]
		 JRST CRASH4]
	MOVEM D,LHOSTN		; SAVE THE HOST NUMBER
	MOVE C,D
	MOVEI A,.GTHNS		; GET HOST NUMBER
	HRROI B,LHSTNM		; PUT IT HERE
	GTHST
	  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,.FHSLF		;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:
	MOVEI A,.GTHSZ		;HOST NUMBER FUNCTION
	GTHST
	ERJMP [	SETZ D,
		JRST .+1]
	MOVEM D,LHOSTN		;SAVE LOCAL HOST NUMBER
	MOVE C,LHOSTN
	HRROI B,LHSTNM
	MOVEI A,.GTHNS
	GTHST
	 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>