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

	TITLE NMAIL - DECNET mail listener

	SUBTTL Larry Campbell

	SEARCH MACSYM,MONSYM
	.REQUIRE SYS:MACREL
	SALL
	.DIRECTIVE FLBLST

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

.VER==5
.EDT==^D149

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

;Macros

DEFINE JERR(STRING),<
	XLIST
	ERJMP [	HRROI T1,[ASCIZ /NMAIL error: /]
		ESOUT
		HRROI T1,[ASCIZ /STRING/]
		PSOUT
		HRROI T1,[ASCIZ / because: /]
		PSOUT
		MOVX T1,.PRIOU
		HRLOI T2,.FHSLF
		ERSTR
		 JFCL
		 JFCL
		CALL LGCRLF
		CALL DTSTMP	;; log this lossage also
		LOG <STRING>
		LOG < because: >
		MOVE T1,LOGJFN
		HRLOI T2,.FHSLF
		ERSTR
		 JFCL
		 JFCL
		JRST FATAL]
	LIST
>

DEFINE LOG(STRING),<		;; put message into log file
	XLIST
	HRROI T1,[ASCIZ \STRING\] ;; so it can type slashes
	CALL LOGMSG
	LIST
>

DEFINE NTMSG(STRING),<		;; type at network link
	XLIST
	LOG <STRING>
	MOVE T1,NETJFN
	HRROI T2,[ASCIZ /STRING/]
	SETZB T3,T4
	SOUTR
	 ERJMP [CALL LGCRLF	;; log this failure
		CALL DTSTMP
		LOG <SOUT to net link failed because: >
		MOVE T1,LOGJFN
		HRLOI T2,.FHSLF
		ERSTR
		 JFCL
		 JFCL
		JRST DMPLNK]	;; dump net link and reset world
	LIST
>

DEFINE ETMSG(STRING),<		;; type error message at net link
	XLIST
	NTMSG <?NMAIL error: 'STRING>
	LIST
>

DEFINE DIE(STRING),<		;; fatal internal error
	XLIST
	JRST [	HRROI T1,[ASCIZ /NMAIL fatal internal error: /]
		ESOUT
		HRROI T1,[ASCIZ /STRING/]
		PSOUT
		HRROI T1,[ASCIZ /
/]
		PSOUT
		CALL LGCRLF	;; log this error
		CALL DTSTMP	;; time stamp it
		HRROI T1,[ASCIZ /Fatal error: /]
		CALL LOGMSG
		HRROI T1,[ASCIZ /STRING/]
		CALL LOGMSG
		JRST FATAL]
	LIST
>

DEFINE HERALD(VER,EDT),<
	XLIST
	TMSG <NMAIL version VER(EDT) running>
	HRROI T1,[ASCIZ /NMAIL version VER(EDT) running/]
	CALL LOGMSG
	LIST
>

DEFINE LOG(STRING),<
	XLIST
	HRROI T1,[ASCIZ \STRING\]
	CALL LOGMSG
	LIST
>

DEFINE FIND(STRING),<		;; search for the given string
	XLIST
	MOVE T1,[POINT 7,[ASCIZ /STRING/]]
	CALL FINDIT		;; call string compare routine
	LIST
>

;In case of old monitor

IFNDEF IOX34,<
	PRINTX %IOX34 not defined in this monitor but don't worry about it
	IOX34==777777
>

;Storage

NATMBF==40			; length of atom buffer in words
BBFLEN==200000			; length of big buffer into which mail is read
NFRMBF==20			; length of sender name buffer
TIMEN==^D900000			; Milliseconds before sender declared tardy
STKLEN==200			; size of stack

ATMBUF:	BLOCK NATMBF
BIGBUF:	BLOCK BBFLEN		; where mail is read into
ULIST:	BLOCK ^D200		; where to store mailbox directory numbers
FRMMSG:	BLOCK 20		; string to type on recipient's terminal
FRMBUF:	BLOCK NFRMBF		; where to put sender's name
HSTNAM:	BLOCK 2			; our host name
GTINF:	BLOCK 20		; GETJI block
STACK:	BLOCK STKLEN		; one stack for each fork
NETJFN:	BLOCK 1			; network link JFN
LOGJFN:	BLOCK 1			; log file JFN
NTIME:	BLOCK 1			; time receipt of mail initiated (for stats)
PAPERF:	BLOCK 1			; -1 => Paper mail was queued
IOFNAM:	BLOCK 10		; "Interoffice-mail-<local-hostname>"
ELPTIM:	BLOCK 1			; elapsed time for receipt of mail
BYTCNT:	BLOCK 1			; length of mail in bytes
DLVLST:	BLOCK 1			; -1 => delivery list exists
MSGPTR:	BLOCK 1			; Pointer to message
CAPENB:	BLOCK 1			; saved capabilities
PC1:	BLOCK 1			; PC save locations for PSI code
PC2:	BLOCK 1
PC3:	BLOCK 1
LEVTAB:	PC1
	PC2
	PC3
CHNTAB:	2,,CONECT		; connect initiate on level 2
	1,,TIMOUT		; timeout PSI on level 1
	XLIST			; nothing else
	REPEAT ^D34,<EXP 0>
	LIST

NMAIL::	RESET
	MOVE P,[-STKLEN,,STACK]
	MOVE T1,[SIXBIT /NMAIL/]
	MOVE T2,[SIXBIT /NMAIL/]
	SETSN			; declare our name for statistics
	 JFCL
	MOVX T1,.NDGLN		; get local node name function
	MOVE T2,[POINT 7,HSTNAM]
	MOVEM T2,1(P)		; put pointer on stack
	MOVEI T2,1(P)		; and point to it
	NODE			; get node name
	 JERR <Can't get local node name>
	HRROI T1,IOFNAM		; Build interoffice mail handler name
	HRROI T2,[ASCIZ /Interoffice-mail-/]
	SETZB T3,T4		; First part
	SOUT
	MOVEM T1,1(P)		; Save on stack
	MOVEI T2,1(P)
	MOVX T1,.NDGLN		; Get local node name function
	NODE
	 JERR <Can't get local node name>
	MOVX T1,.FHSLF		; this process
	MOVE T2,[LEVTAB,,CHNTAB]
	SIR			; init PSI system
	EIR
	CALL OPNLOG		; open log file
	MOVEM T1,LOGJFN		; save JFN
	CALL DTSTMP		; time stamp it
	HERALD \.VER,\.EDT
	LOG< on node >
	TMSG < on node >
	HRROI T1,HSTNAM
	PSOUT
	TMSG <
>
	HRROI T1,HSTNAM
	CALL LOGMSG
	CALL LGCRLF		; CRLF to log file
	MOVE T1,LOGJFN		; close log file for perusers
	CLOSF
	 JFCL
NMAIL0:	CALL OPNLSN		; open connection and set interrupt up
	WAIT			; for connect initiate

;Here when connection initiated

CONECT:	MOVE P,[-STKLEN,,STACK]	; reset stack
	CALL TIMEIT		; time this guy
	CALL OPNLOG		; open log file
	MOVEM T1,LOGJFN
	CALL DTSTMP		; time stamp this transaction
	LOG <----Connect from >
	CALL T4NHST		; type foreign host name at log file
	CALL LGCRLF		; log a CRLF
	MOVE T1,NETJFN		; accept connection
	MOVX T2,.MOCC
	SETZB T3,T4		; no additional data
	MTOPR
	 JERR <Couldn't accept net connection>
	MOVX T1,.HPELP		; elapsed time since system startup
	HPTIM			; snarf it
	 JERR <HPTIM failed>
	MOVEM T1,NTIME		; remember time this reception started
	CALL RDMAIL		; read the mail from foreign host
	 JRST ERRXIT
	MOVX T1,.HPELP		; read clock again
	HPTIM
	 JERR <HPTIM failed>
	SUB T1,NTIME		; time this transaction took
	MOVEM T1,ELPTIM		; remember it
	CALL PARSE		; parse the mail
	 JRST ERRXIT		; failed, quit now
	CALL DTSTMP		; time stamp log
	LOG <Message from >
	HRROI T1,FRMBUF		; sender's name
	CALL LOGMSG		; log it
	LOG < received
>
	CALL LSTATS		; log statistics
	CALL MAILIT		; send the mail off
	 DIE <Failure return from MAILIT>

ERRXIT:	CALL CLZNET		; close and reopen net link
	CALL CNCLTM		; cancel timeout request
	CALL DTSTMP
	LOG <----Connection closed
>
	MOVE T1,LOGJFN
	CLOSF			; close log file for perusers
	 JFCL
	DEBRK			; return to background

;Parse mail received.  Place sender name in FRMBUF, recipient directory
; numbers in ULIST, terminated with a zero entry
; Headers must appear in the following order:
; 			From, To, cc
; Returns +1: failure
;	  +2: success

PARSE:	STKVAR <DLVPTR,SPTR,SCNT>
	SETZM PAPERF		; No paper mail yet
	SETZM DLVPTR
	MOVE T1,[POINT 7,BIGBUF]
	MOVEM T1,MSGPTR
	MOVSI P1,-^D100		; Maximum destinations allowed
	MOVEM PTR,SPTR		; Save context
	MOVEM CNT,SCNT		;  ..
	FIND <Deliver-to:>	; Overriding delivery list exist?
	 JRST PARSE0		; No, nothing special then
	CALL PARSE5		; Yes, parse it for addresses then
	 RET			; Failure, pass it on up
	MOVNI T1,1		; Back up the pointer one
	ADJBP T1,PTR		;  ..
	MOVEM T1,DLVPTR		; Flag that this occurred
PARSE0:	FIND <From:>		; find sender
	 JRST [	CALL SKPLIN		; not on this line, try next
		 JRST [	CALL DTSTMP 		; time stamp log file
			ETMSG <Can't find "From:" field>
			CALL LGCRLF
			RET]			; failure return
		JRST PARSE0]		; try next line
	SETZM FRMBUF		; clear sender name area
	MOVE T1,[FRMBUF,,FRMBUF+1]
	BLT T1,FRMBUF+NFRMBF-1	;  ..
	CALL SKPBLK		; skip white space
	 RET			; text exhausted
	MOVE T1,PTR		; copy current pointer into mail
	MOVE T2,[POINT 7,FRMBUF] ; copy rest of this line into FRMBUF
	CALL CPYLIN		;  ..
	SKIPE T1,DLVPTR		; Overriding delivery list specified?
	JRST [	MOVEM T1,MSGPTR		; Yes, skip over it then
		RETSKP]			; Return now
	MOVE PTR,SPTR		; Restore context
	MOVE CNT,SCNT		;  ..

PARSE2:	FIND <To:>		; find "To:" list
	 SKIPA			; Not there
	JRST PARSE3		; OK, eat it up
	FIND <Redistributed-to:> ; Maybe this flavor?
	 SKIPA			; Nope
	JRST PARSE3		; Win!
	FIND <Circulate-next:>	; Maybe this flavor?
	 JRST [	CALL SKPLIN		; not on this line, try next
		 JRST [	CALL DTSTMP		; none found, complain
			ETMSG <Can't find "To: field>
			CALL LGCRLF
			RET]			; failure return
		JRST PARSE2]		; go try again
;	JRST PARSE3

;Here to parse "To:" list

PARSE3:	CALL PRSUSR		; get a username
	 JRST [	CALL DTSTMP		; none found, complain
		ETMSG <Invalid username in "To:" list: >
		MOVE T1,NETJFN
		HRROI T2,ATMBUF		; tell user what lost
		SETZB T3,T4
		SOUTR
		HRROI T1,ATMBUF		; also log losing name
		CALL LOGMSG
		CALL LGCRLF
		RET]			; failure return
	JUMPE T1,PARSE4		; dirnum=0 means list exhausted
	MOVEM T1,ULIST(P1)	; save this directory number
	AOBJN P1,PARSE3		; go for more
	CALL DTSTMP		; woops, too many
	ETMSG <Too many user names in "To:" list, truncated at >
	MOVE T1,NETJFN
	HRROI T2,ATMBUF		; tell him last name accepted
	SETZB T3,T4
	SOUTR
	HRROI T1,ATMBUF		; also tell log file
	CALL LOGMSG
;	JRST PARSE4

; continue parsing header...

PARSE4:	FIND <cc:>
	 JRST [	FIND <Redistributed-cc:>
		 JRST PARSE6		; absence of CC list is OK
		JRST .+1]
PARSE5:	CALL PRSUSR		; get a user name
	 JRST [	CALL DTSTMP		; garbage
		ETMSG <Invalid user name in "cc:" list >
		MOVE T1,NETJFN		; tell him what lost
		HRROI T2,ATMBUF
		SETZB T3,T4
		SOUTR
		HRROI T1,ATMBUF		; and log it
		CALL LOGMSG
		CALL LGCRLF
		RET]			; failure return
	JUMPE T1,PARSE6		; all done
	MOVEM T1,ULIST(P1)	; store another recipient dirnum
	AOBJN P1,PARSE5		; go round for more
	CALL DTSTMP		; too many
	ETMSG <Too many names in "cc:" list, truncated at >
	MOVE T1,NETJFN
	HRROI T2,ATMBUF
	SETZB T3,T4
	SOUTR
	HRROI T1,ATMBUF
	CALL LOGMSG

PARSE6:	SETZM ULIST(P1)		; tie off recipient list
	MOVE T1,PTR		; get current pointer
	SKIPE PAPERF		; Any paper queued out?
	RETSKP			; Yes, don't worry if no electric recipients
	TRNN P1,-1		; any recipients specified?
	JRST [	CALL DTSTMP		; no, log failure
		ETMSG <No recipients on this host specified>
		CALL LGCRLF
		RET]
	RETSKP			; all done!

;Parse user name, ignoring if not on this host
;Returns +1: source exhausted or garbage in line
;	 +2: OK, T1 has dirnum of user or zero if list exhausted

PRSUSR:	CALL SKPBLK		; skip white space
	 RET			; text exhausted, quit
	LDB T1,PTR		; get nonblank char
	CAIN T1,74		; Open angle bracket?
	JRST [	CALL GETCHR		; Yes, eat it up
		 RET
		JRST PRSUS1]		; Go parse the mailbox name
	CAIN T1,.CHLFD		; EOL?
	JRST [	CALL GETCHR		; Yes, skip it
		 RET			; Quit if text gone
		CAIE T1,40		; Does next line start with space
		CAIN T1,11		;  or tab?
		JRST PRSUSR		; Yes, it's a continuation line
		SETZ T1,		; No, indicate list exhausted
		RETSKP]
	CAIN T1,";"		; Address list terminator?
	JRST [	CALL GETCHR		; Yes, skip it
		 RET			; Text exhausted, pass failure up
		JRST PRSUSR]		; Try again
	CAIN T1,","		; Comma?
	JRST [	CALL GETCHR		; yes, skip it
		 RET			; source gone, quit
		CALL SKPBLK		; skip blanks
		 RET			; text gone, quit
		LDB T1,PTR		; get first nonblank char
		CAIN T1,.CHLFD		; EOL?
		JRST [	CALL SKPLIN		; yes, list cont'd on next line
			 RET			; text gone, error
			JRST PRSUSR]		; parse next line
		JRST .+1]		; not new line, keep parsing this one

;We now should be looking at the beginning of a mailbox name

PRSUS1:	CALL GETTOK		; get token
	 RET			; text exhausted, quit
	CALL SKPBLK		; skip blanks
	 RET			; text gone, quit
	LDB T1,PTR		; Get terminator
	CAIN T1,74		; Open angle bracket (start of mailbox name)?
	JRST [	CALL GETCHR		; Yes, flush it and continue
		 JFCL
		JRST PRSUSR]
	FIND <:>		; Address list name?
	 SKIPA			; No, keep looking
	  JRST PRSUSR		; Yes, just ignore it
	FIND <@>		; look for node name separator
	 SKIPA			; not this kind
	  JRST PRSUS2		; found old style separator
	FIND <at>		; look for fancy separator
	 JRST PRSUSR		; none of the above, keep trying
	LDB T1,PTR		; get terminator
	CAIE T1," "		; "at" should be followed by space
	RET			; it isn't, problem
	CALL GETCHR		; it is, eat the space
	 RET			; text gone

;OK, now have found a network address.  See if host name is our name.

PRSUS2:	CALL PRSHST		; see if this is for us
	 RET			; text exhausted, quit
	JUMPE T1,PRSUSR		; not us, try next name in list
	MOVE T2,[POINT 7,ATMBUF] ; Point to username
	MOVE T3,T2		; Make temp copy of ptr
	ILDB T1,T3		; Get first char of username
	CAIE T1,42		; Is this a quoted string?
	JRST PRSUS5		; No, do normal thing
PRSUS3:	ILDB T1,T3		; Yes, unquote it
	JUMPE T1,PRSUS4		; End of text?
	CAIN T1,42		; Or found matching close quote yet?
	JRST PRSUS4		; Yes, go finish up
	IDPB T1,T2		; No, move this byte up
	JRST PRSUS3
PRSUS4:	SETZ T1,
	IDPB T1,T2		; Insure ASCIZ
	HRROI T2,ATMBUF		; Point at dequoted string
PRSUS5:	MOVX T1,RC%EMO		; see if we know about this guy
	RCUSR 			;  ..
	 ERJMP R		; bad syntax in username
	TXNE T1,RC%NOM		; match found?
	JRST R			; no, bad return
	MOVE T1,T3		; return user number in T1
	RETSKP

;Parse host name, check to see if local host
;Returns +1: text exhausted
;	 +2: T1/ -1 => local host, 0 => not for this host
;If host name is "Interoffice-mail", queues message to line printer
; so operator can rip it off and put it in the mail

PRSHST:	MOVE T1,[POINT 7,HSTNAM]
	CALL FINDIT		; find host name
	 JRST PRSHS1		; not found, skip to end of this username
	CALL SKPBLK		; eat spaces
	 RET
	SETZ T1,
	LDB T2,PTR		; found, terminator must be comma, EOL, or
	CAIN T2,";"		;  semicolon
	SETO T1,
	CAIE T2,","
	CAIN T2,.CHLFD
	SETO T1,		; Indicate success
	CAIN T2,76		; Trailing close of mailbox stuff OK too
	JRST [	CALL GETCHR		; eat the wedge though
		 JFCL
		SETO T1,
		JRST .+1]
	RETSKP			; return OK

;Not this host, see if destined for paper mail system

PRSHS1:	MOVE T1,[POINT 7,IOFNAM]
	CALL FINDIT		; Is this "Interoffice-mail-<local-node>"?
	 JRST PRSHS2		; Nope -- just ignore this one, then
	CALL PAPER		; Yes, print paper
				; Fall thru to skip this address
PRSHS2:	CALL SKPBLK		; skip blanks
	 RET
	LDB T1,PTR		; eat stuff until comma or EOL
	CAIE T1,","
	CAIN T1,.CHLFD
	JRST [	SETZ T1,		; indicate failure
		RETSKP]			; return
	CALL GETCHR		; next char
	 RET			; text gone, pass failure on up
	JRST PRSHS2



;Skip to first nonblank char in mail
;Returns +1: text exhausted
;	 +2: OK, PTR points at first nonblank character

SKPBLK:	LDB T1,PTR		; get char
	CAIN T1,""		; ignore control-Vs
	JRST SKPBL1
	CAIE T1,.CHCRT		; ignore returns
	CAIN T1," "		;  and blanks
	SKIPA
	RETSKP
SKPBL1:	CALL GETCHR		; skip to next
	 RET			; text gone, error
	JRST SKPBLK

;Here to queue paper copy of message out -- recipient
; isn't on electronic mail, so paper must be printed and mailed

PAPER:	PUSH P,PTR		; Don't disturb byte pointer or count
	PUSH P,CNT		;  ..
	MOVX T1,GJ%SHT		; Try to get the lowercase line printer
	HRROI T2,[ASCIZ /LL:Interoffice-mail/]
	GTJFN
	 ERJMP [MOVX T1,GJ%SHT		; Try for any old printer, then
		HRROI T2,[ASCIZ /LPT:Interoffice-mail/]
		GTJFN
		 ERJMP PAPERR
		JRST .+1]		; OK, got LPT, rejoin main flow
	MOVX T2,<070000,,0>+OF%WR	; Open for write
	OPENF
	 ERJMP PAPERR		; Oops... something's screwy
	SETOM PAPERF		; Remember paper printed
	HRROI T2,[ASCIZ /


	I n t e r o f f i c e    M a i l


To:

/]				; Print header
	SETZB T3,T4
	SOUT
	 JERR <Output to line printer failed>
	HRROI T2,ATMBUF		; Name of recipient
	SOUT			; Write it
	 JERR <Output to line printer failed>
	PUSH P,T1		; Save LPT JFN for a bit
	CALL DTSTMP		; Log this recipient
	LOG <Paper mail queued for >
	HRROI T1,ATMBUF		; Write address
	CALL LOGMSG
	CALL LGCRLF
	POP P,T1		; Restore LPT JFN
	HRROI T2,[ASCIZ /

From:

/]
	SOUT
	 JERR <Output to line printer failed>
	HRROI T2,FRMBUF		;  Write name of sender
	SOUT
	 JERR <Output to line printer failed>
	HRROI T2,[ASCIZ /

Printed by and mailed from DECSYSTEM-20 /]
	SOUT
	 JERR <Output to line printer failed>
	HRROI T2,HSTNAM		; Our name
	SOUT
	 JERR <Output to line printer failed>
	MOVEI T2,14		; New page
	BOUT
	HRROI T2,[ASCIZ /
	
+---------------+
! d i g i t a l !    I n t e r o f f i c e    M e m o r a n d u m
+---------------+



/]
	SOUT
	HRROI T2,BIGBUF		; Now output the text of the message
	SOUT
	 JERR <Output to line printer failed>
	CLOSF
	 JERR <Can't close line printer>
PAPERX:	POP P,CNT
	POP P,PTR
	RET


;Can't open LPT -- complain to other end of link, and to log file

PAPERR:	CALL DTSTMP		; Time stamp log file
	ETMSG <Can't generate paper mail for >
	MOVE T1,NETJFN
	HRROI T2,ATMBUF
	SETZB T3,T4		; Complain
	SOUTR
	HRROI T1,ATMBUF
	CALL LOGMSG		; Log file, too
	CALL LGCRLF
	JRST PAPERX		; Quit now

;Skip to beginning of next line
;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


;Get one character from mail
;Returns +1: no more text left
;	 +2: OK, char eaten 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 a 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
;Returns +1: text exhausted
;	 +2: OK

GETTOK:	ACVAR <PTR1,CNT1>
	SETZM ATMBUF		; clear atom buffer
	MOVE T1,[ATMBUF,,ATMBUF+1]
	BLT T1,ATMBUF+NATMBF-1
	CALL SKPBLK		; skip blanks
	 RET			; text gone, quit
	MOVE PTR1,[POINT 7,ATMBUF]
	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 GETTK1		; No, do ordinary thing
GETTK6:	IDPB T1,PTR1		; Yes, start storing literally
GETTK7:	CALL GETCHR		; Get next chr
	 RET			; Text exhausted
	CAIE T1,42		; Close quote?
	JRST [	SOJG CNT1,GETTK6	; No, keep storing if room left
		JRST GETTK7]		; Else  just drop chars on floor
	IDPB T1,PTR1		; Yes, save close quote
	CALL GETCHR		; Skip it
	 RET			;  and fall thru to do rest of address

GETTK1:	CALL GTALPH		; get and uppercase alphanumeric char
	 RET
	JUMPE T1,GETTK2		; Nonalphanumeric
	IDPB T1,PTR1		; store
	SOJG CNT1,GETTK1	; go for more
	RETSKP			; return OK

GETTK2:	CAIE CNT1,^D132		; Did we find anything?
	RETSKP			; Yes, everything's cool then
	LDB T1,PTR		; No, 1st chr of name bad -- retrieve it
GETTK3:	IDPB T1,PTR1		; Save bad name for error message
GETTK4:	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,GETTK3	; Be careful not to overflow atom buffer
	JRST GETTK4		; Full, just toss chars into bit bucket now

;Get alphanumeric char from mail.  Ctrl-V, hyphen, apostrophe, dot,
; and underscore are considered alphanumeric.
;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		;  ..
	CAIE T1,"'"		; allow apostrophe
	CAIN T1,"-"		; allow hyphens
	JRST GTALP1		;  ..
	CAIE T1,"."		; also dots
	CAIN T1,""		;  and ctrl-Vs
	JRST GTALP1		;  ..
	CAIL T1,"A"		; uppercase alphabetic?
	CAILE T1,"Z"		;  ..
	SKIPA			;  no, check some more
	JRST GTALP1		; yes, pass it through
	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

;Here to read mail from net connection into BIGBUF.
;
; Returns +1: problem (timeout, data error, etc.)
;	  +2: OK, PTR and CNT inited

RDMAIL:	HRROI PTR,BIGBUF	; init byte pointer,
	SETZB CNT,P2		;  count, and error flag
	MOVEI P1,^D240		; Allow one minute to read each chunk

RDMAL1:	MOVE T1,NETJFN		; any input for us?
	SIBE			;  ..
	JRST [	MOVEI P1,^D240		; reset timer
		MOVE T3,T2		; put count in right AC for SIN
		JRST RDMAL2]		; and go snarf some text
	MOVEI T1,^D250		; wait one-fourth of a second
	DISMS
	SOJG P1,RDMAL1		; go try again
	CALL DTSTMP
	LOG <Timeout after >
	MOVE T1,LOGJFN
	MOVE T2,CNT		; Report progress
	MOVX T3,^D10
	NOUT
	 JFCL
	LOG < bytes.>
	CALL LGCRLF
	CALL DTSTMP
	ETMSG <Timed out waiting for input>
	CALL LGCRLF
	RET			; failure return

RDMAL2:	ADD CNT,T3		; keep track of byte count
	CAMLE CNT,[BBFLEN*5]	; buffer overflow pending?
	CALL [	HRROI PTR,BIGBUF	; just suck bits
		SKIPE P2		; noticed this already yet?
		RET			; yes, just rejoin loop
		PUSH P,T3		; preserve count
		CALL DTSTMP		; log the failure
		ETMSG <Mail too long>	; and tell the other end
		CALL LGCRLF
		SETO P2,		; remember that the error occurred
		POP P,T3		; restore byte count
		RET]			; rejoin main loop
	MOVE T1,NETJFN		; net link JFN
	MOVE T2,PTR		; current byte pointer
	SETZ T4,		; don't stop on any special byte
	SIN			; read some stuff
	 ERJMP [CAIE T1,IOX4		; end of file?
		DIE <Data error reading from net link> ; *** should be fancier
		JRST RDMAL3]		; yes, all done
	MOVE PTR,T2		; update byte pointer
	LDB T1,T2		; get terminating byte
	CAIE T1,177		; rubout?
	 JRST RDMAL1		; no, go for more input
	; ..

	; ..

RDMAL3:	SKIPE P2		; any errors?
	JRST R			; yes, failure return
	SETZ T1,		; insure ASCIZ
	DPB T1,T2		;  ..
	SUBI CNT,1		; don't count last character
	MOVE PTR,[POINT 7,BIGBUF,6]
	MOVEM CNT,BYTCNT	; save byte count
	RETSKP			; good return

;Here to actually append the mail to users' MAIL.TXT files
; Also types annoying messge on their terminal if they're logged in
;
; Returns +1: problems of some sort
;	  +2: OK

MAILIT:	HRROI T1,FRMMSG		; build annoying msg to splat across screens
	HRROI T2,[ASCIZ /
[You have a message from /]
	SETZB T3,T4
	SOUT
	HRROI T2,FRMBUF		; name of sender
	SOUT
	HRROI T2,[ASCIZ /]
/]
	SOUT
	SETZB P1,P2		; init index and failure flag

MAILT1:	MOVE T1,ULIST(P1)	; get next recipient
	JUMPE T1,MAILT2		; end of list
	CALL SENDIT		; use code stolen from MAILER to do it
	 SETO P2,		; remember that a failure occured
	AOJA P1,MAILT1

MAILT2:	SKIPE P2		; any problems?
	JRST RSKP		; yes, don't log success then
	SKIPN P1		; anything sent?
	JRST [	SKIPN PAPERF		; No, any paper printed?
		DIE <No mail sent at MAILIT>	; No, complain
		CALL DTSTMP		; Yes, log lack of local users
		LOG <No local electronic recipients>
		CALL LGCRLF
		JRST .+1]
	CALL DTSTMP		; log success
	NTMSG <sent OK>		; Send reassuring message to other end
	CALL LGCRLF		; CRLF the log file
	RETSKP

;Append mail to user's mail file
; Call with user number of recipient in T1

SENDIT:	ACVAR <W6>
	STKVAR <<GETSIZ,2>,EOFPTR,USRNO,<TEMP1,50>,TEMP2>
	MOVEM T1,USRNO		;save recipients user number
	HRROI T1,TEMP1		;where to build filespec string
	HRROI T2,[ASCIZ /PS:</]	;prefix
	SETZB T3,T4
	SOUT
	 JERR <SOUT failed at SENDR>
	MOVE W6,T1		;preserve string pointer
	CALL DTSTMP		;time stamp log file
	HRROI T1,[ASCIZ /Sending to /]
	CALL LOGMSG
	MOVE T1,LOGJFN		;write username to log file
	MOVE T2,USRNO		; ..
	DIRST
	 JERR <DIRST failure to log file>
	CALL LGCRLF		; CRLF to the log file
	MOVE T1,W6		;restore string pointer
	MOVE T2,USRNO		;get user number
	DIRST			;add user name
	 JERR <DIRST failure>
	HRROI T2,[ASCIZ />MAIL.TXT/]
	SETZB T3,T4
	SOUT
	 JERR <SOUT failed at SENDR 2>
	MOVX T1,GJ%SHT!GJ%DEL+1
	HRROI T2,TEMP1		;where filespec lives
	GTJFN
	 JERR <Can't GTJFN MAIL.TXT>	
	MOVEI W6,^D40		; Number of 1/2 sec. intervals to wait
;	JRST SENDT1

SENDT1:	MOVE T2,[070000,,300000]
	MOVE T3,T1		; Preserve JFN in case OPENF loses
	OPENF
	 ERJMP [CAIN T1,OPNX9		; Message file busy?
		SOJGE W6,[MOVEI T1,^D500	; Yes, if not too long,
			DISMS			; Wait 1/2 second
			MOVE T1,T3		; Restore JFN
			JRST SENDT1]		; And retry OPENF
		CALL DTSTMP
		ETMSG <Can't OPENF MAIL.TXT
>
		RET]			; Failure return
	MOVE T2,[2,,.FBBYV]	;GET 2 WORDS
	MOVEI T3,GETSIZ		;WHERE TO GET IT
	GTFDB			;READ FILE DATA
	LOAD T3,FB%BSZ,GETSIZ	;GET FILE BYTE SIZE
	CAIN T3,7		;ALREADY HAVE 7-BIT BYTE COUNT?
	JRST [	MOVE T2,1+GETSIZ	;YES, FETCH IT
		JRST SENDT2]		;SKIP FANCY GYRATIONS
	MOVEI T2,44		;NO, GET BITS PER WORD
	IDIVI T2,0(T3)		;COMPUTE TOTAL BYTES PER WORD
	EXCH T2,1+GETSIZ		;GET BYTES IN B
	IDIV T2,1+GETSIZ		;COMPUTE WORDS
	IMULI T2,5		;NOW COMPUTE # OF CHARACTERS
SENDT2:	MOVEM T2,EOFPTR		;SAVE IT
	SFPTR			;SET TO EOF
	 JFCL
	; ..

	; ..
	CALL CAPOFF		; disable caps, so quota is checked
	SETOM T2		;GET DATE AND TIME
	MOVSI T3,(OT%TMZ)	;IN THIS FORM
	ODTIM
	 ERJMP OVRQTA		;ERROR
	MOVEI T2,","
	BOUT			;SEPARATE TIME FROM COUNT
	 ERJMP OVRQTA		;ERROR
	RFPTR			;READ POSITION IN FILE
	 JFCL
	ADDI T2,6		;AT LEAST 6 DIGITS FOR COUNT
	IDIVI T2,5		;GET PART OF WORD IN C
	MOVNS T3		;GET NEGITIVE OF REMAINDER
	ADDI T3,5+6		;GET WIDTH OF COUNT FIELD
	HRL T3,T3		;GET IN RIGHT POSITION FOR NOUT
	TXO T3,NO%LFL!NO%ZRO	;PUT IN LEADING ZEROS
	MOVE T2,BYTCNT		;NUMBER OF CHARS
	HRRI T3,12		;IN DECIMAL
	NOUT
	 ERJMP OVRQTA		;ERROR
	HRROI T2,[ASCIZ /;000000000000
/]
	MOVEI T3,0		;PUT ON THE FLAG FIELD
	SOUT
	 ERJMP OVRQTA		;ERROR
	MOVE T2,MSGPTR		;Pointer to message
	MOVN T3,BYTCNT		;GET NEGATIVE byte COUNT
	SOUT			;WRITE ALL WORDS
	 ERJMP OVRQTA		;ERROR
	CALL CAPON		; enable again
	CALL UPDFIL		; Update file pages
	HRLI T1,.FBCTL		;CHANGE STATUS BITS
	MOVX T2,FB%DEL		;CHANGE DELETED BIT
	SETZ T3,		;MAKE IT A ZERO(UNDELETE)
	TXO T1,CF%NUD		;DONT'T UPDATE DIR (SFUST/CLOSF WILL)
	CHFDB			;DO IT
	MOVX T2,FB%PRM		;CHANGE PERMANENT BIT
	MOVX T3,FB%PRM		;TO BE SET
	CHFDB
	MOVEI T1,(T1)		;JFN ONLY
	MOVE W6,T1		; preserve JFN
	HRROI T1,TEMP1		; where to put string
	CALL QUOTE		; move ctrl-V'ed "from" string to TEMP1
	MOVE T1,W6		; restore JFN
	HRLI T1,.SFLWR		;set last writer
	HRROI T2,TEMP1		;sender string
	SFUST
	 JERR <SFUST failure>
	MOVEI T1,(T1)		;JFN only
	CLOSF			;CLOSSE THE OUTPUT FILE
	 JFCL
	; ..

;ROUTINE TO SEND MESSAGES TO ANY LOGGED IN USERS

	SETZ W6,		;INIT JOB NUMBER FOR SCAN
TOPDIR:	MOVEI T1,0(W6)		;JOB NUMBER
	MOVE T2,[-<.JICPJ-.JITNO+1>,,GTINF] ;GET VALUES FROM MONITOR
	MOVEI T3,.JITNO		;GET TERM # AND LOGGED IN DIR
	GETJI			;GET THEM
	ERJMP [	CAIN T1,GTJIX3	;OUT OF RANGE?
		JRST RSKP	;yes, all done -- success return
		AOJA W6,TOPDIR]	;NO. DO NEXT ONE THEN
	SKIPL <.JICPJ-.JITNO>+GTINF ;IS THIS A PTY?
	AOJA W6,TOPDIR		;YES. SKIP IT THEN
	DMOVE T1,GTINF		;GET GETJI DATA IN REGS
	JUMPL T1,[AOJA W6,TOPDIR] ;IF DETACHED, GO ON.
	CAME T2,USRNO		;IS THIS LOGGED INTO THE SAME DIR?
	AOJA W6,TOPDIR		;NO. SKIP IT THEN
	TRO T1,(1B0)		; MAKE IT A DEVICE DESIGNATOR
	RFMOD			; GET MODE BITS
	TXNE T2,TT%DAM		; IS HE IN ASCII?
	TXNN T2,TT%ALK		; IS HE ACCEPTING?
	AOJA W6,TOPDIR		;NO. DON'T TELL HIM THEN
	MOVEI T2,.MORNT		;SEE IF HE WANTS MESSAGES
	MTOPR
	JUMPN T3,INCDIR		;JUMP IF NO MESSAGE
	HRROI T2,FRMMSG		;GET MESSAGE BLOCK
	TTMSG			;SEND TO THIS USER
INCDIR:	AOJA W6,TOPDIR		;DO ALL JOBS


;Here to copy (and quote) "from" string into area pointed to by T1
; Quotes all characters (to save trouble of checking need for it)

QUOTE:	MOVE T2,[POINT 7,FRMBUF]
	TLC T1,-1		; lh of byte pointer all ones?
	TLCN T1,-1		;  ..
	HRLI T1,(POINT 7,)	; yes, make real byte pointer
	MOVEI T4,<24*5>-1	; maximum characters allowed in string
QUOTE1:	MOVEI T3,""		; quote character
	IDPB T3,T1		; stuff it
	ILDB T3,T2		; next char of source string
	IDPB T3,T1		; stuff it
	JUMPE T3,[MOVNI T2,1		; if zero, back up over last ctrl-V
		ADJBP T2,T1		;  ..
		DPB T3,T1		; wipe it out with null
		RET]			; and return
	SOJGE T4,QUOTE1		; insure no overflow
	DIE <QUOTE overflow>

;Routine to force write of pages just written in case of crash
;Call:	T1/ JFN
;Return +1: always

UPDFIL:	RFBSZ			; Get byte size
	 JFCL
	MOVEI T3,^D36		; Bits in a word
	IDIVI T3,(T2)		; Compute bytes in a word
	MOVEM T3,TEMP2		; Save for later
	RFPTR			; Get EOF pointer
	 JFCL
	IDIV T2,T3		; Compute words in file
	SKIPN T3		; Even number of words?
	SUBI T2,1		; Yes, don't cross over to nonex. page
	MOVE T3,EOFPTR		; Get original EOF pointer
	IDIV T3,TEMP2		; Compute original word count
	LSH T2,-^D9		; Compute page number just written
	LSH T3,-^D9		; Compute original last page number
	MOVE T4,T2		; Copy page no. just written
	SUBI T4,(T3)		; Pages written
	ADDI T4,1		; Plus one for partial page
	HRLZS T1		; JFN in LH for UFPGS
	HRRI T1,(T3)		; First page to update
	MOVEI T2,(T4)		; Page count
	TXO T2,UF%NOW		; Don't block
	UFPGS			; Write these pages to disk
	 JERR <UFPGS failure>
	HLRZS T1		; Restore T1 to good state
	RET			;  and return

;HERE ON QUOTA ERROR

;	T1/ JFN

OVRQTA:	CALL CAPON		; re-enable caps
	RFBSZ			;get current byte size
	 JFCL
	MOVEI T3,^D36		;compute bytes per word
	IDIVI T3,(T2)		; ..
	MOVEM T3,TEMP2		; save
	RFPTR			;GET CURRENT EOF POINTER
	 JFCL
	IDIV T2,TEMP2		;compute words
	LSH T2,-11		;MAKE IT A PAGE NUMBER
	MOVE T3,EOFPTR		;GET ORIGINAL POINTER
	IDIV T3,TEMP2		;compute word number
	LSH T3,-11		;GET PAGE NUMBER
	SUB T2,T3		;compute no. of pages added
	JUMPE T2,OVRQT2		;if none added, all set
	EXCH T3,T2		;put count in proper register
	TXO T3,1B0		;REPEAT COUNT FOR PMAP
	HRL T2,T1
	ADDI T2,1		;STARTING PAGE
	SETOM T1
	PMAP			;ZAP THE FILE PAGES
	HLRZ T1,T2		;JFN AGAIN

;Extra pages now deleted.  Set byte count in FDB

OVRQT2:	HRLI T1,.FBBYV		;word containing byte size
	MOVX T2,FB%BSZ		;set byte size
	MOVX T3,FLD(7,FB%BSZ)	; to 7 bits
	CHFDB			;if failed, quit now
	 ERJMP OVRQT0
	HRLI T1,.FBSIZ		;set size of file
	SETO T2,		; entire word
	MOVE T3,EOFPTR		; to original count
	CHFDB			;zap
	 JFCL
OVRQT0:	CLOSF			;CLOSE THE FILE
	 JFCL
	CALL DTSTMP		; pretty up the log file
	MOVX T1,.FHSLF		;Get last TOPS20 error
	GETER			; ..
	HRRZS T2		;Error code only please
	CAIN T2,IOX11		;Over quota?
	JRST OVRQT1		;Yes, go handle that
	CAIN T1,IOX34		;Disk structure completely full?
	JRST OVRQT3		;Yes, go handle that
	ETMSG <Unexpected JSYS error: >
	MOVE T1,LOGJFN		;Where error string will go
	HRLOI T2,.FHSLF		;Most recent error
	SETZ T3,
	ERSTR
	 JFCL
	 JFCL
	NTMSG <
>
	CALL DTSTMP
	ETMSG <Error occurred sending to user >
	MOVE T1,NETJFN
	MOVE T2,USRNO
	DIRST
	 JERR <DIRST failure>
	MOVE T1,LOGJFN
	DIRST
	 JERR <DIRST failure>
	NTMSG <
>
	RET
OVRQT1:	ETMSG <User >
	MOVE T1,NETJFN
	MOVE T2,USRNO
	DIRST
	 JERR <DIRST failure>
	MOVE T1,LOGJFN
	DIRST
	 JERR <DIRST failure>
	NTMSG < over quota, not sent.
>
	RET
OVRQT3:	NTMSG <%Disk structure completely full, try again later
>
	RET

;Open log file

OPNLOG:	MOVX T1,GJ%SHT		; Try logical name first
	HRROI T2,[ASCIZ /DECNET-LOG:NMAIL.LOG/]
	GTJFN
	 ERCAL [MOVX T1,GJ%SHT		; failed, write onto SYSTEM:
		HRROI T2,[ASCIZ /SYSTEM:NMAIL.LOG/]
		GTJFN
		 ERJMP OPNERR
		RET]
	MOVX T2,<070000,,0>+OF%APP
	OPENF			; Open for append
	 ERJMP OPNERR
	HRRZ T1,T1		; Return JFN only
	RET

OPNERR:	HRROI T1,[ASCIZ /NMAIL: Can't open log file because: /]
	ESOUT
	MOVX T1,.PRIOU
	HRLOI T2,.FHSLF
	ERSTR
	 JFCL
	 JFCL
	JRST FATAL

;Time stamp log file

DTSTMP:	MOVE T1,LOGJFN
	SETO T2,		; current time
	SETZ T3,		; default format
	ODTIM
	 ERJMP [HRROI T1,[ASCIZ /NMAIL: ODTIM failed: /]
		ESOUT
		MOVX T1,.PRIOU
		HRLOI T2,.FHSLF
		ERSTR
		 JFCL
		 JFCL
		TMSG <
DTSTMP called from >
		MOVX T1,.PRIOU		; type PC of caller on terminal
		HRRZ T2,(P)
		MOVX T3,^D8		; in octal
		NOUT
		 JFCL
		JRST FATAL]		; go fire up the world again
	MOVEI T2," "		; space
	BOUT
	RET

;Write ASCIZ string pointed to by T1 to log file

LOGMSG:	MOVE T2,T1		; copy string pointer
	MOVE T1,LOGJFN
	SETZB T3,T4
	SOUT
	 JERR <Can't write to log file>
	RET


;CRLF to log file

LGCRLF:	MOVE T1,LOGJFN
	MOVEI T2,15
	BOUT
	 JERR <Can't write to log file>
	MOVEI T2,12
	BOUT
	 JERR <Can't write to log file>
	RET


;Write statistics to log file

LSTATS:	STKVAR<ELPTM0>
	CALL DTSTMP
	MOVE T1,LOGJFN
	MOVE T2,ELPTIM		; elapsed time for mail receipt
	FLTR T2,T2		; float it
	FDVR T2,[100000.0]	; compute seconds
	MOVX T3,<1B1+FL%ONE+FL%PNT+4B23+3B29>
	FLOUT			; type seconds
	 JFCL
	MOVEM T2,ELPTM0		; save time
	LOG < seconds, >
	MOVE T1,LOGJFN
	MOVE T2,BYTCNT		; byte count
	MOVX T3,^D10		; base 10
	NOUT
	 ERJMP [HALTF]
	LOG < chars,>
	MOVE T1,LOGJFN
	FLTR T2,BYTCNT		; float byte count
	FDVR T2,ELPTM0		; compute bytes per second
	MOVX T3,<1B1+FL%ONE+FL%PNT+5B23+3B29>
	FLOUT
	 JERR <FLOUT failure>
	LOG < chars/sec.
>
	RET

;Close net connection and reopen it.  Re-enable for interrupts
; on connect initiate messages

CLZNET:	MOVEI T1,^D4000		; Give pipe four seconds to empty
	DISMS			;  ..
	MOVE T1,NETJFN		; normal close
	CLOSF
;	 JERR <Badness while closing NET connection>
	 ERJMP [CALL DTSTMP		; We should complain about these
		LOG <%Close error for net link: >
		MOVE T1,LOGJFN
		HRLOI T2,.FHSLF
		ERSTR
		 JFCL
		 JFCL
		CALL LGCRLF
		MOVE T1,NETJFN
		TXO T1,CZ%ABT		; Try real hard to close it
		CLOSF			;  so we don't eat all job 0 JFNs
		 JFCL
		MOVE T1,NETJFN
		RLJFN
		 JFCL
		JRST .+1]
	CALL OPNLSN		; open connection again
	RET			; return


;Open the net connection and listen for connect initiates

OPNLSN:	MOVX T1,GJ%SHT
	HRROI T2,[ASCIZ /SRV:201/]	;magic number for MAIL server
	GTJFN
	 JERR <Can't get net JFN for server>
	MOVX T2,OF%RD!OF%WR!<070000,,0>	;7-bit bytes
	OPENF
	 JERR <Can't open net JFN>
	MOVEM T1,NETJFN		;save it
	MOVX T2,.MOACN		;enable for PSI on network transitions
	MOVX T3,0B8+<.MOCIA>B17+<.MOCIA>B26	;channel zero
	MTOPR
	MOVX T1,.FHSLF
	MOVX T2,1B0		;activate channel zero
	AIC
	RET


;Log name of foreign host

T4NHST:	TRVAR <<HSTNM,2>>	;host names should be short
	SETZM HSTNM		;zero this string
	SETZM 1+HSTNM		; ..
	MOVE T1,NETJFN		;get net JFN
	MOVX T2,.MORHN		;return host name
	HRROI T3,HSTNM		;where to put it
	MTOPR
	 ERJMP [HRROI T1,[ASCIZ /UNKNOWN-HOST/]
		CALL LOGMSG
		RET]		;log confusion
	HRROI T1,HSTNM		;copy name to log file
	CALL LOGMSG		; ..
	RET

;Set up to time out if network too slow

TIMEIT:	MOVE T1,[.FHSLF,,.TIMEL]
	MOVE T2,[TIMEN]		; Milliseconds to allow
	MOVEI T3,1		; channel one
	TIMER
	 JERR <Can't time myself>
	MOVX T1,.FHSLF		; activate timer channel
	MOVX T2,<1B1>
	AIC
	RET

;Cancel above timer request

CNCLTM:	MOVE T1,[.FHSLF,,.TIMAL] ; remove all pending TIMER requests
	MOVEI T3,1		; for this channel
	TIMER
	 JERR <Can't remove pending TIMER request>
	RET


;Here on timeout

TIMOUT:	CALL DTSTMP
	ETMSG <Mail taking too long to come in>
	JRST FATAL

;Here if net link dies while outputting to it

DMPLNK:	CIS			; Zap things
	CALL LGCRLF		; log a CRLF
	MOVEI T1,^D4000		; Wait four seconds (seems like a good idea)
	DISMS
	MOVX T1,CZ%ABT		; abort the net JFN
	HRR T1,NETJFN		;  ..
	CLOSF			;  ..
	 JFCL			; don't care
	CALL DTSTMP
	LOG <----Connection aborted
>
	MOVX T1,.FHSLF		; deactivate connect initiate channel
	MOVX T2,<1B0>		;  ..
	DIC			;  ..
	CALL CNCLTM		; cancel pending timer requests
	MOVE T1,LOGJFN		; Close log file
	CLOSF
	 JFCL
	JRST NMAIL0		; go wait for new mail


;Here on fatal wipeout (JSYS which can't fail does, for instance)

FATAL:	MOVX T1,.FHSLF
	DIR			; disable interrupts
	CIS			; clear interrupts
	MOVE T1,NETJFN		; type a record to force net buffers out
	HRROI T2,[ASCIZ /
?NMAIL internal error/] 
	SETZB T3,T4		; add question mark so mail isn't requeued
	SOUTR			;  ..
	 ERJMP .+1
	MOVEI T1,^D5000		; wait five seconds
	DISMS
	MOVX T1,.FHSLF		; abort all JFNs
	CLZFF			;  ..
	CALL OPNLOG		; reopen log file
	MOVEM T1,LOGJFN
	CALL LGCRLF
	CALL DTSTMP
	LOG <Error restart...
>
	TMSG <NMAIL error restart...
>
	MOVEI T1,^D5000		; wait some more
	DISMS
	JRST NMAIL		; and fire up the world again

;Copy line pointed to by T1 into space pointed to by T2

CPYLIN:	LDB T3,T1		; get a byte
	JUMPE T3,R		; return if null found
	CAIE T3,15		; quit on CR or LF
	CAIN T3,12
	JRST R
	IDPB T3,T2		; stuff this one
	IBP T1			; next byte
	JRST CPYLIN


;Disable capabilities so quota-checking happens

CAPOFF:	PUSH P,T1		; don't clobber
	MOVX T1,.FHSLF		; get my caps
	RPCAP
	MOVEM T3,CAPENB		; remember for later
	SETZ T3,		; no caps at all
	EPCAP
	POP P,T1		; restore
	RET


;Re-enable caps

CAPON:	PUSH P,T1		; no clobberage
	MOVX T1,.FHSLF
	MOVE T3,CAPENB		; caps we had before
	EPCAP
	POP P,T1
	RET

; Local modes:
; Mode: MACRO
; Comment col:40
; Comment begin:; 
; End:

	END NMAIL