Google
 

Trailing-Edge - PDP-10 Archives - integ_tools_tops20_v7_30-apr-86_dumper - tools/vmail/vmailr.mac
There are 5 other files named vmailr.mac in the archive. Click here to see a list.
; MRFORT::MSC:<BUDNE>VMAILR.MAC.25 31-Oct-83 LQ+3D.9H.47M.35S., by BUDNE
; Make GETTOK handle embedded quotes. Add WARN MACRO.
; Add many ENDAV.'s and ENDAV.'s [342] = 226.
;<STEVENS.VMAILR>VMAILR.MAC.94 29-Jun-82 10:04:00, Edit by STEVENS
; Remove limit on TO field sent to VAX.  Handled by limiting the
; size for the TO field string.
;<STEVENS.VMAILR>VMAILR.MAC.93 29-Jun-82 08:54:00, Edit by STEVENS
; Limit TO field sent to VAX to 128 characters.
; Limit storage into TOOBUF in routine GETOCC to prevent TOOBUF
; overflow.  Reduced size of TOOBUF from 1000 to 35.
;<STEVENS.VMAILR>VMAILR.MAC.92 19-Jun-82 21:04:00, Edit by STEVENS
; Modified NOTIFY to put message into PS:<SPOOL> for DMAILR to process.
;<STEVENS.VMAILR>VMAILR.MAC.91 19-Jun-82 20:06:00, Edit by STEVENS
; Changed JRST at end of SNDVR1 from SNDVER to SNDVR1.
;<STEVENS.VMAILR>VMAILR.MAC.90 19-Jun-82 19:58:00, Edit by STEVENS
; Fixed message when error occured in parsing CC field.
; Changed ERRPTR in SNDFIL routine to an AC variable so subroutine
;  SNDVR1 could access it.
; Merged routine BLDMSG into NOTIFY routine and changed TRVAR to
;  a STKVAR call to that previous TRVAR variables don't get lost.
;<STEVENS.VMAILR>VMAILR.MAC.89 27-May-82 16:15:00, Edit by STEVENS
; Overflowed halfword so created INTVL1 and compared to it in
; routine HICCUP
;<STEVENS.VMAILR>VMAILR.MAC.88 27-May-82 15:56:00, Edit by STEVENS
; Fixed forced sleep time by putting the ^D's that were needed.
;<STEVENS.VMAILR>VMAILR.MAC.87 26-May-82 22:39:00, Edit by STEVENS
; Changed name of privledged job from SDMALR to SVMALR to prevent
; confusion between the twenty mailer and the vaxen.
;<STEVENS.VMAILR>VMAILR.MAC.86 26-May-82 21:45:00, Edit by STEVENS
; Added code in routine HICCUP to limit how often the mailer can
; be awaken as a result of a network topology change.  Current
; setting is 10 seconds since last run.
;<STEVENS.VMAILR>VMAILR.MAC.85 25-May-82 20:37:00, Edit by STEVENS
; Cleared T3 and T4 before doing SOUT near GTOCC1.
;<STEVENS.VMAILR>VMAILR.MAC.84 25-May-82 20:16:00, Edit by STEVENS
; Added space before personal name field in GETFRM routine.
; Added code to gobble closing ">" for personal name in TO field
; in GETOCC routine.
;<STEVENS.VMAILR>VMAILR.MAC.83 19-May-82 22:16:00, Edit by STEVENS
; Added code at SNDVX6 to find body of message by looking for
; the blank line that terminates the header.
;<STEVENS.VMAILR>VMAILR.MAC.82 19-May-82 21:53:00, Edit by STEVENS
; Removed all to SKPLIN at end of GETNAM.
;<STEVENS.VMAILR>VMAILR.MAC.81 19-May-82 21:42:00, Edit by STEVENS
; Fixed error in outputing username in routine GETFRM.
;<STEVENS.VMAILR>VMAILR.MAC.80 19-May-82 21:38:00, Edit by STEVENS
; Added routine (GETNAM) to get username, host, personal name from
; mail file.  Modified GETFRM and GETOCC to use the routine
; created.
;<STEVENS.VMAILR>VMAILR.MAC.79 19-Apr-82 21:46:00, Edit by STEVENS
; Fixed close quote of personal name in GETFRM routine.
;<STEVENS.VMAILR>VMAILR.MAC.78 19-Apr-82 21:26:00, Edit by STEVENS
; Output personal name in GETFRM before finding host name.
;<STEVENS.VMAILR>VMAILR.MAC.77 19-Apr-82 21:06:00, Edit by STEVENS
; Create AC variable in GETFRM to store personal name pointer.
;<STEVENS.VMAILR>VMAILR.MAC.76 19-Apr-82 20:54:00, Edit by STEVENS
; 1 Modified GTALPH to allow underscore in name.
; 2 Decreased max characters in SNDVX5 to field in hopes of solving
;   missing to field.
; 3 Changed "RET" to "RETSKP" in SNDFIL to get blank lines out of log
;   file.
; 4 Modified GETFRM to include personal name a-la RSTS.
;<STEVENS.VMAILR>VMAILR.MAC.75 15-Jan-82 13:46:00, Edit by STEVENS
; Removed changes made to FIXHST in last edit and added code in
; SNDVAX routine to put the current node name in HSTBUF if node
; message is from is not the current node.
;<STEVENS.VMAILR>VMAILR.MAC.74 11-Jan-82 10:35:00, Edit by STEVENS
; Fixed routing string by adding code to FIXHST routine to put the
; current node into the routing string if message is not from the
; current host.  Also added null terminator to text lines in CPYLIN
; routine.
;<STEVENS.VMAILR>VMAILR.MAC.73 17-Dec-81 09:24:00, Edit by STEVENS
; Repaired bug in SNDVAX routine for when mail is not from the node
; that is attempting mail transmission.  SIN call after STCMP of
; node name not properly setup.
;<STEVENS.VMAILR>VMAILR.MAC.72 16-Dec-81 17:27:00, Edit by STEVENS
; Added null sting terminator to node name string in GRTNOD routine
;<STEVENS.VMAILR>VMAILR.MAC.71 16-Dec-81 12:46:00, Edit by STEVENS
; Comented out skipl in SCANEM missed when moby scan turned off
;<STEVENS.VMAILR>VMAILR.MAC.70 10-Dec-81 09:37:00, Edit by STEVENS
; Setup default node routed to in SNDVAX before calling FIXHST
; in case node is an immediate neighbor.
;<STEVENS.VMAILR>VMAILR.MAC.69 09-Dec-81 13:30:00, Edit by STEVENS
; Limit length of TO field to 255 characters in SNDVAX routine
;<STEVENS.VMAILR>VMAILR.MAC.68 09-Dec-81 10:50:00, Edit by STEVENS
; Renamed TEMP2 to RTENAM (Name of host routed to)
; Added code in SNDVAX routine to send node name when addressing
; a remote node.  This happens when the host we want to go to is
; not the host we got to.  This is required in order to use the
; EMS gateaway at TELC.
;<STEVENS.VMAILR>VMAILR.MAC.67 24-Nov-81 10:28:00, Edit by STEVENS
; Corrected minor bug in GETFRM routine
;<STEVENS.VMAILR>VMAILR.MAC.66 24-Nov-81 08:31:00, Edit by STEVENS
; Corrected problem in skiping over personal name
;<STEVENS.VMAILR>VMAILR.MAC.65 23-Nov-81 10:10:00, Edit by STEVENS
; Ignore personal name in from field
; Scan to find subject field
;<STEVENS.VMAILR>VMAILR.MAC.64 20-Nov-81 09:29:00, Edit by STEVENS
; Cleaned up notification routine some more
;<STEVENS.VMAILR>VMAILR.MAC.63 20-Nov-81 08:58:00, Edit by STEVENS
; REPAIRED BUG IN NOTIFICATION OF FAILURE
;<STEVENS.VMAILR>VMAILR.MAC.62 20-Nov-81 08:40:00, Edit by STEVENS
; Disable Moby scan and clearing of decnet-flag bits
; This is to prevent conflict with DMAILR
;<LCAMPBELL.DECNET>DMAILR.MAC.190 26-May-81 18:00:00, Edit by LCAMPBELL
; Do physical-only open for SYSTEM:DECNET-MAILER.FLAGS
;<LCAMPBELL.DECNET>DMAILR.MAC.189 19-May-81 12:52:16, Edit by LCAMPBELL
;<LCAMPBELL.DECNET>DMAILR.MAC.188 19-May-81 12:49:07, Edit by LCAMPBELL
; Rip pass-through code out and put it in a separate module

	TITLE VMAILR - DECNET Mail User Process

	SUBTTL Larry Campbell

	SEARCH MACSYM,MONSYM,DNCUNV
	SALL
	NOSYM
	.DIRECTIVE FLBLST
	.REQUIRE SYS:MACREL,VNCONN
	EXTERNAL .DNINI,.DNCON		; Entry points in DNCONN

T1=1
T2=2
T3=3
T4=4
P1=5
P2=6
P3=7
P4=10
F=11
PTR=13				; global byte pointer to received mail
CNT=14				; global byte count for same
CX=16
P=17

.VER==5
.EDT==342			;226 DECIMAL

	LOC 137
	EXP <.VER>B11+.EDT
	RELOC
;MACROS

Define Clrbuf(Bufnam,Buflen),<
	Setzm Bufnam
	Move  T1,[Bufnam,,Bufnam+1]
	Blt   T1,Bufnam+Buflen-1
>

Define Nrecord(Buffer),<
	Move  T1,Njfn
	Hrroi T2,Buffer
	Movni T3,4
	Setz  T4,
	Sinr
	 Erjmp Fatal
>

Define Nsuccess,<
	Move  T1,Njfn
	Hrroi T2,[0]
	Movei T3,1
	Setz  T4,
	Soutr
>

Define Nsend(Record),<
	Move  T1,Njfn
	Hrroi T2,Record
	Setzb T3,T4
	Soutr
	 Erjmp Fatal
>

Define Find(String),<		;; Search for the given string
	Xlist
	Move T1,[Point 7,[Asciz/String/]]
	Call Findit		;; Call string compare routine
	List
>

DEFINE TMSG(STRING),<
	XLIST
	MOVE T1,LOGJFN
	HRROI T2,[ASCIZ \STRING\]
	SETZB T3,T4
	SOUT
	 ERJMP [HRROI T1,[ASCIZ \
?TMSG failure\]
		PSOUT
		HALTF]
	LIST
>

DEFINE YECCH(STRING),<
	XLIST
	ERJMP [	TCRLF
		TXNE F,F%WEEL
		CALL DTSTMP
		TMSG <?VMAILR: >
		MOVE T1,LOGJFN
		HRROI T2,[ASCIZ \STRING\]
		SETZB T3,T4
		SOUT
		TMSG < because: >
		MOVE  T1,LOGJFN
		HRLOI T2,.FHSLF
		SETZ  T3,
		ERSTR
		 JFCL
		 JFCL
		MOVE  T1,LOGJFN		;; insure log file gets written
		CLOSF			;;  ..
		 JFCL
		TXNN  F,F%WEEL		;;if SYSJOB, never stop
		HALTF
		JSP   CX,BEGIN ]
	LIST
>
DEFINE BLECH(STRING),<
	XLIST
	JRST [	TMSG <?VMAILR: Fatal internal error: >
		MOVE T1,LOGJFN
		HRROI T2,[ASCIZ \STRING\]
		SETZB T3,T4
		SOUT
		MOVE T1,LOGJFN	;;in case SOUT trashes T1 with error code
		CLOSF
		 JFCL
		TXNN F,F%WEEL	;; if SYSJOB, never stop
		HALTF
		JSP CX,BEGIN]
	LIST
>

DEFINE TCRLF,<TMSG <
>>

DEFINE HERALD(VER,EDT),<
	TMSG <VMAILR version VER(EDT) started
>>

;[342]
DEFINE WARN(MESS) <
	HRROI T2,[ASCIZ \%VMAILR: MESS\]
>
;Flag bits

F%WEEL==1B0			; WHEEL
F%RNAM==1B1			; Rename required
F%PACK==1B2			; Postive acknowledgement received
F%ERRF==1B3			; Error message received
F%STAY==1B4			; "stay lit" flag for mailer flags bit

;Parameters

SLPTIM==^D1800000		;milliseconds to sleep between scans
MAXDIR==4000			;maximum number of dirs scannable
PDLLEN==200			;length of stack
FLGPAG==600			;page into which we map DECNET-MAILER.FLAGS
FLGADR==FLGPAG*1000		;address of DECNET-MAILER.FLAGS
NERMSG==50			;no. of words for error msg from 4n host
XSAGE==7,,0			;excessive age for queued mail (one week)
MOBYN==1,,0			;how often to do moby scans (once per day)
STRN==40000			;words of string space
HOSTNN==^D39			;maximum chars in hostname

;Storage

STACK:	BLOCK PDLLEN
LOGJFN:	BLOCK 1			;JFN on which to type most things
NODNAM:	BLOCK 5			;our node name
FLGJFN:	BLOCK 1			;JFN of PS:<SYSTEM>DECNET-MAILER.FLAGS
ERRMSG:	BLOCK NERMSG		;last fatal error message from other host
DIRS:	BLOCK MAXDIR		;list of directories to scan
LINBUF:	BLOCK ^D100		;line buffer for stuff from mail file
DEDHST:	BLOCK 100		;list of hosts known to be inaccessible or down
STRSP0:	BLOCK 1			;pointer to dead host name string space
STRSPC:	BLOCK STRN		;dead host name string space
MOBY:	BLOCK 1			;-1 => time for moby scan (ALL directories)

;STORAGE FOR VAX MESSAGE CHANGES

NJFN:	BLOCK 1			;Network JFN
MJFN:	BLOCK 1			;Mail file JFN
HOSTBA:	BLOCK 1			;Address of host TBLUK table
AROUTE:	BLOCK 1			;Pointer to routing string being used
BLNKBF:	ASCIZ / /		;Blank string for null records
BYTCNT:	BLOCK 1			;Lenght of message
TOOPTR:	BLOCK 1			;Pointer to To Buffer
TOOBUF:	BLOCK 35		;To buffer
ATMBUF:	BLOCK 20		;Atom buffer
FRMBUF:	BLOCK 20		;From buffer
SUBBUF:	BLOCK 20		;Subject buffer
TEMP1:	BLOCK 20		;Temporary buffer
RTENAM:	BLOCK 20		;Temporary buffer
USER:	BLOCK 20		;User name or recipient buffer
HSTBUF:	BLOCK 20		;Host buffer
BIGBUF:	BLOCK 40000		;Storage for message file

LEVTAB:	PC1
	0
	0
CHNTAB:	1,,HICCUP		;net topology changed routine
	REPEAT ^D35,<EXP 0>
PC1:	BLOCK 1
SCNFLG:	BLOCK 1			;-1 => work in progress
INTRVL:	EXP SLPTIM		;sleep interval
INTVL1: EXP ^D10*^D60*^D1000	;FORCED SLEEP INTERVAL (10 MINUTES)
SCNTOD:	BLOCK 1			;TOD (msec) of last scan
DNBLK:	BLOCK DN.INF+1		; Arg block for DNCONN utility
BEGIN:	RESET
	MOVE P,[IOWD PDLLEN,STACK]
	CLRBUF NODNAM,5		;clear node name, flag bits
	MOVEI T1,.PRIOU		;assume logging to TTY
	MOVEM T1,LOGJFN
	MOVEI T1,.FHSLF		;get our capabilities
	RPCAP
	MOVE T1,[SIXBIT /VMAILR/] ; assume nonprivileged name
	TXNE T3,SC%WHL!SC%OPR	; WHOPER?
	JRST [	MOVE T1,[SIXBIT /SVMALR/] ; yes, declare different name
		TXO F,F%WEEL		  ; remember that
		JRST .+1]
	MOVE T2,T1		; private name also
	SETSN
	 JFCL
	MOVX T1,.NDGLN		;function to get local node name
	MOVEI T2,T3		;arg block
	HRROI T3,NODNAM		;where to put node name
	NODE
	 YECCH <Impossible NODE failure>
	TXNE F,F%WEEL		; WHEEL or OPERATOR?
	JRST [	HERALD \.VER,\.EDT	; yes, announce our name and version
		CALL OPNLOG		; open log file
		MOVEM T1,LOGJFN
		CALL TOPLGY		; set up to interrupt on
					;  network topology change
		CALL DTSTMP		; start log file
		HERALD \.VER,\.EDT
		JRST .+1]
	MOVX T1,GJ%SHT!GJ%PHY	;find mailer flags, physical-only please
	HRROI T2,[ASCIZ /SYSTEM:DECNET-MAILER.FLAGS.1;P777777/]
	GTJFN
	 YECCH<Can't find SYSTEM:DECNET-MAILER.FLAGS.1>
	MOVX T2,<440000,,0>!OF%RD!OF%WR!OF%THW
	OPENF			;open thawed (so updates OK)
	 YECCH<Can't OPENF PS:<SYSTEM>DECNET-MAILER.FLAGS>
	MOVEM T1,FLGJFN		;remember handle
	HRLZ T1,T1		;from file page zero
	MOVE T2,[.FHSLF,,FLGPAG] ;to fork page FLGPAG
	MOVX T3,PM%RD!PM%WR	;read and write access
	PMAP			;get the page in
;	SETOM MOBY		;always do moby scan first time
	; ..
	; ..

BEGIN2:	SETOM SCNFLG		;flag scan in progress
	CALL SCANEM		;check for queued mail and process it
	TXNN F,F%WEEL		;if not wheel,
	JRST [	HALTF			;all done
		JSP CX,BEGIN]
	MOVE T1,LOGJFN		;close log file for readers
	CLOSF
	 JFCL
	CALL OPNLOG		;open it again
	MOVEM T1,LOGJFN		;save new JFN
	SETZM SCNFLG		;note that we're now idle
	MOVE T1,INTRVL		;how long to sleep before checks
BEGIN3:	DISMS
	TIME			;current TOD
	MOVE T3,SCNTOD		;get TOD of last scan
	SUB T1,T3		;difference
	CAML T1,INTRVL		;have we waited the full interval yet?
	JRST BEGIN2		;yes, go scan again
	MOVE T2,INTRVL
	SUB T2,T1		;how much longer to wait
	MOVE T1,T2		;be patient
	JRST BEGIN3
;Check for queued mail and handle (called also at net topology change)

SCANEM:	TIME			;get current TOD
	MOVEM T1,SCNTOD		;remember
	MOVEI T1,100		;empty dead host table
	MOVEM T1,DEDHST		;because we don't know anything yet
	MOVEI T1,STRSPC		;reset string space area
	MOVEM T1,STRSP0		; ..
	GTAD			;get current time
	MOVE T2,FLGADR+777	;and time of last moby scan
	SUB T1,T2		;compute difference
;	SKIPL T1		;if unreasonable,
;	CAML T1,[MOBYN]		;time for one yet?
;	SETOM MOBY		;yes
	CALL DIRLST		;build list of directories to scan
	JUMPE T1,R		;none, just return
	MOVN P1,T1		;save negative count
	TXNN F,F%WEEL		;if not WHEEL,
	JRST SCANM1		; skip the logging
	CALL DTSTMP		;time stamp the log file
	HRROI T3,[ASCIZ /----Beginning periodic scan
/]
	MOVEI T1,.FHSLF		;see if running as an interrupt routine
	RWM			; ..
	SKIPE T2		;if so, get different message
	HRROI T3,[ASCIZ /----Network topology changed, beginning scan
/]
	MOVE T2,T3		;put string pointer in right AC
	MOVE T1,LOGJFN		;write to the log file
	SETZB T3,T4
	SOUT
	SKIPN MOBY		;moby scan?
	JRST SCANM1		;no, skip this
	CALL DTSTMP
	HRROI T2,[ASCIZ /----Scanning all directories
/]
	SETZB T3,T4
	SOUT

SCANM1:	CLRBUF DNBLK,DN.INF+1	; Zero arg block
	MOVE T1,LOGJFN		; Where to type stuff
	MOVEM T1,DNBLK+DN.ERR
	MOVEM T1,DNBLK+DN.WRN
	MOVEM T1,DNBLK+DN.INF
	MOVEI T1,DNBLK		; Arg block address
	CALL .DNINI		; Init connect utility
	 JRST [	CALL DTSTMP		; Hmm, flag error
		TMSG <%Problem initializing routing database>
		JRST .+1]
	MOVEM T1,HOSTBA		;Save host table address
	HRLZ P1,P1		;make AOBJN pointer
SCANM2:	MOVE T1,DIRS(P1)	;get next directory number
	CALL CHKDIR		;check for queued mail, send if found
	AOBJN P1,SCANM2
	SETZM MOBY
	TXNN F,F%WEEL		;if not WHEEL,
	RET			; then all done
	CALL DTSTMP		; else time stamp log file
	TMSG <----End of scan
>
	RET
;Check directory whose number is in T1 for queued mail

CHKDIR:	ACVAR<IFH,JFN>		;[342] Indexable File Handle,JFN
	TRVAR<<STRING,16>,DIRNUM> ;place to build string, dirnum
	TXZ F,F%STAY		;assume MAILER.FLAG bit won't stay lit
	MOVEM T1,DIRNUM		;preserve directory number

FILUP2:	HRROI T1,STRING		;where to build filespec string
	HRROI T2,[ASCIZ /PS:</]	;first part of filespec
	SETZB T3,T4
	SOUT			;start building filespec
	MOVE T2,DIRNUM		;get user number
	DIRST			;convert to string
	 JRST [	CAIN T1,DIRX2		; Insufficient system resources?
		TXO F,F%STAY		; Yes, don't flush this from queue
		JRST ALLDON]		; Wrap up
	HRROI T2,[ASCIZ />[--DECNET-MAIL--].*/]
	SETZB T3,T4		;finish off filespec string
	SOUT			; ..
	SETZ T2,		;insure ASCIZ
	IDPB T2,T1		; ..
	MOVE T1,[GJ%SHT+GJ%IFG+GJ%OLD+<0,,-3>] ;all generations
	HRROI T2,STRING		;point to filespec we built
	GTJFN			;get indexable file handle
	 ERJMP [TXNN F,F%RNAM		;any renames done?
		TXNE F,F%WEEL		; or doing this for system?
		JRST ALLDON		;yes, quit
		TMSG <%No queued DECNET mail>
		HALTF
		JSP CX,BEGIN]
	MOVE IFH,T1		;[342] save indexable file handle
	CALL DTSTMP		;time stamp log file
	TMSG <Unspooling mail from >
	MOVE T1,LOGJFN		;where to put username
	MOVE T2,DIRNUM		;user number
	DIRST			;log it
	 YECCH<DIRST failure while logging>
	TCRLF
	MOVE T1,IFH		;[342] get JFN of mail back
	JRST FILUP1		;go to it
FILOOP:	MOVE T1,IFH		;[342] get indexable file handle
	GNJFN			;get next file
	 ERJMP ALLDON		;no more
FILUP1:	HRRZ JFN,T1		;isolate and preserve JFN
	HRRZS T1		;pass JFN only
	CALL SNDFIL		;send to appropriate host and delete
	 JRST [	MOVE T1,JFN
		TXO T1,CO%NRJ		;keep JFN lying around
		CLOSF
		 JFCL
		PUSH P,T1		;save offending JFN
		TCRLF
		TXNN F,F%RNAM		;need to be renamed?
		JRST [	TXO F,F%STAY		;no, keep flag lit for retries
			POP P,T1		;flush stack
			JRST FILOOP]		;check some more
		POP P,T1		;get JFN back
		CALL RNAMIT		;yes, rename to prevent retries
		RLJFN			;release JFN
		 YECCH<RLJFN failure after RNAMIT>
		JRST FILUP2]		;and check for more mail to send
	JRST FILOOP		;do for all files

;Let dmailr handle clearing the flag bits to prevent conflict

ALLDON:
;	MOVE T4,[ANDCAM T3,FLGADR(T1)] ; assume we'll be clearing the bit
;	TXNE F,F%STAY		;should flag bit stay lit 'cuz of err?
	TXNN F,F%STAY		;should flag bit stay lit 'cuz of err?
	RET			;return without changing flags
	MOVE T4,[IORM T3,FLGADR(T1)] ; yes, light it (in case not lit now)
	HRRZ T1,DIRNUM		;get directory number
	IDIVI T1,^D36		;get word number in DECNET-MAILER.FLAGS
	MOVSI T3,400000		;bit zero
	MOVN T2,T2		;negate bit number
	LSH T3,(T2)		;position bit correctly
	XCT T4			; light or clear it appropriately
	RET			;all done
	ENDAV.			;[342] {IFH,JFN}
	ENDTV.			;[342] {STRING,DIRNUM}
;Send one file to appropriate host, JFN of file in T1
; P4 negative flags end of file
; Returns: +1: failure
;	   +2: success

SNDFIL:	ACVAR  <TOCNT,ERRPTR>		; Count of the number of recipients
	STKVAR <<HNAM,20>> ; Error msg ptr, mail JFN, net JFN, hostname
	HRRZM T1,MJFN		;save mail file JFN
	TXZ F,F%RNAM!F%ERRF!F%PACK	; No errors, no renames, no acks, yet
	CLRBUF ERRMSG,NERMSG	;zero error message save area
	HRROI T1,ERRMSG		;init pointer to error message string
	MOVEM T1,ERRPTR		; ..
	HRROI T1,HNAM		; Where to build hostname string

;Check to see if host is in the VAX router table.  If not, return and do
;nothing.  DMAILR will handle it.

	MOVE T2,MJFN		;mail file JFN
	MOVX T3,<1B11>		;type extension only
	SETZ T4,
	JFNS
	MOVE  T1,HOSTBA		;Is this host in the table?
	HRROI T2,HNAM
	TBLUK
	TXNN  T2,TL%EXM		;Skip if node is in routing table
	RETSKP			;No, Must not be for a VAX let DMAILR handle it

	MOVE T1,MJFN		;mail file JFN
	MOVX T2,<070000,,0>+OF%RD ;open for ASCII read
	OPENF
	 ERJMP [TXNE F,F%WEEL
		CALL DTSTMP
		TMSG <%Can't open mail file
>
		RET]		;failure return
	CALL DTSTMP		;put date/time stamp in log file
	TMSG <Sending to >
	MOVE T1,LOGJFN		; Move hostname to log file
	HRROI T2,HNAM
	SETZB T3,T4
	SOUT
	TMSG <, >
	MOVE T1,MJFN		;mail file JFN
	CALL CHKOLD		;see if old and dusty yet
	 RET			;yes, don't bother with it
	MOVE T1,MJFN		;mail file JFN
	CALL HSTCHK		;host considered up?
	 JRST [	TMSG <known inaccessible, skipped.>
		RET]
	CLRBUF DNBLK,DN.INF+1	; Zero DNCONN arg block
	MOVE T1,LOGJFN		; Place all messages in log file
	MOVEM T1,DNBLK+DN.ERR
	MOVEM T1,DNBLK+DN.WRN
	MOVEM T1,DNBLK+DN.INF
	HRROI T1,HNAM		; Pointer to host name
	MOVEM T1,DNBLK+DN.HST
	MOVEI T1,^D27		; Object type 27 decimal
	MOVEM T1,DNBLK+DN.ROB
	SETZ T1,		; Assume defaults for flags
	TXNE F,F%WEEL		; Are we the system unspooler?
	TXO T1,DN%DTS!DN%SPL	; Yes, light time-stamp and spool flags
	MOVEM T1,DNBLK+DN.FLG	;  ..
	MOVEI T1,7		; Byte size
	MOVEM T1,DNBLK+DN.BSZ	;  ..
	MOVEI T1,DNBLK		; Pass arg block address
	CALL .DNCON		; Attempt the connect
	 JRST [	MOVE T1,MJFN		; Failed - mark host dead
		CALL HSTDED
		RET]		;  and give failure return
	MOVEM T1,NJFN		; Remember the JFN we just won
	MOVEI T2,2(T2)		; Point to routing string
	HRLI  T2,(POINT 7,,6)	; Form byte pointer to routing string
	MOVEM T2,AROUTE		; Save address of routing string
	SETZ P4,		; Success - clear end of file flag
;	JRST SNDFL2		; Go send the message
SNDFL2:
;
;PROGRAM FROM FOR SENDING DATA TO VAX
;
;STEP DESCRIPTION:
;	BEGIN SNDVAX
;	: EXTRACT FROM THE MAIL FILE WHO THE MAIL IS FROM
;	: ADD ROUTINE LIST TO STRING WHERE NEEDED
;	: SEND FROM STRING TO VAX *I/O*
;	: REPEAT UNTIL NO MORE RECIPIENTS
;	: : EXTRACT FROM THE MAIL FILE ONE OF THE RECIPIENTS
;	: : ADD TO LIST OF RECIPIENTS ALONG WITH NODE NAME
;	: : IF RECIPIENT IS ON NODE WERE SENDING TO
;	: : : SEND RECIPIENTS NAME TO NODE FOR ACKNOWLEDGEMENT
;	: : : RECEIVE ACKNOWLEDGEMENT FROM REMOTE NODE
;	: : : IF BAD ACKNOWLEDGEMENT
;	: : : : REPORT ERROR
;	: : : ENDIF
;	: : ENDIF
;	: END REPEAT
;	SEND NULL TO REMOTE HOST
;	SEND TO STRING CREATED DURING REPEAT LOOP
;	GET SUBJECT OF MESSAGE
;	SEND SUBJECT OF MESSAGE
;	SKIP 2 LINES IN MAILE FILE TO GET OVER THE GARBAGE
;	SEND THE TEXT OF THE MESSAGE TO THE REMOTE HOST IN LINE MODE
;	SEND A NULL TO THE REMOTE HOST
;	REPEAT UNTIL ONE ACK RECEIVED FOR EACH RECIPIENT
;	:  RECEIVE AN ACKNOWLEDGEMENT FROM THE REMOTE HOST
;	:  IF BAD ACKNOWLEDGEMENT
;	:  : GET ERROR MESSAGE FROM REMOTE HOST
;	:  : LOG ERROR MESSAGE INTO THE LOG FILE
;	:  ENDIF
;	END REPEAT
;

SNDVAX:	CLRBUF BIGBUF,40000	; CLEAR THE INPUT BUFFER

	MOVE  T1,MJFN		; READ 40000 CHARACTERS FROM
	HRROI T2,BIGBUF		; THE MAIL FILE
	MOVEI T3,40000
	SETZ  T4,
	SIN
	 ERJMP [MOVEI T1,.FHSLF		;this fork
		GETER			;get last error code
		HRRZS T2		; ..
		CAIE T2,IOX4		;end of file?
		JRST  [ MOVE  T1,ERRPTR		; BUILD MESSAGE TO USER
			WARN  <I/O error reading mail file: >
			JRST  ESEND ]
		SETO P4,		;flag end of file
		MOVEI T1,12		;insure ends with line feed
		IDPB T1,T2		; ..
		JRST .+1]

	MOVN  CNT,T3		; CREATE THE COUNT OF THE NUMBER
	ADDI  CNT,40000		; OF BYTES READ
	MOVEM CNT,BYTCNT

	MOVE  PTR,[POINT 7,BIGBUF,6]	; CREATE POINTER TO INPUT BUFFER

	CALL  GETFRM		; GET WHO MAIL IS FROM
	 JRST [ MOVE  T1,ERRPTR		; BUILD MESSAGE TO USER
		WARN  <Error parsing FROM field of message>
		JRST  ESEND1 ]

	HRROI T1,NODNAM		; POINT TO OUR NODE NAME
	HRROI T2,HSTBUF		; HOST MESSAGE IS FROM
	STCMP			; IS MESSAGE FROM OUR HOST ?
	TXNN  T1,<SC%SUB>	; YES
	JRST  [ HRROI T1,HSTBUF		; GET TO END OF STRING
		HRROI T2,HSTBUF
		SETZB T3,T4
		SIN
		BKJFN
		 JFCL
		HRROI T2,FRMBUF		; ADD ROUTE TO FRMBUF
		SETZB T3,T4
		SOUT
		HRROI T1,FRMBUF
		HRROI T2,HSTBUF
		SETZB T3,T4
		SOUT
		HRROI T1,HSTBUF		; PUT CURRENT NODE NAME IN HSTBUF
		HRROI T2,NODNAM
		SETZB T3,T4
		SOUT
		HRROI T2,[ASCIZ/::/]	; WITH NODE DESIGNATOR
		SOUT
		JRST  .+1 ]

	HRROI T1,RTENAM		; CREATE DEFAULT NODE ROUTED TO
	HRROI T2,HNAM
	SETZB T3,T4
	SOUT
	HRROI T2,[ASCIZ/::/]	; WITH NODE DESIGNATOR
	SOUT
	CALL  FIXHST		; DEVELOPE ROUTING STRING SO
				;  VAX CAN GET BACK TO US
	 JRST [ MOVE  T1,ERRPTR		; BUILD ERROR MESSAGE TO USER
		WARN  <Error encountered in routing file>
		JRST  ESEND1 ]

	NSEND <FRMBUF>		; SEND SENDER TO VAX W ROUTING

	MOVSI TOCNT,-^D100	; MAXIMUM OF 100 NAMES IN LIST
	SETZM TOOBUF
	SETZM TOOBUF+^D25
	MOVE  T1,[POINT 7,TOOBUF]
	MOVEM T1,TOOPTR		; SETUP POINTER TO TO BUFFER
SNDVX1:	FIND   <TO:>		; FIND "TO:" LIST
	 JRST [ CALL SKPLIN		; NOT ON THIS LINE, TRY NEXT
		 JRST [ MOVE  T1,ERRPTR	; NO TO FIELD FOUND, -ERROR-
			WARN  <No recipients specified>
			JRST  ESEND1 ]
		JRST SNDVX1 ]		; GO TRY AGAIN
SNDVX2:	CALL  GETOCC		; PARSE TO FIELD AND BUILD TO STRING
	 JRST [ MOVE  T1,ERRPTR		; ERROR PARSING "TO" FIELD
		WARN  <Error parsing TO field of mail file>
		JRST  ESEND1 ]
	JUMPE T1,SNDVX3		; DONE PROCESSING TO FIELD - LOOK FOR CC
	HRROI T1,HNAM		; POINT TO OUR NODE NAME
	HRROI T2,HSTBUF		; HOST MESSAGE IS FOR
	STCMP			; IS MESSAGE FOR OUR HOST ?
	TXNN  T1,<SC%SUB>	; YES
	JRST  SNDVX2		; NO, GET NEXT RECIPIENT
	HRROI T1,HSTBUF		; HOST MESSAGE IS FOR
	HRROI T2,RTENAM		; HOST ROUTED TO
	STCMP			; DID WE ROUTE TO INTENDED HOST ?
				; (**THIS IS TO ALLOW USE OF OTHER GATEAWAYS**)
	JUMPE T1,SNDLC1		; YES, SEND LOCAL ADDRESS
	MOVE  T1,NJFN		; SEND REMOTE NODE NAME
	HRROI T2,HSTBUF
	SETZB T3,T4
	SOUT			; USE SOUT SO IT WILL GET CONCATENATED
				; WITH USERNAME
SNDLC1:	NSEND <USER>		; SEND RECIPIENT TO VAX
	NRECORD <TEMP1>		; GET ACKNOWLEDGEMENT
	HLRZ  T1,TEMP1
	CAIE  T1,4000		; WAS IT GOOD ?
	 JRST [ TXO   F,F%ERRF		; SET FATAL ERROR FLAG
		JRST  SNDVER ]		; FETCH ERROR MESSAGE
	AOBJN TOCNT,SNDVX2		; LOOP TILL DONE
	JRST  [ MOVE  T1,ERRPTR		; TOO MANY RECIPIENTS
		WARN  <Too many recipients.  Please split message>
		JRST  ESEND1 ]

SNDVX3:	FIND   <CC:>		; FIND "CC:" LIST
	 JRST SNDVX5			; ABSENCE OF CC FIELD OK
SNDVX4:	CALL  GETOCC		; PARSE TO FIELD AND BUILD TO STRING
	 JRST [ MOVE  T1,ERRPTR		; ERROR PARSING "TO" FIELD
		WARN  <Error parsing CC field of mail file>
		JRST  ESEND1 ]
	JUMPE T1,SNDVX5		; DONE PROCESSING CC FIELD
	HRROI T1,HNAM		; POINT TO OUR NODE NAME
	HRROI T2,HSTBUF		; HOST MESSAGE IS FOR
	STCMP			; IS MESSAGE FOR OUR HOST ?
	TXNN  T1,<SC%SUB>	; YES
	JRST  SNDVX4		; NO, GET NEXT RECIPIENT
	HRROI T1,HSTBUF		; HOST MESSAGE IS FOR
	HRROI T2,RTENAM		; HOST ROUTED TO
	STCMP			; DID WE ROUTE TO INTENDED HOST ?
				; (**THIS IS TO ALLOW USE OF OTHER GATEAWAYS**)
	JUMPE T1,SNDLC2		; YES, SEND LOCAL ADDRESS
	MOVE  T1,NJFN		; SEND REMOTE NODE NAME
	HRROI T2,HSTBUF
	SETZB T3,T4
	SOUT			; USE SOUT SO IT WILL GET CONCATENATED
				; WITH USERNAME
SNDLC2:	NSEND <USER>		; SEND RECIPIENT TO VAX
	NRECORD <TEMP1>		; GET ACKNOWLEDGEMENT
	HLRZ  T1,TEMP1
	CAIE  T1,4000		; WAS IT GOOD ?
	 JRST [ TXO   F,F%ERRF		; SET FATAL ERROR FLAG
		JRST  SNDVER ]		; FETCH ERROR MESSAGE
	AOBJN TOCNT,SNDVX4		; LOOP TILL DONE
	JRST  [ MOVE  T1,ERRPTR		; TOO MANY RECIPIENTS
		WARN  <Too many recipients.  Please split message>
		JRST  ESEND1 ]

SNDVX5:	NSUCCESS		; SEND NODE RECIPIENT LIST TERMINATOR
	MOVE  T1,NJFN
	HRROI T2,TOOBUF
	SETZB T3,T4		; THIS WAY A NULL WON'T GET SENT
	SOUTR			; SEND RECIPIENT LIST
	 ERJMP FATAL
	CALL  GETSUB		; GET SUBJECT FIELD
	 JRST [ MOVE  T1,ERRPTR		; ERROR PARSING SUBJECT FIELD
		WARN  <Error parsing SUBJECT field in mail file>
		JRST  ESEND1 ]
	NSEND <SUBBUF>		; SEND SUBJECT FIELD

; FIND START OF MESSAGE BY LOCATING FIRST BLANK LINE

	LDB   T1,PTR		; GET CHARACTER FROM BUFFER
SNDVX6:	CAIN  T1,.CHCRT		; SKIP IF LINE IS NOT BLANK
	JRST  SNDPA0		; EAT BLANK LINE
	CALL  SKPLIN		; SKIP TO NEXT LINE
	 JRST [ MOVE  T1,ERRPTR		; ERROR FINDING MESSAGE BODY
		WARN  <Unable to find body of message>
		JRST  ESEND1 ]
	JRST  SNDVX6

; NOW GET THE MESSAGE, ONE LINE AT A TIME

SNDPA0:	CALL SKPLIN		 ; SKIP TO NEXT LINE
	 JRST SNDONE		 ; NO MORE LINES, DONE!
SNDPA1:	CLRBUF ATMBUF,20
	MOVE T2,[POINT 7,ATMBUF] ; COPY REST OF THIS LINE INTO ATMBUF
SNDPA2:	CALL CPYLIN		 ; COPY LINE INTO ATMBUF
	JUMPE T1,[ SKIPE P4		; SKIP IF NOT EOF
		   JRST  SNDON1
		   PUSH  P,T2		; GET ANOTHER HUNK FROM THE MAIL FILE
		   MOVE  T1,MJFN
		   HRROI T2,BIGBUF
		   MOVEI T3,40000
		   SETZ  T4,
		   SIN
		    ERJMP [MOVEI T1,12		;insure ends with line feed
			   IDPB  T1,T2		; ..
			   MOVEI T1,.FHSLF	;this fork
			   GETER		;get last error code
			   HRRZS T2		; ..
			   CAIE T2,IOX4		;end of file?
			   JRST  [ POP   P,T2
				   MOVE  T1,ERRPTR	; BUILD MESSAGE TO USER
				   WARN  <I/O error reading mail file: >
				   JRST  ESEND ]
			   SETO  P4,		;flag end of file
			   JRST  SNDPAX]
SNDPAX:		   POP   P,T2
		   MOVN  CNT,T3		; CREATE THE COUNT OF THE NUMBER
		   ADDI  CNT,40000	; OF BYTES READ
		   MOVEM CNT,BYTCNT
		   MOVE  PTR,[POINT 7,BIGBUF,6]	; CREATE POINTER TO INPUT BUFFER
		   JRST  SNDPA2 ]	; BACK FOR REST OF LINE

	SKIPN ATMBUF		 ; DON'T BOTHER WITH NULL RECORDS
	 JRST [ NSEND <BLNKBF>
		JRST SNDPA0]
	NSEND <ATMBUF>
	JRST SNDPA0

SNDONE:	SKIPE P4		; SKIP IF NOT EOF
	JRST  SNDON1
	MOVE  T1,MJFN		; GET ANOTHER BLOCK OF DATA FROM MAIL FILE
	HRROI T2,BIGBUF
	MOVEI T3,40000
	SETZ  T4,
	SIN
	 ERJMP [MOVEI T1,.FHSLF		;this fork
		GETER			;get last error code
		HRRZS T2		; ..
		CAIE T2,IOX4		;end of file?
		JRST  [ MOVE  T1,ERRPTR		; BUILD MESSAGE TO USER
			WARN  <I/O error reading mail file: >
			JRST  ESEND ]
		SETO P4,		;flag end of file
		MOVEI T1,12		;insure ends with line feed
		IDPB T1,T2		; ..
		JRST .+1]
	MOVN  CNT,T3		; CREATE THE COUNT OF THE NUMBER
	ADDI  CNT,40000		; OF BYTES READ
	MOVEM CNT,BYTCNT
	MOVE  PTR,[POINT 7,BIGBUF,6] ; CREATE POINTER TO INPUT BUFFER
	JRST  SNDPA0		; BACK FOR REST OF LINE

SNDON1:	NSUCCESS

	HRLZS TOCNT		; CREATE AOBJN COUNT FOR NUMBER OF RECIPIENTS
	MOVNS TOCNT

SNDON2:	SETZM TEMP1		; GET RESPONSE
	MOVE  T1,NJFN
	HRROI T2,TEMP1
	MOVNI T3,4
	SETZ  T4,
	SINR
	 ERJMP [MOVEI T1,.FHSLF		; THIS FORK
		GETER			; GET LAST ERROR CODE
		HRRZS T2		;  ..
		CAIE  T2,IOX5		; DATA OR DEVICE ERROR??? !WHY!!!
		JRST  FATAL
		JRST  SNDON3 ]		; THINGS PROBABLY WENT OK
	HLRZ  T1,TEMP1
	CAIE  T1,4000		; WAS IT GOOD ?
	 CALL SNDVR1		; LOG ERROR AND CHECK FOR MORE ACKS
SNDON3:	AOBJN TOCNT,SNDON2	; LOOP UNILL ALL ACK's RECEIVED.
	TMSG  <sent OK>
;	JRST  DONE		; ALL DONE!

DONE:	MOVE T1,NJFN		;get net JFN
	CALL CLZLNK		;close net link
	 JFCL		;*** temp until I figure out pass-through's weirdness
	TXNE F,F%ERRF		;if any errors occurred,
	JRST [	TXO F,F%RNAM		;remember to rename mail file
		RET]			;failure return
	MOVE T1,MJFN		;mail file JFN
	TXO T1,CO%NRJ		;don't release JFN
	CLOSF
	 ERJMP [TCRLF
		CALL DTSTMP
		TMSG <Can't close mail file>
		MOVE T1,MJFN
		RLJFN
		 JFCL
		RET]
	MOVE T1,MJFN
	TXO T1,DF%NRJ		;keep JFN around
	DELF			;delete the unsent mail file
	 ERJMP [TCRLF
		CALL DTSTMP
		TMSG <%Can't delete mail file>
		MOVE T1,MJFN
		RLJFN
		 JFCL
		RET]		;give failure return
	TMSG <, deleted.
>
	RETSKP

SNDVER:	CALL SNDVR1		; LOG ERROR
	JRST DONE		; ABORT

SNDVR1:	CLRBUF LINBUF,^D100	;zero out LINBUF
	MOVE   T1,NJFN		;net JFN
	HRROI  T2,LINBUF	;where to read stuff
	SETZB  T3,T4		;read what server has to say
	SINR			; ..
	 ERJMP [MOVEI T1,.FHSLF		;this fork
		GETER			;get last error code
		HRRZS T2		; ..
		CAIE T2,IOX4		;end of file?
		CAIN T2,IOX5		;*** temporary until I figure out
		SKIPA			;*** why PSTHRU always causes IOX5's
		JRST [	TCRLF
			CALL DTSTMP		;time stamp log file
			TMSG <%I/O error reading reply from mail server>
			POP  P,T1 		;throw away return
			JRST SNDERR]		;clean up and return bad
		SETO P4,		;flag end of file
		JRST .+1]		;rejoin main flow
	HLR   T1,LINBUF
	JUMPE T1,R		;END OF MESSAGE
	TXO F,F%ERRF		; error found, flag that
	TCRLF			;start message on new line
	CALL DTSTMP		;date-time stamp it
	MOVE T1,LOGJFN		;type it out
	HRROI T2,LINBUF
	SETZB T3,T4
	SOUT
	MOVE T1,ERRPTR		;also save in error message area
	HRROI T2,LINBUF
	SETZB T3,T4		; ..
	SOUT			; ..
	MOVEM T1,ERRPTR		;save current error message pointer
	JRST  SNDVR1		;repeat until EOF

;FATAL ERROR OCCURED DURING TRANSMISSION OF MAIL

ESEND1:	SETZB T3,T4
	SOUT			; OUTPUT ERROR STRING
	JRST  ESEND2

ESEND:	SETZB T3,T4
	SOUT			; OUTPUT ERROR STRING
	BKJFN			; BACK UP POINTER OVER NULL
	 JFCL
	HRLOI T2,.FHSLF		; LAST ERROR, THIS PROCESS
	SETZ  T3,
	ERSTR
	 JFCL
	 JFCL
ESEND2:	TXO   F,F%ERRF		; SET FATAL ERROR FLAG
ESEND3:	TCRLF
	CALL  DTSTMP
	MOVE  T1,LOGJFN		; OUTPUT ERROR MESSAGE TO LOG FILE
	HRROI T2,ERRMSG
	SETZB T3,T4
	SOUT
	JRST  DONE

;FATAL NETWORK ERROR - MAIL REQUEUED

FATAL:	MOVE  T1,ERRPTR
	HRROI T2,[ASCIZ/%VMAILR: Fatal network error: /]
	SETZB T3,T4
	SOUT
	BKJFN			;BACK UP POINTER OVER THE NULL
	 JFCL
	HRLOI T2,.FHSLF
	SETZ  T3,
	ERSTR
	 JFCL
	 JFCL
	TCRLF
	CALL  DTSTMP
	MOVE  T1,LOGJFN
	HRROI T2,ERRMSG
	SETZB T3,T4
	SOUT
SNDERR:	MOVE T1,NJFN		;get net JFN
	CALL CLZLNK		;close it
	 JFCL			;what can you do?
	RET			;failure return
	ENDAV.			;[342] {TOCNT,ERRPTR}
	ENDSV.			;[342] {HNAM}
;ROUTINE TO GET THE NAME OF WHO SENT THIS MAIL
;
;CALL:
;	PTR   = POINTER TO THE MAIL FILE
;	CALL GETFRM
;RETURNS:
;	FRMBUF= USER FROM WHO THE MAIL WAS FROM
;	HSTBUF= HOST NAME FROM WHICH THE MAIL WAS SENT

GETFRM:
	FIND   <FROM:>		; FIND SENDER
	 JRST [ CALL  SKPLIN		; NOT IN THIS LINE, TRY NEXT
		 RET			; OOPS... NO FROM
		JRST  GETFRM ]		; TRY NEXT LINE
	CALL  GETNAM		; GET USERNAME, HOST, AND PERSONAL NAME
	 RET			; TEXT EXHAUSTED
	CLRBUF FRMBUF,20
	MOVE   T1,[POINT 7,FRMBUF]
	HRROI  T2,USER		; USERNAME FIELD
	SETZB  T3,T4
	SOUT			; OUTPUT TO FROM BUFFER
	SKIPE  TEMP1		; SKIP IF PERSONAL NAME FIELD
	JRST   [HRROI T2,[ASCIZ/ 	"/]	; START OF PERSONAL NAME
		SETZB T3,T4
		SOUT			; OUTPUT STARTING QUOTE
		HRROI T2,TEMP1		; OUTPUT PERSONAL NAME FIELD
		SOUT
		BKJFN			; BACKUP OVER SPACE
		 RET			; FATAL INTERNAL ERROR
		MOVEI T2,42		; OUTPUT END OF PERSONAL NAME
		BOUT
		CALLRET SKPLIN]		; SKIP TO NEXT LINE AND RETURN
GTFRM5:	CALLRET SKPLIN		; SKIP TO NEXT LINE AND RETURN
;Routine to fix the host routing string so that VAX's can find the
;return path on reply.
;
;CALL:
;	AROUTE= STRING POINTER TO ROUTING STRING USED BY THE
;		ROUTER FOR THE CONNECTION
;	CALL FIXHST
;USED:
;	TEMP1 = TEMPORARY STORAGE FOR HOST NAME IN ROUTE
;	RTENAM= TEMPORARY STORAGE FOR HOST NAME IN ROUTE
;RETURNS:
;	FRMBUF= WHO MESSAGE IS FROM WITH ROUTING AS REQUIRED
;	RTENAM= FINAL NODE IN ROUTING STRING

FIXHST:
	STKVAR <ARPTR>
	MOVE  T2,AROUTE			; GET STRING POINTER TO ROUTING STRING
	MOVE  T1,[POINT 7,TEMP1]	; GET PLACE TO STORE STRING
	CALL  GRTNOD			; GET NODE NAME
	 JRST RSKP			; NO ERROR, IMMEDIATE NEIGHBOR
FIXHS1:	MOVE  T1,[POINT 7,RTENAM]	; GET PLACE TO STORE NEXT NODE NAME
	CALL  GRTNOD			; GET NODE NAME
	 JRST R				; FATAL ERROR IN ROUTING TABLE
	LDB   T1,T2			; GET NEXT CHARACTER IN ROUTING TABLE
	SKIPN T1			; SKIP IF NOT ALL NODES READ
	 JRST FIXHS2			; ALL NODES READ, ROUTING COMPLETE
	MOVEM T2,ARPTR			; SAVE POINTER TO ROUTING STRING
	HRROI T1,TEMP1			; GET TO END OF STRING
	HRROI T2,TEMP1
	SETZB T3,T4
	SIN
	BKJFN
	 JFCL
	HRROI T2,HSTBUF			; TACK FIRST NODE READ ONTO BEGINNING
	SETZB T3,T4
	SOUT				;  OF HSTBUF AND PREPARE TO LOOP
	HRROI T1,HSTBUF
	HRROI T2,TEMP1
	SETZB T3,T4
	SOUT
	HRROI T1,TEMP1
	HRROI T2,RTENAM
	SETZB T3,T4
	SOUT
	MOVE  T2,ARPTR
	JRST  FIXHS1

FIXHS2:	HRROI T1,HSTBUF
	HRROI T2,HSTBUF
	SETZB T3,T4
	SIN
	BKJFN
	 JFCL
	HRROI T2,FRMBUF			; TACK ROUTING STRING ONTO BEGINNING
	SETZB T3,T4
	SOUT				; OF FRMBUF
	HRROI T1,FRMBUF
	HRROI T2,HSTBUF
	SETZB T3,T4
	SOUT
	RETSKP
	ENDSV.			;[342] {ARPTR}
;Routing to get routing node.
;Get a node name from the routing string being used.
;
;CALL:
;	T1    = POINTER TO ROUTING STRING
;	T2    = POINTER TO WHERE TO STORE NODE NAME
;	CALL GRTNOD
;RETURNS:
;	+1: ROUTING STRING EXHAUSTED
;	+2: OK, NODE RETURNED

GRTNOD:
	LDB  T3,T2		; GET A CHARACTER FROM ROUTING STRING
	CAIN T3,0		; SKIP IF STRING NOT EXHAUSTED
	JRST R
GRTND1:	IDPB T3,T1		; PUT CHARACTER IN OUTPUT STRING
	ILDB T3,T2		; GET CHARACTER FROM ROUTING STRING
	CAIN T3,0		; SKIP IF NOT END OF STRING
	JRST RSKP		; END OF STRING - RETURN SUCCESS
	CAIE T3,":"		; SKIP IF A NODE SEPARATOR
	JRST GRTND1		; LOOP TILL DONE
	IDPB T3,T1		; PUT INTO OUTPUT STREAM
	ILDB T3,T2		; SHOULD BE FOLLOWED BY ANOTHER COLON
	CAIE T3,":"		;  CHECK FOR IT
	 RET			; SOMETHING IS WRONG
	IDPB T3,T1		; SAVE IN OUTPUT STRING
	SETZ T3,		; OUTPUT NULL TERMINATOR FOR ASCIZ STRING
	IDPB T3,T1
	IBP  ,T2		; POINT TO NEXT BYTE TO GET
	JRST RSKP		; NODE SEPARATOR - RETURN SUCCESS
;Routine to parse TO/CC field in the mail file and build the TO string.
;  Parses one user per call and returns the user and node. 
;
;CALL:
;	PTR    = POINTER TO THE MAIL FILE
;	TOOPTR = POINTER TO TOO BUFFER
;	CALL GETOCC
;VARIABLES RETURNED:
;	TOOBUF = STRING OF USERS MAIL ADDRESSED TO
;	HSTBUF = HOST USER IS TO RECEIVE MAIL ON
;	USER   = USER TO RECEIVE MAIL
;	TOOPTR = POINTER TO TOOBUF
;RETURNS:
;	+1: ERROR ENCOUNTERED IN MAIL FILE
;	+2: T1=0 LIST EXHAUSTED OR T1<>0 VALID VARIABLES RETURNED

GETOCC:
	CALL   SKPBLK		; SKIP OVER WHITE SPACE
	 RET				; TEXT EXHAUSTED
	LDB    T1,PTR		; GET CHARACTER FROM MAIL FILE
	CAIN   T1,.CHLFD	; IS CHARACTER A LINE FEED - END OF FIELD
	 JRST [ CALL SKPLIN		; YES, SKIP TO NEXT LINE
		 RET			; INPUT TEXT EXHAUSTED
		SETZ T1,		; NOTE END OF FIELD
		RETSKP ]		; RETURN SUCCESS
	CAIN   T1,";"		; IS CHARACTER AN ADDRESS LIST TERMINATOR ?
	 JRST [ CALL SKPLIN		; YES, SKIP TO NEXT LINE
		 RET			; INPUT TEXT EXHAUSTED
		SETZ T1,		; NOTE END OF FIELD
		RETSKP ]		; RETURN SUCCESS
	CAIN   T1,","		; IS CHARACTER A COMMA - MORE RECIPIENTS
	 JRST [ CALL  GETCHR		; FLUSH COMMA
		 RET			; TEXT EXHAUSTED
		CALL  SKPBLK		; SKIP TO START OF NEXT RECIPIENT
		 RET			; TEXT EXHAUSTED
		LDB   T1,PTR		; GET FIRST NON-BLANK CHARACTER
		CAIN  T1,.CHLFD		; END OF LINE ?
		 JRST [ CALL SKPLIN		; YES, LIST CONT'D ON NEXT LINE
			 RET			; TEXT GONE - ERROR
			CALL SKPBLK		; SKIP BLANKS
			 RET			; TEXT GONE - ERROR
			JRST GETOCC ]
		JRST  .+1 ]
	CALL   GETNAM		; GET USERNAME, HOST, AND PERSON NAME
	 RET			; TEXT EXHAUSTED
	SKIPE  TOOBUF+^D25	; SKIP IF ROOM IN "TO" BUFFER
	JRST   GTOCC2		; DON'T BOTHER ADDING MORE TO STRING
	SKIPN  TOOBUF
	JRST   GTOCC1

	MOVEI  T1,","		; OUTPUT A COMMA
	IDPB   T1,TOOPTR
	MOVEI  T1," "		; FOLLOWED BY A SPACE
	IDPB   T1,TOOPTR

GTOCC1:	MOVE   T1,TOOPTR	; GET DESTINATION STRING POINTER
	HRROI  T2,HSTBUF	; OUTPUT HOST NAME TO TOOBUF
	SETZB  T3,T4
	SOUT
	HRROI  T2,USER		; OUTPUT USER NAME TO TOOBUF
	SOUT
	MOVEM  T1,TOOPTR	; SAVE UPDATED POINTER
GTOCC2:	RETSKP
;ROUTINE TO EXTRACT USER-PERSONAL-NAME, USER-NAME, HOST FROM BUFFER
;
;CALL:
;	PTR   = POINTER TO THE MAIL FILE
;	CALL GETNAM
;VARIABLES RETURNED:
;	USER  = USER NAME EXTRACTED FROM MAIL FILE
;	HSTBUF= HOST FOR USER NAME
;	TEMP1 = USER'S PERSONAL NAME
;RETURNS:
;	+1: ERROR ENCOUNTERED IN MAIL FILE
;	+2: VARIABLES RETURNED

GETNAM:
	ACVAR  <TPTR>		; TEMPORARY POINTER TO PERSONAL NAME STRING
	STKVAR <FCNT,FPTR>	; TEMPORARY POINT AND COUNT STORAGE
GTNAM1:	CLRBUF TEMP1,20		; CLEAR TEMPORARY BUFFER
	MOVE   TPTR,[POINT 7,TEMP1] ; CREATE IDPB POINTER TO TEMP. BUFFER
	CALL   SKPBLK		; SKIP OVER WHITE SPACE
	 RET			; TEXT EXHAUSTED
	MOVEM  CNT,FCNT		; SAVE COUNT
	MOVEM  PTR,FPTR		;  AND POINTER
	LDB    T1,PTR		; GET A CHARACTER FROM MAIL FILE
GTNAM2:	CAIN   T1,":"		; ADDRESS LIST TERMINATOR?
	JRST   [CALL GETCHR		; YES, THROW IT AWAY
		 RET			; ERROR - TEXT EXHAUSTED
		JRST GTNAM1 ]
	CAIN   T1,"<"		; SCAN FOR REAL NAME FIELD
	JRST   GTNAM4		; REAL FIELD FOUND
	CAIE   T1,.CHLFD	; END OF LINE (LINE FEED)?
	CAIN   T1,.CHCRT	; END OF LINE (CARRIAGE RETURN)?
	JRST   GTNAM3		; YES, MUST HAVE BEEN REAL FIELD
	CAIE   T1,","		; NAME SEPARATOR?
	CAIN   T1,";"		; END OF ADDRESS LIST?
	JRST   GTNAM3		; YES, MUST HAVE BEEN REAL FIELD
	IDPB   T1,TPTR		; SAVE CHAR IN CASE PERSONAL NAME FIELD
	CALL   GETCHR		; GET NEXT CHARACTER
	 RET			; ERROR, TEXT EXHAUSTED
	JRST   GTNAM2

GTNAM3:	MOVE  CNT,FCNT		; RESTORE ORIGINAL COUNT
	MOVE  PTR,FPTR		; RESTORE ORIGINAL POINTER
	SETZM TEMP1		; NO PERSONAL NAME FIELD
	JRST  GTNAM5

GTNAM4:	CALL   GETCHR		; GOBBLE SPACE OR "<"
	 RET
GTNAM5:	CLRBUF USER,20		; CLEAR USERNAME STORAGE AREA
	MOVE   T1,[POINT 7,USER] ; AND POINT TO IT
	CALL   GETTOK		; GET NAME
	 RET			; INVALID CHARACTER ENCOUNTERED
	CALL   SKPBLK		; SKIP WHITE SPACE
	 RET			; TEXT EXHAUSTED
	FIND   <AT>
	 RET			; NO AT ?
	CALL   GETNOD		; GET NODE SENT FROM
	 RET			; TEXT EXHAUSTED
	LDB    T1,PTR		; GET A CHARACTER FROM MAIL FILE
	CAIN   T1,">"		; END OF FIELD WITH PERSONAL NAME?
	JRST   GETCHR		; YES, GOBBLE ">" AND RETURN
	RETSKP			; NO, RETURN SUCCESS
	ENDAV.			;[342] {TPTR}
	ENDSV.			;[342] {FCNT,FPTR}
;Get the subject field and store it
;
;CALL:
;	PTR   = POINTER TO THE MAIL FILE
;	CALL GETSUB
;VARIABLES RETURNED:
;	SUBBUF= STRING CONTAINING THE SUBJECT OF THE MESSAGE
;RETURNS:
;	+1: ERROR ENCOUNTERED WHILE GETTING SUBJECT FIELD
;	+2: OK, SUBJECT FIELD IN SUBBUF

GETSUB:
	STKVAR <SCNT,SPTR>	; TEMPORARY STORAGE FOR COUNT AND POINTER
	MOVEM CNT,SCNT		; SAVE COUNT
	MOVEM PTR,SPTR		;  AND POINTER

GETSB1:	FIND <SUBJECT:>		; FIND SUBJECT FIELD
	 JRST [ CALL SKPLIN		; NOT IN THIS LINE, TRY NEXT
		JRST NOSUB		; NO SUBJECT, THAT'S OK
		JRST GETSB1 ]		; TRY NEXT LINE

	CALL SKPBLK		; SKIP WHITE SPACE
	 RET			; TEXT EXHAUSTED

	CLRBUF  SUBBUF,20
	MOVE T2,[POINT 7,SUBBUF] ; COPY REST OF THIS LINE INTO SUBBUF
	CALL    CPYLIN		 ;  ..
	CALLRET SKPLIN

NOSUB:	MOVE  CNT,SCNT		; RESTORE COUNT
	MOVE  PTR,SPTR		;  AND POINTER

	MOVE T1,BLNKBF
	MOVEM T1,SUBBUF		; PUT A BLANK STRING IN THERE
	 RETSKP
	ENDSV.			;[342] {SCNT,SPTR}
;Routine to get the node name from the mail file.
;
;CALL:
;	PTR   = POINTER TO MAIL FILE POSITIONED AT NODE NAME TO GET
;	CALL GETNOD
;VARIABLES RETURNED:
;	HSTBUF= NODE NAME WITH DOUBLE COLON TACKED ON THE END
;RETURNS:
;	+1: ERROR PARSING NODE NAME
;	+2: OK, NODE NAME IN HSTBUF

GETNOD:
	MOVE  T1,[POINT 7,HSTBUF] ; GET DESTINATION STRING POINTER
	CALL  GETTOK		; GET NODE NAME
	 RET				; ERROR ENCOUNTERED WHILE GETTING NODE
	MOVX  T2,":"		; GET A COLON
	IDPB  T2,T1		; PUT IT ON THE END OF THE NODE NAME
	IDPB  T2,T1
	SETZ  T2,		; ENSURE ASCIZ STRING
	IDPB  T2,T1
	RETSKP
;SKIP TO FIRST NONBLANK CHARACTER.
;SKIP OVER CNTRL-V'S, SPACES, AND CARRIAGE RETURNS.
;
;CALL:
;	PTR   = STRING POINTER TO TEXT THAT BLANKS ARE TO
;		BE SKIPPED IN
;	CALL SKPBLK
;RETURNS:
;	+1: TEXT EXHAUSTED
;	+2: OK, PTR POINTS AT FIRST NONBLANK CHARACTER

SKPBLK:	LDB  T1,PTR		; GET CHAR
	CAIN T1,""		; IGNORE CONTROL-V'S
	JRST SKPBL1
	CAIE T1,.CHCRT		; IGNORE RETURNS
	CAIN T1," "		;  AND BLANKS
	SKIPA
	RETSKP
SKPBL1:	CALL GETCHR		; SKIP TO NEXT
	 RET			; TEST GONE, ERROR
	JRST SKPBLK
;SKIP TO BEGINNING OF NEXT LINE.  SKIP OVER ALL CHARACTER ON A LINE
;UNTIL A CARRIAGE RETURN IS SEEN.
;
;CALL:
;	PTR   = STRING POINTER TO TEXT THAT A LINE IS
;		BE SKIPPED IN
;	CALL SKPLIN
;RETURNS:
;	+1: NO MORE TEXT LEFT
;	+2: OK, PTR POINTS TO BEGINNING OF LINE

SKPLIN:	LDB  T1,PTR		; GET NEXT CHAR
	CAIN T1,.CHLFD		; DID WE JUST EAT AN EOL?
	CALLRET GETCHR		; YES, SKIP OVER IT AND RETURN
	CALL GETCHR		; NO, EAT NEXT CHAR
	 RET			; TEXT EXHAUSTED
	JRST SKPLIN		; NO, EAT ANOTHER
;COPY A LINE OF TEXT FROM ONE AREA OF MEMORY TO ANOTHER.
;
;CALL:
;	T2    = STRING POINTER TO WHICH TEXT IS TO BE STORED
;	CALL CPYLIN
;RETURN:
;	+1: ALWAYS

CPYLIN:	LDB   T1,PTR		; GET A BYTE
CPYLN1:	JUMPE T1,R		; RETURN IF NULL FOUND
	CAIE  T1,15		; QUIT ON CR OR LF
	CAIN  T1,12
	JRST  CPYLNR
	IDPB  T1,T2		; STUFF THIS ONE
	CALL  GETCHR		; FLUSH CHARACTER
	JRST  [ SETZ T1,	; ERROR - TEXT EXHAUSTED
		RET ]
	JRST  CPYLN1

CPYLNR:	SETZ  T3,		; PUT NULL TERMINATOR ON STRING
	IDPB  T3,T2
	RET
;GET A CHARACTER
;
;CALL:
;	PTR   = STRING POINTER FROM WHICH A CHARACTER IS TO BE TAKEN
;	CALL GETCHR
;RETURNS
;	+1: NO MORE TEXT LEFT
;	+2: OK, CHARACTER GOTTEN IN T1

GETCHR:	JUMPE CNT,R		; ANY TEXT LEFT?
	ILDB  T1,PTR		; YES, SNARF CHAR
	SOJA  CNT,RSKP		; DECREMENT COUNT AND RETURN
;SEARCH FOR A STRING.  CALLED BY FIND MACRO
;
;CALL:
;	T1    = POINTER TO STRING TO FIND
;	CALL FINDIT
;RETURNS:
;	+1: STRING NOT FOUND, PTR AND CNT PRESERVED
;	+2: STRING FOUND, PTR AND CNT UPDATED TO POINT PAST STRING

FINDIT:	PUSH P,PTR		; SAVE CURRENT POINTER INFO
	PUSH P,CNT		; IN CASE STRING NOT FOUND
	MOVE P3,T1		; COPY T1 TO SAFE PLACE

FINDT1: LDB   T2,PTR		; FETCH A CHAR FROM SOURCE
	CAIL  T2,"a"		; IF LOWERCASE,
	CAILE T2,"z"		;  ..
	SKIPA			;  ..
	TRZ   T2,40		; THEN UPPERIZE IT
	ILDB  T3,P3		; FETCH CHAR FROM TEST STRING
	JUMPE T3,[ADJSP P,-2		; TEST STRING GONE, MATCH FOUND
		  RETSKP]		; FLUSH OLD POINTERS AND GIVE OK RETURN
	CAIL  T3,"a"		; UPPERIZE IT ALSO
	CAILE T3,"z"		;  ..
	SKIPA			;  ..
	TRZ   T3,40		;  ..
	CAME  T2,T3		; MATCHING SO FAR?
	JRST  FINDTX		; NO, QUIT NOW AND RESTORE POINTERS
	CALL  GETCHR		; SKIP TO NEXT CHAR IN MAIL
	 SKIPA			; NONE LEFT, FAIL
	JRST  FINDT1		; MORE TO LOOK AT, KEEP GOING

FINDTX:	POP P,CNT		; NO MATCH, RESTORE POINTERS
	POP P,PTR		;  AND GIVE BAD RETURN
	RET
;GET TOKEN - ALPHANUMERIC STRING - AND STORE IN ATMBUF
;
;CALL:
;	PTR   = STRING POINTER TO GET TOKEN FROM
;	T1    = STRING POINTER WHERE TOKEN IS TO BE STORED
;	CALL GETTOK
;VARIABLES RETURNED:
;	PTR   = UPDATED TO REFLECT TEXT TAKEN
;	T1    = UPDATED TO END OF TEXT INSERTED
;RETURNS:
;	+1: TEXT EXHAUSTED
;	+2: OK

GETTOK:	ACVAR <PTR1,CNT1>
	MOVE   PTR1,T1		; SAVE POINTER
	CALL   SKPBLK		; SKIP BLANKS
	 RET			; TEXT GONE, QUIT
	MOVEI CNT1,^D132	; MAX CHARS IN TOKEN

	LDB  T1,PTR		; SEE IF THIS USERNAME IS A QUOTED STRING
	CAIE T1,42		; DOES IT START WITH DOUBLE QUOTE?
	 JRST GETTK2		; NO, DO ORDINARY THING

GETTK1:	CALL	GETCHR		; GET NEXT CHR
	 RET			; TEXT EXHAUSTED
	CAIE	T1,42		; [342] QUOTE?
	 JRST	GETTK0		; [342] NO, JUST COPY
	CALL	GETCHR		; [342] GET NEXT CHAR
	 RET			; [342] NONE
	CAIE	T1,42		; [342] DOUBLE QUOTE?
	 JRST	GETTK3		; [342] NO, THE END
GETTK0:	SOJLE	CNT1,R		; [342] STORE IF THERE IS ROOM
	IDPB	T1,PTR1		; [342] IN WE GO!
	JRST	GETTK1		; [342] KEEP GOIN

GETTK2:	CALL  GTALPH		; GET AN UPPERCASE ALPHANUMERIC CHAR
	 RET
	JUMPE T1,GETTK3		; NONALPHANUMERIC
	IDPB  T1,PTR1		; STORE
	SOJG  CNT1,GETTK2	; GO FOR MORE
	RET			; ERROR - TOO MANY CHARACTERS

GETTK3:	MOVE T1,PTR1		; RETURN UPDATED POINTER IN T1
	CAIE CNT1,^D132		; DID WE FIND ANYTHING?
	RETSKP			; YES, EVERTHING'S COOL THEN
	LDB  T1,PTR		; NO, 1ST CHR OF NAME BAD -- RETRIEVE IT
GETTK4:	IDPB T1,PTR1		; SAVE BAD NAME FOR ERROR MESSAGE
GETTK5:	CALL GETCHR		; GET NEXT CHR OF BAD NAME
	 RET			; SKIP TO COMMA OR EOL THEN, THIS NAME IS BAD
	CAIE T1,","		;  ..
	CAIN T1,12		;  ..
	RET			; OK, GIVE BAD RETURN NOW
	SOJG CNT1,GETTK4	; BE CAREFUL NOT TO OVERFLOW ATOM BUFFER
	JRST GETTK5		; FULL, JUST TOSS CHARS INTO BIT BUCKET NOW
	ENDAV.			; [342] {PTR1,CNT1}
;GET ALPHNUMERIC CHARACTER.  CTRL-V AND DOT ARE CONSIDER ALPHANUMERIC.
;
;CALL:
;	PTR   = STRING POINTER TO GET ALPHANUMERIC CHARACTER FROM
;	CALL GTALPH
;RETURNS:
;	+1: TEXT EXHAUSTED
;	+2: T1=0 IF NEXT CHAR NO ALPHANUMERIC
;	    T1 CONTAINS CHAR IF ALPHANUMERIC

GTALPH:	LDB  T1,PTR		; SNIFF AT THIS CHAR
	CAIN T1,"_"		; ALLOW UNDERSCORE
	JRST GTALP1		;  ..
	CAIN T1,"-"		; ALLOW HYPHENS
	JRST GTALP1		;  ..
	CAIE T1,"."		; ALSO DOTS
	CAIN T1,""		;  AND CTRL-V'S
	JRST GTALP1		;  ..
	CAIL T1,"A"		; UPPERCASE ALPHABETIC?
	CAILE T1,"Z"		;  ..
	SKIPA			; NO, CHECK SOME MORE
	JRST GTALP1		; YES, PASS IT THRU
	CAIL T1,"a"		; LOWERCASE?
	CAILE T1,"z"		;  ..
	SKIPA			; NO, CHECK MORE CASES
	JRST [  TRZ T1,40		; YES, UPPERIZE IT
		JRST GTALP1]		;  AND PASS IT
	CAIL  T1,"0"		; DIGIT?
	CAILE T1,"9"		;  ..
	JRST [  SETZ T1,		; NO, INDICATE NONALPHANUMERIC
		RETSKP]
GTALP1:	PUSH P,T1		; SAVE THIS CHAR
	CALL GETCHR		; CHAR OK, SKIP TO NEXT
	 JFCL			; NEXT CALL WILL CATCH THIS
	POP  P,T1		; RETURN CHAR SKIPPED
	RETSKP
;Rename [--DECNET-MAIL--].host to ]--UNDELIVERABLE-DECNET-MAIL--[.host
; because of fatal error detected by server
; Call with JFN in T1

RNAMIT:	ACVAR <SJFN>		;source JFN
	STKVAR <<STR1,30>>	;where to build filespec string
	HRRZ SJFN,T1		;save JFN
	SETZM STR1		;clear string space
	HRLI T1,STR1		;zap from here
	HRRI T1,1+STR1		; to here
	BLT T1,27+STR1		; stop here
	HRROI T1,STR1		;where to build new filespec
	MOVE T2,SJFN		;JFN of bad mail
	MOVX T3,<1B2+1B5+JS%PAF> ;return and punctuate device and directory
	JFNS			; ..
	 YECCH<JFNS failure at RNAMIT>
	HRROI T2,[ASCIZ /]--UNDELIVERABLE-DECNET-MAIL--[./]
	SETZB T3,T4		;add filename and dot
	SOUT			; ..
	 YECCH<SOUT failure at RNAMIT>
	MOVE T2,SJFN		;now add original extension
	MOVX T3,<1B11>		; ..
	JFNS
	 YECCH<JFNS failure at RNAMIT 2>
	HRROI T2,[ASCIZ /.-1/]	;new generation
	SOUT
	MOVX T1,GJ%SHT		;get a JFN for the new filespec
	HRROI T2,STR1		;where the spec was built
	GTJFN
	 YECCH<GTJFN failure at RNAMIT>
	MOVE T2,T1		;new JFN
	MOVE T1,SJFN		;old JFN
	RNAMF			;rename it
	 YECCH<RNAMF failure at RNAMIT>
	MOVE SJFN,T2		;save new JFN
	MOVE T1,T2		;copy JFN
	TXO T1,CF%NUD+(.FBBYV)	;don't clank disk, word to change
	MOVSI T2,770000		;generation-retention-count field
	SETZ T3,		;zero (keep all generations)
	CHFDB			;do it
	MOVE T1,SJFN		;pass new JFN to NOTIFY
	CALL NOTIFY		;notify user of lossage
	MOVE T1,SJFN		;return new JFN
	RET
	ENDAV.			;[342] {SJFN}
	ENDSV.			;[342] {STR1}
;Close net link, JFN in T1

CLZLNK:	STKVAR <NJF>
	MOVEM T1,NJF
	TXO T1,CZ%ABT		;Abort the link so program doesn't hang
	CLOSF
	 ERJMP CLZLN0
	RETSKP			;OK, that was easy
CLZLN0:	CAIN T1,DCNX11		;if error is "link aborted",
	JRST CLZLN1		; don't complain
	TCRLF
	CALL DTSTMP		;time stamp log file
	TMSG <%Close error for net link because:>
	MOVE T1,LOGJFN
	HRLOI T2,.FHSLF
	ERSTR
	 JFCL
	 JFCL
CLZLN1:	MOVE T1,NJF		;Try like hell to get rid of this JFN
	TXO T1,CZ%ABT		; ..
	CLOSF
	 JFCL
	RET
	ENDSV.			;[342] {NJF}
;Place date/time stamp in log file

DTSTMP:	TXNN F,F%WEEL		;only if system scanning
	RET
	MOVE T1,LOGJFN		;put into log file
	SETO T2,		;current date/time
	SETZ T3,		; everything
	ODTIM
	TMSG < >		;delimit rest of line
	RET

;Open SYSTEM:VMAILR.LOG

OPNLOG:	MOVX T1,GJ%SHT
	HRROI T2,[ASCIZ /DECNET-LOG:VMAILR.LOG/]
	GTJFN			;try logical name first
	 ERCAL [MOVX T1,GJ%SHT
		HRROI T2,[ASCIZ /SYSTEM:VMAILR.LOG/]
		GTJFN
		 YECCH<Can't get JFN for log file>
		RET]
	MOVX T2,<070000,,0>!OF%RD!OF%WR!OF%APP
	OPENF			;open it
	 ERJMP [CAIN T1,OPNX9		;invalid simultaneous access?
		JRST [	TMSG <?LOG file already open, please DISABLE first.>
			HALTF
			JSP CX,BEGIN]
		TMSG <?Can't open log file because: >
		MOVX T1,.PRIOU
		HRLOI T2,.FHSLF		;type last error for this fork
		ERSTR
		 JFCL
		 JFCL
		HALTF
		JSP CX,BEGIN]
	HRRZ T1,T1		;return JFN only
	RET
;Build list of directories to scan, return how many in T1

DIRLST:	TXNE F,F%WEEL		;doing whole system?
	JRST DIRLS2		;yes, handle differently
	SETO T1,		;no, get our logged-in directory number
	MOVE T2,[-1,,P1]	;return result in P1
	MOVX T3,.JIUNO
	GETJI
	 YECCH<GETJI failure>
	MOVEM P1,DIRS		;one directory only (ours)
	MOVEI T1,1		; ..
	RET

DIRLS2:	MOVSI P1,-777		;words in DECNET-MAILER.FLAGS
	MOVSI P2,-MAXDIR	;words in directory list we build
	SKIPE MOBY		;doing moby scan?
	CALL LMOBY		;yes, set lots of bits

DIRLS3:	SKIPE T1,FLGADR(P1)	;any flags set in this word?
	JRST DIRLS4		;yes, examine it
DIRLS6:	AOBJN P1,DIRLS3		;no, check next word
	HRRZ T1,P2		;number of dirs to scan
	RET			;done

DIRLS4:	JFFO T1,.+2		;get bit number
	JRST DIRLS6		;no more bits in this word
	HRRZ T3,P1		;get word number
	IMULI T3,^D36		;times bits per word
	ADD T3,T2		;plus this bit position
	HRLI T3,500000		;plus magic number field
	MOVEM T3,DIRS(P2)	;save directory number
	MOVSI T3,400000		;bit zero
	MOVN T2,T2		;get negative bit position
	LSH T3,(T2)		;create bit we just handled
	TDZ T1,T3		;clear it
	AOBJN P2,DIRLS4		;move to next slot in directory list
	CALL DTSTMP		;stamp the log file
	TMSG <%Too many directories with queued mail, rebuild VMAILR with bigger MAXDIR
>
	HRRZ T1,P2		;number of dirs to scan
	RET			;quit now
;Set lots of bits in MAILER.FLAGS so race conditions don't rip us off

LMOBY:	ACVAR<USR>
	MOVX T1,RC%AWL
	HRROI T2,[ASCIZ /*/]
	RCUSR			;begin stepping through all user directories
	MOVE USR,T3

LMOBY1:	HRRZ T1,USR		;set this bit
	IDIVI T1,^D36		;in this word
	MOVX T3,1B0		;make a bit
	MOVN T2,T2		;negate shift amount
	LSH T3,(T2)		;position bit correctly
	IORM T3,FLGADR(T1)	;set it
	MOVX T1,RC%STP!RC%AWL
	HRROI T2,[ASCIZ /*/]
	MOVE T3,USR
	RCUSR			;step to next user
	TXNE T1,RC%NMD		;any more directories?
	JRST [	GTAD			;no, get current time
		MOVEM T1,FLGADR+777	;remember time we did this
		RET]
	MOVE USR,T3
	JRST LMOBY1
	ENDAV.			;[342] {USR}
;Set up to interrupt on network topology change

TOPLGY:	MOVX T1,.NDSIC		;function to set channel to interrupt on
	MOVEI T2,T3		; when net topology changes
	SETZ T3,		;interrupt on channel zero
	NODE			;do it
	 ERJMP [MOVE T1,INTRVL		;since we can't be topology-driven,
		LSH T1,-2		;quarter the sleep interval
		MOVEM T1,INTRVL		; ..
		RET]
	MOVEI T1,.FHSLF		;set up interrupt system
	MOVE T2,[LEVTAB,,CHNTAB]
	SIR
	EIR
	MOVX T2,1B0
	AIC
	RET			;all set!


;Here when net topology changes

HICCUP:	SKIPE SCNFLG		;is scan in progress?
	DEBRK			;yes, forget it then
	SETOM SCNFLG		;flag scan in progress
	PUSH  P,T1		;Save registers used
	PUSH  P,T2
	PUSH  P,T3
	TIME			;current TOD
	MOVE  T3,SCNTOD		;get TOD of last scan
	SUB   T1,T3		;difference
	CAMGE T1,INTVL1		;have we waited the full 10 seconds yet?
	JRST  [ POP P,T3		;No, wait some more
		POP P,T2
		POP P,T1
		DEBRK    ]
	POP   P,T3		;Restore ACs saved
	POP   P,T2
	POP   P,T1
	MOVEI T1,^D5000		;wait 5 seconds for net to settle down
	DISMS
	CALL SCANEM		;do the heavy stuff
	MOVE T1,LOGJFN		;close log file for perusers
	CLOSF
	 JFCL
	CALL OPNLOG		;open it again
	MOVEM T1,LOGJFN		;save new JFN
	SETZM SCNFLG		;clear scan in progress flag
	DEBRK			;and return to background
;See if a host is up.
;Call:	T1/ JFN of mail file (extension is host name)
;	CALL HSTCHK
;Returns +1: host considered dead
;	 +2: host considerd up

HSTCHK:	STKVAR<<STRING,<<HOSTNN+5>/5>>>
	MOVE T2,T1		;put JFN in right AC
	HRROI T1,STRING		;where to put host name
	MOVX T3,<1B11>		;extension (host name) only
	JFNS
	MOVEI T1,DEDHST		;dead host table
	HRROI T2,STRING		;name of this host
	TBLUK			;is it known dead?
	TXNN T2,TL%EXM		;exact match for any name?
	RETSKP			;no, consider it up
	RET			;yes, consider it down
	ENDSV.			;[342] {STRING}

;Mark a host as dead.  Call with mail file JFN in T1.

HSTDED:	ACVAR <Q1>		;[342] CHANGE FROM P1
	MOVE Q1,T1		;[342] copy JFN
	MOVEI T1,<<HOSTNN+5>/5> ; room for a hostname and null
	CALL ALLSTR		;allocate string space
	 RET			;ignore failures
	MOVE T2,Q1		;[342] get JFN
	MOVE Q1,T1		;[342] save string address
	HRRO T1,T1		;form string pointer
	MOVX T3,<1B11>		;extension only
	JFNS
	MOVEI T1,DEDHST		;dead host table
	HRLZ T2,Q1		;[342] address of string
	TBADD			;add to table
	 ERJMP .+1		;ignore failures
	RET
	ENDAV.			;[342] {Q1}

;Allocate c(T1) words of storage
; Returns +1: failure
;	  +2: OK, address in T1

ALLSTR:	MOVE T2,STRSP0		;current free space
	ADDI T2,(T1)		; plus amount requested
	CAIL T2,STRSPC+STRN	;overflow?
	RET			;yes, fail
	MOVE T2,STRSP0		;no, get address of this string
	PUSH P,T2		;save for a bit
	SETZM (T2)		;zero it
	HRLZI T3,(T2)		;build BLT pointer
	HRRI T3,1(T2)		; ..
	ADDI T2,-1(T1)		;last word to zero
	BLT T3,(T2)
	ADDM T1,STRSP0		; ..
	POP P,T1		;return address of chunk
	RETSKP
;Check to see if queued mail too old to bother with
;Call:
;	T1/ JFN of queued mail
;Returns +1: too old, give up
;	 +2: OK

CHKOLD:	MOVE T2,[1,,.FBWRT]	;get last write date
	MOVEI T3,T4		; into T4
	GTFDB
	GTAD			;get current time/date
	SUB T1,T4		;compute age
	CAMG T1,[XSAGE]		;too old?
	RETSKP			;no, send it
	TCRLF			;new line
	CALL DTSTMP		;time-stamp log file
	TMSG <%VMAILR: Queued mail is too old -- renamed>
	TXNN F,F%WEEL		;system scanning?
	CALL [	TMSG < to ]--UNDELIVERABLE-DECNET-MAIL--[>
		RET]		;no, be wordier for lusers
	HRROI T1,ERRMSG		;no, build reason string
	HRROI T2,[ASCIZ /unsent mail is over one week old./]
	SETZB T3,T4
	SOUT
	TXO F,F%RNAM		; Remember to rename queued mail
	RET			; failure return
;Notify user of lossage reported by foreign host (eg., bad username)
; Cause of error is string stored in ERRMSG
; We will construct a mail file containing the reason and
; call SNDFIL to mail it to the sucker
;Call with:  JFN of [--UNDELIVERABLE-MAIL--] file in T1

NOTIFY:	STKVAR <UNDJFN,CPYJFN,OURDIR,TEMPT1,<STRNG1,10>> ;undeliverable mail JFN, MAIL.CPY JFN, filename string
	TXNN F,F%WEEL		;only need to do this if WHEEL
	RET			;not WHEEL, user will get this typed
	MOVEM T1,UNDJFN		;save UNDELIVERABLE-MAIL JFN
	CALL DTSTMP		;log this notification
	TMSG <Notifying user of lossage
>
;	SETO  T1,		;build filename string for notification file
;	HRROI T2,OURDIR		; Results to OURDIR
;	MOVEI T3,17
;	GETJI
;	 YECCH<GETJI failure>
	MOVX  T1,RC%EMO		; EXACT MATCH ONLY
	HRROI T2,[ASCIZ/PS:<SPOOL>/] ; GET DIRECTORY NUMBER OF SPOOL
	SETZ  T3
	RCDIR
	TXNE  T1,<RC%NOM!RC%AMB!RC%NMD>	; SKIP IF NO ERRORS
	 YECCH <Rcdir failure while translating PS:<SPOOL>>
	MOVEM T3,OURDIR		; SAVE DIRECTORY NUMBER
	HRROI T1,STRNG1
	MOVE  T2,OURDIR		; Get name of forwarding directory
	DIRST
	 YECCH <Dirst Failure>
	HRROI T2,[ASCIZ/[--Decnet-Mail--]./]
	SETZB T3,T4
	SOUT
	HRROI T2,NODNAM		; Our node name (mailing to this node)
	SOUT
	HRROI T2,[ASCIZ/.-1/]
	SETZB T3,T4
	SOUT
	MOVX  T1,GJ%SHT		;short form
	HRROI T2,STRNG1		;string we built
	GTJFN
	 YECCH<Can't GTJFN for MAIL.CPY>
	MOVX T2,<070000,,0>+OF%WR ;open for write, 7-bit bytes
	OPENF
	 YECCH<Can't OPENF MAIL.CPY>
;Build message to notify user of lossage.  Write the message into
; the JFN in T1.

BLDMSG:	HRROI T2,[ASCIZ /Date: /]
	SETZB T3,T4
	SOUT			;start building text of mail
	SETO T2,
	MOVX T3,<OT%4YR!OT%SPA!OT%NSC!OT%NCO!OT%TMZ!OT%SCL> ; "12 Dec 1977 1906-PST"
	ODTIM
	HRROI T2,[ASCIZ /
From: DECnet mail process (VMAILR)
To: /]				;more text
	SETZB T3,T4
	SOUT
	MOVE T2,UNDJFN		;get bad mail JFN
	MOVX T3,<1B5>		;output directory name only
	SETZ T4,
	JFNS
	HRROI T2,[ASCIZ / at /] ;delimit node name
	SETZB T3,T4		; ..
	SOUT
	HRROI T2,NODNAM		;our node name
	SETZB T3,T4		; ..
	SOUT
	HRROI T2,[ASCIZ /
Subject: Undeliverable mail

I'm sorry, but your mail to /]
	SETZB T3,T4		;more noise
	SOUT
	MOVE  T2,UNDJFN
	MOVX  T3,<1B11>		;type extension (host name)
	SETZ  T4,
	JFNS
	HRROI T2,[ASCIZ /, which was queued for
transmission /]
	SETZB T3,T4
	SOUT
	MOVEM T1,TEMPT1		; Save notification JFN for a moment
	HRRZ  T1,UNDJFN		; JFN of queued mail
	MOVE  T2,[1,,.FBWRT]	; Get last write date
	MOVEI T3,T2		; Into T2
	GTFDB			;  ..
	MOVX  T3,<OT%4YR!OT%SPA!OT%NSC!OT%NCO!OT%TMZ!OT%SCL> ; "12 Dec 1977 1906-PST"
	MOVE  T1,TEMPT1		; Write date/time into message
	ODTIM
	HRROI T2,[ASCIZ /, encountered problems because:
/]
	SETZB T3,T4
	SOUT			;header now done
	HRROI T2,ERRMSG		;now type the error message
	SOUT
	HRROI T2,[ASCIZ /

You may use the REPAIR command in MS to correct the problem
and resubmit the mail.  If the problem was a user or users being
over quota, then all other users have received copies of the message.
Otherwise, nobody on the host named above has received the message.
   --------
/]
	SOUT
	CLOSF
	 YECCH<Can't CLOSF MAIL.CPY>
	MOVE T4,[IORM T3,FLGADR(T1)] ; light it (in case not lit now)
	HRRZ T1,OURDIR		;get directory number
	IDIVI T1,^D36		;get word number in DECNET-MAILER.FLAGS
	MOVSI T3,400000		;bit zero
	MOVN T2,T2		;negate bit number
	LSH T3,(T2)		;position bit correctly
	XCT T4			; light or clear it appropriately
	RET
	ENDSV.			;[342] {UNDJFN,CPYJFN,OURDIR,TEMPT1,STRNG1}
;Table of reasons for disconnection from net link

REASON:	[ASCIZ /No special error/]			;0
	[ASCIZ /Resource allocation failure/]		;1
	[ASCIZ /Destination node does not exist/]	;2
	[ASCIZ /Node shutting down/]			;3
	[ASCIZ /Destination process does not exist/]	;4
	[ASCIZ /Invalid name field/]			;5
	[ASCIZ /Destination process queue overflow/]	;6
	[ASCIZ /Unspecified error/]			;7
	[ASCIZ /Third party aborted the logical link/]	;8
	[ASCIZ /User abort/]				;9
	FUNNY						;10
	[ASCIZ /Undefined error code/]			;11
	FUNNY						;12
	FUNNY						;13
	FUNNY						;14
	FUNNY						;15
	FUNNY						;16
	FUNNY						;17
	FUNNY						;18
	FUNNY						;19
	FUNNY						;20
	[ASCIZ /Connect initiate with illegal destination address/] ;21
	FUNNY						;22
	FUNNY						;23
	[ASCIZ /Flow control violation/]		;24
	FUNNY						;25
	FUNNY						;26
	FUNNY						;27
	FUNNY						;28
	FUNNY						;29
	FUNNY						;30
	FUNNY						;31
	[ASCIZ /Too many connections to node/]		;32
	[ASCIZ /Too many connections to destination process/] ;33
	[ASCIZ /Access not permitted/]			;34
	[ASCIZ /Logical link services mismatch/]	;35
	[ASCIZ /Invalid account/]			;36
	[ASCIZ /Segment size too small/]		;37
	[ASCIZ /Process aborted/]			;38
	[ASCIZ /No path to destination node/]		;39
	[ASCIZ /Link aborted due to data loss/]		;40
	[ASCIZ /Destination logical link address does not exist/] ;41
	[ASCIZ /Confirmation of disconnect initiate/]	;42
	[ASCIZ /Image data field too long/]		;43
NREASN==.-REASON

FUNNY:	ASCIZ /Unknown DECnet disconnect reason code/


	END BEGIN