;<PUP>PUPMLS.MAC;75    13-JAN-83 15:09:11    EDIT BY TAFT
;<PUP>PUPMLS.MAC;74    13-JAN-83 14:50:35    EDIT BY TAFT
; Add code to handle new-style ARPA Internet recipient names
;<PUP>PUPMLS.MAC;73     8-NOV-82 16:26:55    EDIT BY TAFT
; Fix bug in which result of expanding a MBEX string was later used as
; a template.  If "%" appeared in the expanded string, havoc would ensue.
;<PUP>PUPMLS.MAC;72     5-NOV-82 08:36:29    EDIT BY TAFT
; Rip out XNET stuff
;<PUP>PUPMLS.MAC;71     7-JUL-81 10:43:34    EDIT BY TAFT
; Strip registry in MESSAGE.ARCHIVE code
;<PUP>PUPMLS.MAC;70     2-JUN-81 10:37:50    EDIT BY TAFT
; Disable forwarding loop check if host qualification was stripped off.
; If PUPNM fails because no name lookup server responded, accept name
; as valid non-local registry rather than rejecting.
;<PUP>PUPMLS.MAC;69    28-MAY-81 17:33:57    EDIT BY TAFT
; For recipient "@Parc-Maxc", strip off Arpanet host name and
; go around again.
;<PUP>PUPMLS.MAC;68    18-MAY-81 15:19:59    EDIT BY TAFT
; Rip out code for calling MAILBOX program.
; Check Arpanet host names using GTHST jsys.
; In general, deal uniformly with fully-qualified recipient names.
; Simplify quoting conventions in [--UNDISTRIBUTED-MAIL--] file.
;<PUP>PUPMLS.MAC;66    12-SEP-80 11:29:15    EDIT BY TAFT
; Increase max length of Sender property
;<PUP>PUPMLS.MAC;65     1-SEP-80 16:38:29    EDIT BY TAFT
; Fix bug in RECPAS -- GS PASJFN, not LS PASJFN !!
;<PUP>PUPMLS.MAC;64     1-SEP-80 15:53:43    EDIT BY TAFT
; Suppress duplicates in incoming recipient names.
;<PUP>PUPMLS.MAC;63    30-AUG-80 15:38:42    EDIT BY TAFT
; Correctly compare recipient names even when one is qualified by registry
; and the other isn't.
; Add code to correctly handle PA registry after it moves to GV servers.
;<PUP>PUPMLS.MAC;62    29-AUG-80 13:38:22    EDIT BY TAFT
; Detect forwarding loops by comparing host number, not host name.
;<PUP>PUPMLS.MAC;61    15-AUG-80 16:37:55    EDIT BY TAFT
; Add password capturing hack
;<PUP>PUPMLS.MAC;60    13-FEB-80 18:35:04    EDIT BY TAFT
; Permit retrieve to work even if Message.txt file is not permanent.
;<PUP>PUPMLS.MAC;59     8-FEB-80 14:17:17    EDIT BY TAFT
; Change Pup types for Validate Recipient
;<PUP>PUPMLS.MAC;58     2-FEB-80 17:38:20    EDIT BY TAFT
; Add Validate Recipient misc request
;<PUP>PUPMLS.MAC;56    29-JAN-80 18:43:59    EDIT BY TAFT
; Fix bug causing authenticate to hang
;<PUP>PUPMLS.MAC;55    20-JAN-80 17:41:55    EDIT BY TAFT
; Include mail-related misc services, formerly in PUPSRV.MAC.
; Accept optional registry qualification in Mail Check and Authenticate.
; Permit only true registry names (socket 7) in recipient names.
;<PUP>PUPMLS.MAC;54     1-JAN-80 12:35:42    EDIT BY TAFT
; Quote sender name in same manner as recipient name when generating
; recipient list in queued message.
;<PUP>PUPMLS.MAC;52     4-NOV-79 12:47:02    EDIT BY TAFT
; Fix another glitch in handling empty mailbox when over allocation
;<PUP>PUPMLS.MAC;51     2-SEP-79 16:00:35    EDIT BY TAFT
;<PUP>PUPMLS.MAC;50    29-JUL-79 15:33:14    EDIT BY TAFT
; Optionally append retrieved mail to Message.Archive also.
;<PUP>PUPMLS.MAC;49     4-MAY-79 10:44:53    EDIT BY TAFT
; Bug fixes
;<PUP>PUPMLS.MAC;48     3-MAY-79 19:35:11    EDIT BY TAFT
; Quote special characters in recipient names put into queue files
;<PUP>PUPMLS.MAC;47    11-APR-79 17:10:31    EDIT BY TAFT
; Parse internally recipient names of the form "name.host" rather
; than passing them to the MAILBOX program.  Recognize hosts
; belonging to the "local site" and treat such recipients as local.
; Expand mailbox-exception messages earlier and buffer the resulting text.
; Improve some of the mailbox-exception messages.
;<PUP>PUPMLS.MAC;44     8-APR-79 16:10:09    EDIT BY TAFT
; Fix QUEREC so it doesn't rejuvenate a deleted [--UNDISTRIBUTED-MAIL--] file
;<PUP>PUPMLS.MAC;43    18-MAR-79 19:35:14    EDIT BY TAFT
; Add Sender property parser
; Use bit 0 of <SYSTEM>MAILER.FLAGS to notify Mailer of undistributed mail
;<PUP>PUPMLS.MAC;41     9-FEB-79 16:16:51    EDIT BY TAFT
; Rename [--UNSENT-MAIL--] to [--UNDISTRIBUTED-MAIL--]
; Filter out zero-length messages during retrieve
; Faster NAMCHK routine
; Misc bug fixes
;<PUP>PUPMLS.MAC;40    18-JAN-79 17:12:30    EDIT BY TAFT
; Redo queueing mechanism for new Pup mail forwarding strategy.
; Queue even local recipients if more than 3 of them.
;<PUP>PUPMLS.MAC;33    24-OCT-78 17:07:35    EDIT BY TAFT
; Add count of messages and bytes to mail retrieval log entry
;<PUP>PUPMLS.MAC;32     9-OCT-78 18:32:52    EDIT BY TAFT
; Buffer the mailbox exception messages until the property list
; has been completely processed.  Otherwise we get a deadlock!
;<PUP>PUPMLS.MAC;30     4-JUL-78 16:48:10    EDIT BY TAFT
; Another special case in Retrieve-mail OPENF failure
;<PUP>PUPMLS.MAC;29    17-APR-78 17:27:30    EDIT BY TAFT
; Correct error code for "No" reply in Retrieve-mail
;<PUP>PUPMLS.MAC;28     5-APR-78 15:54:37    EDIT BY TAFT
; Disallow delivery to System
;<PUP>PUPMLS.MAC;27     4-FEB-78 14:42:21    EDIT BY TAFT
; Read source file with PMAP in CPYFIL
;<PUP>PUPMLS.MAC;26     3-FEB-78 19:55:10    EDIT BY TAFT
; Eliminate logging each mailbox delivered to, except when debugging.
; Eliminate unnecessary CLOSF/OPENF
;<PUP>PUPMLS.MAC;24    10-JAN-78 12:13:57    EDIT BY TAFT
; Alternate handling if Retrieve-mail unable to open mailbox for writing
; due to user being over allocation
;<PUP>PUPMLS.MAC;23    16-OCT-77 15:52:40    EDIT BY TAFT
; Fix bug in QUEMSG causing names of the form xx@XNET not to be terminated correctly
;<PUP>PUPMLS.MAC;22    17-SEP-77 15:47:29    EDIT BY TAFT
; Revise handling of deleted or empty mailbox
; Fix Flush-mail to render mailbox empty in all respects
;<PUP>PUPMLS.MAC;21    16-SEP-77 13:24:28    EDIT BY TAFT
; More bug fixes
;<PUP>PUPMLS.MAC;19    15-SEP-77 18:17:32    EDIT BY TAFT
; Bug fixes
;<PUP>PUPMLS.MAC;17     2-SEP-77 12:20:57    EDIT BY TAFT
; Bug fixes
;<PUP>PUPMLS.MAC;16     1-SEP-77 17:07:13    EDIT BY TAFT
; Remove "Mail from host ..." line
; Mods to conform to revised Mail Transfer Protocol:
; - Multiple mailboxes now come in multiple property lists.
; - Maintain mailbox index for [Mailbox-exception] replies
; Add Retrieve-mail and Flush-mail commands.
;<PUP>PUPMLS.MAC;15     3-JUN-77 13:09:22    EDIT BY TAFT
; Remove "Sender" and "Distribution" properties
;<PUP>PUPMLS.MAC;14    12-APR-77 20:18:41    EDIT BY TAFT
; Add code in QUEMSG for Telenet kludge
;<PUP>PUPMLS.MAC;13     7-APR-77 17:16:10    EDIT BY TAFT
; Improve a few messages.
; Zero JFNs stored in memory when they are closed or released.

; Copyright 1979, 1980, 1981 by Xerox Corporation

	TITLE PUPMLS -- MAIL SERVER PORTION OF FTP SERVER
	SUBTTL E. A. Taft / March 1977

	SEARCH PUPDEF,PSVDEF,STENEX
	USEVAR FTPVAR,FTPPVR


LMBXTB==^D2000		; Length of MBXTAB -- max number of recipients
LHSHTB==^D251		; Length of HSHTAB hash bucket table (should be prime)
MAXLCL==3		; Max number of messages delivered locally
FWDLCF==RAISEF		; Flag controlling forwarding loop check
ARPFLG==1B19		; Working on ARPA name
QUOTEF==1B20		; Inside quotes (PRSPTH)



; "Store-Mail"

C.SMAI::PUSHJ P,SAVE1##
	SETZM MBXTAB		; Zero out mailbox table
	MOVE A,[MBXTAB,,MBXTAB+1]
	BLT A,MBXTAB+LMBXTB-1
	MOVEI A,MBXBUF		; Set pointer to name buffer
	MOVEM A,MBXFRE
	MOVSI P1,-LMBXTB	; Length of MBXTAB
	AOBJN P1,.+1		; Start counting at 1
	SETZM FILPRP##		; Clear out property list
	MOVE B,[FILPRP##,,FILPRP##+1]
	BLT B,FILPRP##+PLSIZE-1
	MOVEI B,1		; Init to Type text
	MOVEM B,FILPRP+P.TYPE
	MOVEI B,7		; Byte size 7
	MOVEM B,FILPRP+P.BYTE
	HRROI A,NETBUF##	; Set pointer to argument string

; Loop to collect mailbox property lists
C.SMA0:	HRRZM P1,MBXIDX		; Store current index
	MOVEI B,FILPRP##	; File property list
	PUSHJ P,SCNPRP##	; Scan property list
	 POPJ P,		; Failed
	MOVE B,A		; Peek ahead in input
	ILDB C,B
	JUMPE C,.+3		; Done if no more property lists
	AOBJN P1,C.SMA0		; Repeat if room in table
	FTPM(NO,110,<Mailbox table full>,1)

; Count recipients and generate Mailbox-Exception responses.
; Also perform duplicate elimination at this time.
	SETZM NQUEUE		; Reset counts
	SETZM NDELIV
	SETZM NDUPLI
	PUSHJ P,INIHSH		; Init hash table
	MOVN P1,MBXIDX		; Init MBXTAB index
	HRLZ P1,P1
	HRRI P1,1
GMBEX:	MOVE A,MBXTAB(P1)	; Get entry
	TLNN A,(1B1)		; Mailbox exception?
	 JRST GMBEX2		; No, normal entry
	HRROI B,2(A)		; Where the text of the response is
	UFTPM 0(A)		; Yes, generate Mailbox-exception response
	SETZM MBXTAB(P1)	; Flush this entry
	JRST GMBEX1		; On to next

GMBEX2:	PUSHJ P,INSHSH		; Insert name into hash table
	 JRST [	SETZM MBXTAB(P1) ; Duplicate, delete from MBXTAB
		AOS NDUPLI
		JRST GMBEX1]
	SKIPL MBXTAB(P1)	; Normal entry, which kind?
	 AOSA NDELIV		; Message for local delivery
	 AOS NQUEUE		; Message to be queued
GMBEX1:	AOBJN P1,GMBEX		; Loop for all 

; "Store-mail" (cont'd)

; See whether there were any valid mailboxes
	SKIPN A,NDELIV
	SKIPE NQUEUE
	 CAIA
	  FTPM(NO,40,<No valid mailbox in property list>,1)

; Set to queue all if more than MAXLCL local recipients or any non-local recipients
	SKIPN NQUEUE
	CAILE A,MAXLCL
	 JRST [	ADDM A,NQUEUE	; Add local recipients to queue count
		SETZM NDELIV	; No local deliveries
		JRST .+1]

; Open a temporary file to receive the message
	GJINF			; Generate unique version number
	IMULI C,NFORKS		; = job#*NFORKS + fork#
	ADDI C,(FX)
	HRROI A,TEMP		; Make filename
	WRITE <PUPSRV.MAIL;%3D;P770000>
	MOVSI A,(1B0+1B5+1B8+1B17)  ; Output, temp, ignore deleted
	HRROI B,TEMP
	GTJFN
	 FTPM(NO,107,<Mail system malfunction: %1J>,1)
	MOVEM A,DSTJFN##	; Save JFN

; Note: open write-only now and re-open for read later, because if we
; open for read-write now, SOUT works inefficiently and writing the file
; is ~25 times more costly!  This is a bad glitch in Tenex.
	MOVE B,[7B5+1B20]	; Open for write
	OPENF
	 JRST [	FTPM(NO,107,<Mail system malfunction: %1J>)
		MOVE A,DSTJFN##
		RLJFN
		 PUSHJ P,SCREWUP##
		SETZM DSTJFN##
		POPJ P,]

; Generate "Yes" reply and await "Here-is-file" command
; and file data
	FTPM(YES,0,<Ready for message>)
C.SMA1:	PUSHJ P,GETCMD		; Get next command
	 JRST SMAEND		; End received
	CAIN A,MKFILE		; "Here-is-file"?
	 JRST C.SMA3		; Yes, go receive file
	CAIN A,MKNO		; "No"? (i.e. abort)
	 JRST DELDST		; Flush output file and return
	MOVE C,MRKNAM##(A)	; No, get dispatch
	TLNN C,(OKSTOR)		; Command ok during "Store"?
	 JRST [	HRRO C,MRKNAM##(A)  ; No, make ptr to command name
		FTPM(NO,3,<Comand [%3S] out of sequence during Store-Mail>)
		JRST DELDST]	; Flush output file and return
	MOVE C,MRKDSP##(A)	; Ok, get dispatch
	PUSHJ P,0(C)		; Do the command
	JRST C.SMA1		; Look for another

; "Store-Mail" (cont'd)

; Here when "Here-is-file" command encountered
C.SMA3:	HLRZ A,FRKJFN(FX)	; Source is net
	MOVEM A,SRCJFN##
	MOVEI A,FILPRP##	; Property list being used
	PUSHJ P,RECDAT##	; Receive the message
	 JRST [	PUSHJ P,GETCMD##  ; Failed, suck up next command
		 JRST SMAEND	; End received
		HRRZ A,DSTJFN##	; Report failure
		LOG <Data error during Store-Mail %1F>
		FTPM(NO,103,<Data error during Store-Mail>)
		JRST DELDST]	; Flush output file and return
	PUSHJ P,GETCMD##	; Done, get next command
	 JRST SMAEND		; End received
	CAIN A,MKNO		; Terminated by "No"?
	 JRST [	FTPM(NO,106,<Store-Mail not completed>)
		JRST DELDST]	; Flush output file and return
	CAIE A,MKYES		; Terminated by "Yes"?
	 JRST [	HRRO C,MRKNAM##(A)  ; No, make ptr to command name
		FTPM(NO,3,<Command [%3S] out of sequence during Store-Mail>)
		JRST DELDST]	; Flush output file and return

; Mail received successfully
; Now deliver to mailboxes or queue for forwarding
	MOVE A,DSTJFN##		; Get current file position (= length)
	RFPTR
	 PUSHJ P,SCREWUP##
	MOVEM B,MSGLEN		; Save length
	HRLI A,400000		; Close but don't release JFN
	CLOSF
	 PUSHJ P,SCREWUP##
	MOVE A,DSTJFN##		; Re-open for reading and writing
	MOVE B,[7B5+1B19+1B20]
	OPENF
	 JRST [	FTPM(NO,107,<Mail system malfunction: %1J>)
		MOVE A,DSTJFN##
		RLJFN
		 PUSHJ P,SCREWUP##
		POPJ P,]
	MOVN P1,MBXIDX		; Init table index
	HRLZ P1,P1
	HRRI P1,1

; Loop to deliver to each mailbox
C.SMA5:	PUSHJ P,SETWDT##	; Reset watchdog timer
	SKIPN MBXTAB(P1)	; Have mailbox to deliver to?
	 JRST C.SMA7		; No
	MOVE A,DSTJFN##		; Get temp file JFN
	HRRO B,MBXTAB(P1)	; String ptr to mailbox name
	MOVE C,MSGLEN		; Length of message
	SKIPE NDELIV		; Queueing all?
	SKIPGE MBXTAB(P1)	; Non-local recipient?
	 JRST C.SMA6		; Yes, queue
	PUSHJ P,SNDMSG		; No, try to append to mailbox
	 JRST [	MOVSI A,(1B0)	; Failed, force queueing
		IORM A,MBXTAB(P1)
		SOS NDELIV	; Adjust counts
		AOS NQUEUE
		JRST C.SMA5]	; Try again
	HRRO A,MBXTAB(P1)
	TLNE F,(DEBUGF)		; Log only if debugging
	 LOG <Mail delivered to %1S>
	JRST C.SMA7

; "Store-Mail" (cont'd)

; Here if need to queue
C.SMA6:	PUSHJ P,QUEREC		; Add recipient name to queue
	 JRST [	MOVEI A,0(P1)
		HRRO D,MBXTAB(P1)
		FTPM(MBEX,3,<%1D Unexpected failure to queue mail for %4S>)
		ELOG <QUEMSG failed for %4S>
		JRST C.SMA7]	; Give up on this mailbox
	HRRO A,MBXTAB(P1)
	TLNE F,(DEBUGF)		; Log only if debugging
	 LOG <Mail queued for %1S>

; Here when done one mailbox
C.SMA7:	AOBJN P1,C.SMA5		; Jump if any more
	MOVE A,DSTJFN##		; Get temp file JFN
	MOVE C,MSGLEN		; Length of message
	PUSHJ P,QUEMSG		; Finish queueing message if necessary
	 PUSHJ P,SCREWUP##	; Can't happen at present
	FTPM(YES,0,<Mail delivery completed>)
	PUSHJ P,DELDST		; Close and delete temp file
	MOVE A,MSGLEN		; Log summary
	MOVE B,NDELIV
	MOVE C,NQUEUE
	MOVE D,NDUPLI
	LOG <Mail received, length: %1D;  %2D copies delivered, %3D queued, %4D duplicate>
	POPJ P,			; Exit [Store-mail] command

; Here if End received in the middle of a Store-Mail
SMAEND:	PUSHJ P,DELDST		; Close and delete destination file
	SETZM MBXIDX
	JRST FTPEND##		; Handle EOF normally

; Close and delete DSTJFN
DELDST:	MOVE A,DSTJFN##
	DELF
	 MOVE A,DSTJFN##
	CLOSF
	 PUSHJ P,SCREWUP##
	SETZM DSTJFN##
	POPJ P,

; Send message to mailbox
;	A/ JFN of file containing message
;	B/ String ptr to name of recipient
;	C/ Length of message in bytes
; Returns +1:  unsuccessful
;	+2:  successful
; Clobbers A-D, TEMP buffer
; Does not close JFN

SNDMSG:	HRLM A,0(P)		; Save source JFN
	PUSH P,C		; Save byte count
	MOVSI A,(1B0+1B2+1B8+1B17) ; Output, old file, ignore deleted
	PUSHJ P,GTJMBX		; Get JFN for mailbox file
	 JRST [	POP P,C		; Mailbox went away?
	 	POPJ P,]
	MOVE D,A		; Save JFN
	MOVEI C,5		; Max number of retries
SNDMS1:	MOVE B,[7B5+1B22]	; Open for append
	OPENF
	 JRST [	CAIN A,OPNX9	; Failed, busy?
		 SOJG C,[MOVEI A,^D1000  ; Yes, wait a second
			DISMS
			MOVE A,D  ; Try again
			JRST SNDMS1]
		MOVE A,D	; Other failure, release JFN
		RLJFN
		 PUSHJ P,SCREWUP##
		POP P,C		; Discard byte count
		POPJ P,]	; Fail return

; Put special header on message for mail programs
	SETO B,			; Output current date and time
	MOVSI C,(1B13)		; Include time zone
	ODTIM
	POP P,C			; Recover length
	WRITE <,%3D;000000000000%/>

; Copy the message to the file
	PUSH P,D
	HLRZ A,-1(P)		; Source file
	MOVE B,D		; Destination file
	PUSHJ P,CPYFIL		; Do it (byte count in C)
	POP P,A			; Recover mailbox JFN
	CLOSF			; Close it
	 PUSHJ P,SCREWUP##
	JRST SKPRET##		; Return +2

; Message queueing

; This is a three-stage process:

; (1) The recipient list and message body are appended to file
; [--UNDISTRIBUTED-MAIL--] (distinguishing it from old-style queue files,
; which are [--UNSENT-MAIL--].user@host), and the Mailer is notified.
; Notification consists of setting bit 0 of word 0 in <SYSTEM>MAILER.FLAGS.
; This bit corresponds to directory number zero, which doesn't exist,
; and is checked more frequently than the bits corresponding to real
; directories.

; (2) The Mailer reads this file, distributes copies of messages to
; the Message.txt files of local recipients, and appends a recipient list
; and message body to file [--FORWARDED-MAIL--].host for each host that
; has one or more of the recipients' mailboxes.
; When an [--UNDISTRIBUTED-MAIL--] file has been completely processed,
; it is deleted.

; (3) The Mailer then enumerates the [--FORWARDED-MAIL--].host files.
; For each one, it attempts to contact the host and deliver all the
; messages queued in the file.  When all messages have been delivered,
; the file is deleted.

; Syntax of queued message:

; *start*+nnnnnn,date,_sender,+recipient1,+recipient2, ... ,+recipientN <cr><lf>
; message body

; nnnnnn is length of queued message (recipient list + body).
; date is the date and time at which the message was received.
; Leading "+" means message pending; changed to "-" when entirely delivered.
; "+" before recipient name means delivery pending to that recipient;
; changed to "-" when delivery to recipient completed.
; "_" before name designates sender, if known.
; The characters comma and single quote must be quoted by preceding
; them with a single quote if they appear literally in a recipient name.

; The user-settable word (FDBUSW) of the FDB points to the start of
; the first message that is still pending.  The file attributes are set
; to "nonexistent" when all messages have been delivered to all recipients.

; Undistributed messages are appended to file [--UNDISTRIBUTED-MAIL--].;99999.
; If that file is busy, successively lower versions are used.
; (Decreasing rather than increasing version numbers are used so as to
; correspond to Tenex directory order and thereby ensure messages are
; delivered in order.)

; Message queueing (cont'd)

; Begin queued message if necessary and insert recipient name.
;	B/ String ptr to recipient name
; Returns +1:  unsuccessful (shouldn't happen, error logged)
;	+2:  successful

QUEREC:	TLC B,-1		; Turn -1 lh into byte ptr
	TLCN B,-1
	 HRLI B,(POINT 7)
	PUSH P,B		; Save string ptr to recipient name
	SKIPE A,QUEJFN		; Already have file open?
	 JRST QUERE4		; Yes
	MOVEI C,^D99999		; Version to use if no queue file exists
	MOVE A,[1B2+1B17+<0,,-2>] ; Find oldest existing version
	HRROI B,[ASCIZ /[--UNDISTRIBUTED-MAIL--]./]
	GTJFN
	 JRST QUERE1		; No existing version, use 99999
	MOVE B,[1,,7]		; Found one, get its version number
	MOVEI C,C
	GTFDB
	HLRZ C,C
	JRST QUERE2		; Go try to open it
	
QUERE1:	HRRZ A,C		; Try version (C), create if necessary
	HRLI A,(1B0+1B17)
	HRROI B,[ASCIZ /[--UNDISTRIBUTED-MAIL--].;P770000/]
	GTJFN
	 JRST QUEFAI		; Failed!
QUERE2:	MOVEM A,QUEJFN
	MOVE B,[7B5+1B20]	; 7-bit byte, write only
	OPENF
	 JRST [	PUSH P,A	; Failed, save error code
		MOVE A,QUEJFN	; Release JFN
		RLJFN
		 PUSHJ P,SCREWUP##
		POP P,A
		CAIN A,OPNX9	; File busy?
		 SOJG C,QUERE1	; Yes, try next lower version
		JRST QUEFAI]	; Other error, fail

; Position to current end-of-file.  Must use FDBSIZ, not FILLEN, since
; Tenex zeroes FILLEN if you open write-only.  We open write-only rather
; than read-write due to a Tenex performance problem that makes SOUT
; much (~25x) more expensive when the file is open read-write.
; I would have opened append-only, except if I had done that I wouldn't be
; allowed to execute SFPTR later to fix up the count in the stamp!
	SETZM QUEPTR		; Assume creating new file from scratch
	MOVE B,[1,,1]		; Read FDBCTL flags
	MOVEI C,C
	GTFDB
	TLNE C,(1B3+1B4)	; Was it nonexistent or deleted?
	 JRST QUERE3		; Yes, start writing at byte 0
	SIZEF			; No, get existing file length
	 PUSHJ P,SCREWUP##
	MOVEM B,QUEPTR		; This is where we start
	SFPTR			; Position to EOF
	 PUSHJ P,SCREWUP##

; Append stamp for start of new message
QUERE3:	SETO B,			; Current date and time
	WRITE <*start*+00000000,%2T>
	SKIPN FILPRP+P.SNDR	; Sender known?
	 JRST QUERE4		; No
	WRITE <,_>
	MOVEI B,FILPRP+P.SNDR	; String ptr to sender
	HRLI B,(POINT 7)
	PUSHJ P,QRECNM		; Append name, quoting where necessary

; Message queueing (cont'd)

; Append new recipient name
QUERE4:	WRITE <,+>
	POP P,B			; String ptr to recipient name
	PUSHJ P,QRECNM		; Append name, quoting where necessary
	JRST SKPRET##		; Return +2

; Here if failed to open queue file
QUEFAI:	POP P,B
	ELOG <Failed to queue mail for %2S%/ - %1J>
	POPJ P,


; Append recipient name, quoting where necessary.
;	A/ JFN
;	B/ String ptr to recipient name
; Returns +1 always
; Clobbers B-D

QRECNM:	MOVE C,B
QRECN1:	ILDB B,C		; Get a char
	JUMPE B,CPOPJ##		; Jump if done
	CAIE B,","		; Comma?
	CAIN B,"'"		; Single quote?
	 JRST [	MOVEI B,"'"	; Yes, quote it
		BOUT
		LDB B,C		; Recover original character
		JRST .+1]
	BOUT			; Append to recipient list
	JRST QRECN1

; Message queueing (cont'd)

; Finish queueing message for background delivery, if necessary
;	A/ JFN of file containing message
;	C/ Length of message in bytes
; Returns +1:  unsuccessful (no way this can happen at present)
;	+2:  successful
; Clobbers A-D, TEMP buffer
; Does not close JFN

QUEMSG:	SKIPN B,QUEJFN		; Is there a queue file?
	 JRST SKPRET##		; No, return immediately
	WRITE B,<%/>		; Append crlf to stamp
	PUSHJ P,CPYFIL		; Append body of message
	MOVE A,QUEJFN
	RFPTR			; Read current position
	 PUSHJ P,SCREWUP##
	MOVE D,B
	SUB D,QUEPTR		; Compute length of new message
	MOVE B,QUEPTR		; Position to start of message
	ADDI B,^D8		; + 8 chars for "*start*+"
	SFPTR
	 PUSHJ P,SCREWUP##
	MOVE B,D		; Length of message
	MOVE C,[1B2+1B3+8B17+^D10] ; Leading 0's, 8 columns, decimal
	NOUT			; Put length in stamp
	 PUSHJ P,SCREWUP##
	CLOSF			; Close queue file
	 PUSHJ P,SCREWUP##
	SETZM QUEJFN
	MOVSI A,(1B0)		; Notify mailer of undistributed mail
	IORM A,MFLAGS
	JRST SKPRET##		; Return +2


; Copy a file (7-bit ASCII)
;	A/ Source JFN
;	B/ Destination JFN
;	C/ Number of bytes to copy
; Reads the specified number of bytes from the source file starting
; at the beginning, and appends them to the destination file.
; Returns +1 always
; Clobbers A-D, TEMP buffer; does not close JFNs

CPYFIL:	MOVE D,C		; Save byte count
	PUSH P,B		; Save destination JFN
	HRLZ A,A		; Make source JFN,,page designator

CPYFI1:	MOVEI B,TEMP		; Where to map source page
	LSH B,-9		; Convert to page number
	HRLI B,400000		; This fork
	MOVSI C,(1B2)		; Read access
	JUMPLE D,CPYFI2		; Jump if no more bytes left
	PMAP			; Map the page
	EXCH A,0(P)		; Save source designator, get destination
	HRROI B,TEMP		; Where the data is
	MOVNI C,5000		; Number of bytes assuming full page
	CAIGE D,5000		; Full page remaining?
	 MOVN C,D		; No, cut down to actual amount
	SOUT			; Write to destination
	EXCH A,0(P)		; Save destination, get back source
	SUBI D,5000		; Decrement byte count
	AOJA A,CPYFI1		; Increment page number and repeat

; Here when no more bytes left, B and C set up for PMAP
CPYFI2:	SETO A,			; Unmap source page
	PMAP
	POP P,A			; Flush stack and return
	POPJ P,

; "Retrieve-mail"

C.RMAI::SETZM FILPRP		; Clear out property list
	MOVE A,[FILPRP,,FILPRP+1]
	BLT A,FILPRP+PLSIZE-1
	MOVEI A,1		; Init to Type text, byte size 7
	MOVEM A,FILPRP+P.TYPE
	MOVEI A,7
	MOVEM A,FILPRP+P.BYTE
	SETZM MBXTAB		; Zero out mailbox table
	MOVE A,[MBXTAB,,MBXTAB+1]
	BLT A,MBXTAB+LMBXTB-1
	MOVEI A,MBXBUF		; Where to put mailbox property
	MOVEM A,MBXFRE
	HRROI A,1		; Table index to use (negative => Retrieve)
	MOVEM A,MBXIDX
	HRROI A,NETBUF		; Set pointer to argument string
	MOVEI B,FILPRP
	PUSHJ P,SCNPRP##	; Scan property list
	 POPJ P,		; Failed
	SKIPN MBXTAB+1		; Make sure a mailbox was specified
	 FTPM(NO,40,<No mailbox in property list>)
	MOVEI A,FILPRP
	PUSHJ P,LOGCHK##	; Check login/connect parameters
	 POPJ P,		; Failed

; Open mail file
	SETZM MBXLEN		; Zero length in case open fails
	SETZM NDELIV		; No messages processed yet
	MOVSI A,(1B2+1B8+1B17)	; Old file, ign deleted, name from string
	HRROI B,MBXBUF
	PUSHJ P,GTJMBX		; Get JFN for mailbox file
	 JRST RGJFER##		; Not found
	MOVEM A,SRCJFN##	; Ok, store it
	MOVEI C,5		; Max number of retries
	MOVE B,[7B5+1B19+1B20]	; Open for read and write
C.RMA2:	MOVE A,SRCJFN##
	OPENF
	 JRST [	CAIN A,OPNX9	; Failed, busy?
		 SOJG C,[MOVEI A,^D1000  ; Yes, wait a second
			DISMS
			JRST C.RMA2]  ; Try again
		CAIN A,OPNX10	; Over allocation?
		 SOJG C,[TRZ B,1B20  ; Yes, abandon trying to write
			JRST C.RMA2]
		CAIN A,OPNX2	; File doesn't exist?
		 JRST C.RMA8	; Yes, behave as if it exists but is empty
		PUSHJ P,ROPNER##  ; Other problem, report it and fail
		MOVE A,SRCJFN##	; Release JFN
		RLJFN
		 PUSHJ P,SCREWUP##
		SETZM SRCJFN##
		POPJ P,]

; Set up for mail transfer.  Read from mail file using local PMAPs,
; but send to net using normal mechanism.
	MOVE B,[1,,1]		; Get FDBCTL
	MOVEI C,C
	GTFDB
	SETZ B,			; In case empty file
	TLNE C,(1B3)		; Deleted?
	 JRST .+3		; Yes, treat as empty
	SIZEF			; Get file length
	 PUSHJ P,SCREWUP##
	MOVEM B,MBXLEN		; Save it
	MOVEI A,MBXDTE		; Enable for data error in mailbox file
	MOVEM A,SRCDSP##
	MOVEM P,ERRPDP##
	SETOM MBXPGN		; Don't have input file mapped yet
	SETZ A,			; Position to first byte
	PUSHJ P,POSMBX
	 JRST C.RMA8		; Mailbox is empty

; "Retrieve-mail" (cont'd)

; Loop to send each message to user.
; First, read and interpret the stamp.
C.RMA4:	PUSHJ P,SETWDT##	; Reset watchdog timer
	HRRZ A,FRKJFN(FX)	; Destination is net
	MOVEM A,DSTJFN##
	MOVEI A,NETBUF##	; Buffer to use for sending
	MOVEM A,DSTIBP##
	MOVEI A,8		; Byte size 8
	PUSHJ P,SETOUT##	; Setup for output
	MOVE D,[POINT 7,TEMP]	; Buffer stamp here
C.RMA5:	SOSGE MBXCNT		; Read up to line feed
	 JRST [	PUSHJ P,FIXMBX
		 JRST C.RMA8	; Eof, done
		JRST C.RMA5]
	ILDB A,MBXBYT		; Copy byte
	IDPB A,D
	CAIE A,12		; Line feed?
	 JRST C.RMA5		; No, continue

	HRROI A,TEMP		; Read date received
	MOVSI B,(1B8)
	IDTIM
	 JRST MBXBAD		; Bad format
	MOVEM B,DATREC
	MOVEI C,^D10		; Decimal
	NIN			; Get message length
	 JRST MBXBAD		; Bad format
	MOVEM B,MSGLEN
	MOVEI C,10		; Octal
	NIN			; Get flags
	 JRST MBXBAD
	MOVEM B,MSGFLG		; Store flags

; Now one pass over the message to determine length after LFs stripped
	PUSHJ P,FIXMBX		; Get where we are now
	 JRST MBXBAD		; Bad format if eof
	PUSH P,A		; Save it
	MOVE D,MSGLEN		; Nominal length
	MOVEM D,TEMP

C.RMA6:	SOSGE MBXCNT		; Decrement and test count
	 JRST [	PUSHJ P,FIXMBX	; No more, get next buffer
		 JRST [	POP P,A	; Bad mailbox if hit eof
			JRST MBXBAD]
		JRST C.RMA6]
	ILDB A,MBXBYT		; Get byte
	CAIN A,12		; Line feed?
	 SOS TEMP		; Yes, do not include in count
	SOJG D,C.RMA6		; Repeat for all bytes in message
	SKIPN TEMP		; Zero-length message?
	 JRST C.RMA4		; Yes, filter out
	AOS NDELIV		; Count messages

; Send property list
	MOVE A,MSGFLG		; Get flags
	SETZB C,D
	TRNE A,1B35		; Message already read?
	 HRROI C,[ASCIZ /(Opened Yes)/]
	TRNE A,1B34		; Deleted?
	 HRROI D,[ASCIZ /(Deleted Yes)/]
	MOVE A,TEMP		; Length not including LFs
	MOVE B,DATREC		; Date of receipt
	FTPM(PLST,,<((Length %1D)(Date-received %2T)%3S%4S)>)

; "Retrieve-mail" (cont'd)

; Send the message
	MOVEI A,MKFILE		; "Here-is-file"
	SETZ B,
	PUSHJ P,BEGCMD##
	POP P,A			; Recover starting position
	PUSHJ P,POSMBX		; Reposition file
	 PUSHJ P,SCREWUP##

C.RMA7:	SOSGE MBXCNT		; Decrement and test count
	 JRST [	PUSHJ P,FIXMBX	; No more, get next buffer
		 PUSHJ P,SCREWUP##
		JRST C.RMA7]
	ILDB A,MBXBYT		; Get byte
	CAIN A,12		; Line feed?
	 JRST C.RM7A		; Yes, ignore
	SOSGE DSTCNT##		; Decrement and test destination count
	 PUSHJ P,PUTNPG##	; Dump buffer, return .-1
	IDPB A,DSTBYT##		; Store byte
C.RM7A:	SOSLE MSGLEN		; Repeat for entire message
	 JRST C.RMA7
	PUSHJ P,PUTLPG##	; Send last partial page

	JRST C.RMA4		; On to next message

; Here when done
C.RMA8:	FTPM(YES,0,<Mail retrieval completed>)
	PUSHJ P,UNMAP##		; Unmap file page
	SETOM MBXPGN		; Don't know where we are now
	MOVE A,SRCJFN##		; Log mailbox filename and length
	MOVE B,NDELIV
	MOVE C,MBXLEN
	LOG <Retrieve mailbox %1F, %2D messages, %3D bytes>

C.RMA9:	PUSHJ P,GETCMD##	; Get next command
	 JRST FTPEND##
	MOVE P1,MRKDSP##(A)	; Get dispatch
	CAIE A,MKCOMM		; Comment?
	CAIN A,MKEOC		; EOC?
	 JRST [	PUSHJ P,0(P1)	; Yes, execute and stay in this context
		JRST C.RMA9]
	CAIN A,MKFMAI		; Flush-mail?
	 JRST FLMAIL		; Yes, do it
	PUSHJ P,CLZMAI		; Something else, close mail file
	JRST 0(P1)		; Execute command, return to main loop

; Here when Flush-Mail command received.
FLMAIL:	MOVE A,SRCJFN##
	GTSTS
	JUMPGE B,FLMAI1		; Just release JFN if never got the file open

; "Retrieve-mail" (cont'd)

; First, append retrieved messages to Message.Archive, if such a file exists.
	SKIPN MBXLEN		; Were there any messages?
	 JRST NOARC		; No, forget it
	MOVE A,[POINT 7,TEMP]	; Build file name here
	MOVEI C,"<"
	MOVE B,[POINT 7,MBXBUF]	; Where Mailbox property value is
ARCMS0:	IDPB C,A		; Copy name thru "." or null
	ILDB C,B
	CAIE C,"."
	 JUMPN C,ARCMS0
	UWRITE A,[ASCIZ />MESSAGE.ARCHIVE/]
	MOVSI A,(1B2+1B17)	; Old file, name from string
	HRROI B,TEMP
	GTJFN
	 JRST NOARC		; No such file
	MOVEM A,ARCJFN		; Save JFN
	MOVE B,[7B5+1B22]	; Open for append
	OPENF
	 JRST [	MOVE A,ARCJFN	; Failed, forget it
		RLJFN
		 PUSHJ P,SCREWUP##
		JRST NOARC1]
	SETZ A,			; Position mailbox to start of first message
	PUSHJ P,POSMBX
	 JRST ARCMS5
ARCMS1:	MOVE A,ARCJFN		; Destination file
	MOVE B,MBXBYT		; Source byte ptr
	MOVN C,MBXCNT		; Byte count
	JUMPE C,ARCMS5		; Jump if none
	SOUT
	SETZM MBXCNT		; Say all bytes consumed
	PUSHJ P,FIXMBX		; Advance to next page
	 JRST ARCMS5		; EOF
	JRST ARCMS1		; Continue copying

; Here when reach EOF
ARCMS5:	PUSHJ P,UNMAP##		; Unmap mailbox file page
	MOVE A,ARCJFN		; Close archive file
	CLOSF
	 PUSHJ P,SCREWUP##

NOARC1:	SETZM ARCJFN

; Now really flush the mailbox.
NOARC:	MOVE A,SRCJFN##
	GTSTS
	TLNE B,(1B2)		; Do we have mailbox open for writing?
	 PUSHJ P,DELPGS##	; Yes, delete all pages in file
	MOVE A,SRCJFN##		; Reset EOF pointer to zero
	HRLI A,12
	SETO B,
	SETZ C,
	CHFDB
	MOVE A,SRCJFN##		; Delete file
	DELF
	 PUSHJ P,SCREWUP##
FLMAI1:	FTPM(YES,0,<Flush-mail completed successfully>)
CLZMAI:	MOVE A,SRCJFN##
	CLOSF
	 JRST [	MOVE A,SRCJFN## ; If it fails, it can be only because the
		RLJFN		;  file isn't open to begin with
		 PUSHJ P,SCREWUP##
		JRST .+1]
	SETZM SRCJFN##
	POPJ P,

; Here if discover bad format in message file
MBXBAD:	PUSHJ P,UNMAP##
	FTPM(NO,103,<Mailbox is malformed>)
	JRST CLZMAI

; Here if encounter data error in message file
MBXDTE:	PUSHJ P,UNMAP##
	FTPM(NO,103,<Disk error in mailbox file>)
	JRST CLZMAI

; Retrieve-mail subroutines

; Fix up mailbox byte count, and read next page if necessary.
; Expects MBXCNT to reflect number of bytes read.
; Returns +1: EOF
;	+2: normal, A/ current byte position
; Clobbers A-C

FIXMBX:	MOVE A,MBXPGN		; Get current page
	ADDI A,1		; Advance to next
	IMULI A,5000		; Convert to byte number
	CAML A,MBXLEN		; Past end?
	 MOVE A,MBXLEN		; Yes, limit
	SKIPL MBXCNT		; Compensate for extra SOS
	 SUB A,MBXCNT		; Subtract bytes remaining
				; Fall into POSMBX


; Position mailbox file to specified byte and set up byte count
;	A/ byte position
; Returns +1: EOF
;	+2: normal, A/ byte position
; Clobbers A-C

POSMBX:	CAML A,MBXLEN		; Past end?
	 POPJ P,		; Yes, don't do anything
	MOVE B,MBXLEN		; Compute remaining bytes
	SUB B,A
	MOVEM B,MBXCNT		; Store temporarily
	PUSH P,A
	IDIVI A,5000		; Compute page number and byte in page
	MOVEI C,5000		; Compute remaining bytes in page
	SUBI C,(B)
	CAMGE C,MBXCNT		; Less than rest of file?
	 MOVEM C,MBXCNT		; Yes, limit
	IDIVI B,5		; Compute byte pointer
	ADD B,BPTAB(C)
	MOVEM B,MBXBYT
	CAMN A,MBXPGN		; Already at desired page?
	 JRST POSMB1		; Yes, done
	MOVEM A,MBXPGN
	HRL A,SRCJFN##		; No, map the page
	MOVEI B,FILBUF##
	LSH B,-9
	HRLI B,400000
	MOVSI C,(1B2)
	HRROS SRCDSP##		; Enable data error dispatch
	PMAP
	SKIP FILBUF##		; Data error will happen here
	HRRZS SRCDSP##
POSMB1:	POP P,A			; Recover current position
	JRST SKPRET##

BPTAB:	POINT 7,FILBUF
	POINT 7,FILBUF,6
	POINT 7,FILBUF,13
	POINT 7,FILBUF,20
	POINT 7,FILBUF,27


; "Flush-mail" -- should never be received at top-level

C.FMAI::FTPM(NO,3,<Incorrect context for Flush-mail command>,1)
C.MBEX::FTPM(NO,3,<Unexpected command>,1)

; Property value processing routines specific to the mail server

; (Mailbox <name>)

; The following macro queues up a Mailbox-exception reply.
; It must be executed at top level, and the text is interpreted
; as for FTPM except that arguments may be in B-D only.

DEFINE MBEX(CODE,TEXT) <
	JRST [	JSP A,DOMBEX
		FTPM(MBEX,CODE,<%1D TEXT>) ]
>

PPMLBX::PUSHJ P,SAVE2##
	SKIPN D,MBXIDX		; Get mailbox table index
	 FTPM(NO,10,<Mailbox property out of context>,1)
	HRRO B,MBXFRE		; Where to put property value
	HRRZM B,MBXTAB(D)
	MOVEI C,500
	PUSHJ P,GTPVAL##	; Get property value string
	 FTPM(NO,10,<Malformed Mailbox property>,1)
	MOVEI P1,1(B)		; Update free pointer, get start
	EXCH P1,MBXFRE
	TRO F,FWDLCF		; Do forwarding loop check unless cancelled

; First see what kind of mailbox
	HRLI P1,(POINT 7)
	PUSH P,A		; Save source string ptr
PPMLB1:	MOVE A,P1
	SETZ P2,
	TRZ F,ARPFLG		; Not known to be an ARPA name yet
FNDSEP:	ILDB C,A		; Search for last "@" or "." in name
	CAIN C,"@"
	 TROA F,ARPFLG		; Remember this is an ARPA name
	CAIN C,"."
	 MOVE P2,A		; Found ".", remember where it was
	JUMPN C,FNDSEP
	JUMPN P2,HAVREG		; If found one, go see what it is

; Name has no "@" or "." in it -- append local registry name before proceeding
	MOVE P2,A		; Start of registry
	ADD A,[7B5]		; Back up over terminator
	HRROI B,LCLREG
	WRITE <.%2S>
	IBP A			; Update free pointer
	MOVEI A,1(A)
	MOVEM A,MBXFRE

; Now P1/ string ptr to entire recipient name, P2/ string ptr to registry or host.
; See what kind of registry/host.
HAVREG:	LDB C,P2		; Get separator character
	CAIN C,"@"
	 JRST CHKARP		; Arpanet host

; "." separator -- Pup registry.  First check for ArpaGateway.
	MOVE A,P2
	HRROI B,ARPREG
	PUSHJ P,NAMCHK
	 CAIA			; Not ArpaGateway
	  JRST REGARP		; ArpaGateway, go strip ".ArpaGateway" and process

	TRNE F,ARPFLG		; Were there any "@"s?
	 JRST CHKARP		; Yes, treat entire string as ARPA name
	 
; Treat as Pup registry name
	MOVE A,P2
	PUSHJ P,CHKREG		; Check registry name
	 MBEX(1,<Invalid registry name "%11S">)
	 JRST NOTLCL		; Not local

; Check for existence of local mailbox
	MOVE B,P1
	PUSHJ P,CKLMBX		; Check for existence of local mailbox
	 JRST [	HRROI A,FWDHST	; Not present, get host we will forward to
		JRST NOTLC1]	; Go do loop detection and queueing
	JRST MLBXOK		; Ok to deliver to local user

; Mailbox property list parser (cont'd)

; Non-local Pup registry name, or local registry but no such mailbox.
; Make some minimal checks to prevent infinite forwarding loops.
NOTLCL:	MOVE A,P2		; Registry to look up for loop detection
NOTLC1:	SKIPG MBXIDX		; Stop here if context is "Retrieve-mail"
	 FTPM(NO,41,<No such mailbox as %10S>,2)
	TRNN F,FWDLCF		; Want to check for forwarding loops?
	 JRST MBXFWD		; No, just accept for forwarding
	MOVE B,[1B0+100B17+TEMP]
	PUPNM			; Convert registry to address(es)
	 JRST MBXFWD		; Huh?  accept
	TLC B,-1		; LH B has address vector length
	ADD B,[1,,0]		; Make AOBJN ptr
	MOVE A,FRNHAD##		; Net,,host of guy we're connected to
	CAMN A,0(B)
	 JRST MFWDLP		; Same as forwarding host, reject
	ADDI B,1
	AOBJN B,.-3

; Ok, accept this recipient for forwarding
MBXFWD:	MOVSI A,(1B0)		; Mark entry for queueing
	MOVE B,MBXIDX
	IORM A,MBXTAB(B)
MLBXOK:	POP P,A			; Restore source string ptr
	JRST SKPRET##		; Return +2

; Seems to be forwarding in a loop--reject.
MFWDLP:	HRROI B,LCLHNM##
	HRROI C,FRNHNM##
	MBEX(4,<Cannot locate mailbox for %10S on either %2S or %3S.>)

; Registry is ArpaGateway.  Flush registry name and process as ARPA name.
REGARP:	SETZ B,
	DPB B,P2

; Arpanet host.  Check it and queue for forwarding.
CHKARP:	MOVE A,P1
	MOVE D,[POINT 7,TEMP]
	PUSHJ P,PRSPTH
	 MBEX(1,<Syntax error in ARPA recipient name "%10S">)
	MOVEM A,LCLPRT
	MOVEM B,DOMAIN
	MOVEM C,SRCROU
	SKIPN A,DOMAIN		; Domain must be present
	 MBEX(1,<Domain missing in ARPA recipient name "%10S">)
	SKIPE B,SRCROU		; Source-route present?
	 JRST [	IBP B		; Yes, see if it is the same as the domain
		PUSHJ P,NAMCHK
		 JRST .+1	; No, continue
		SETZM SRCROU	; Yes, flush source-route
		JRST .+1]
	SKIPN A,SRCROU		; Try to parse the source-route if present
	 SKIPA A,DOMAIN		; Else parse domain
	  IBP A			; Skip leading "@" in source-route
	PUSHJ P,PRSDMN		; Parse domain string
	 JRST [	SKIPN B,SRCROU
		 MOVE B,DOMAIN
	 	MBEX(1,<Syntax error in ARPA domain expression "%2S">)]
	 JRST [	SKIPN B,SRCROU
		 MOVE B,DOMAIN
	 	MBEX(1,<Sorry, I never heard of an ARPA domain named "%2S">)]
	CAMN C,LHOSTN		; Ok, is it really me?
	 JRST [	MOVE A,P1	; Yes, copy out just the local-part
		MOVE B,LCLPRT
		WRITE <%2S>
		IBP A		; Adjust free storage pointer
		MOVEI A,1(A)
		MOVEM A,MBXFRE
		TRZ F,FWDLCF	; Disable forwarding loop check
		JRST PPMLB1]	; Go around again
	JRST MBXFWD		; Accept for forwarding

; Mailbox property list parser (cont'd)

; Here to buffer up a Mailbox-exception response (MBEX macro).
; A points to an FTPM instruction.  Copy its control word and
; expand its text into the MBXFRE area, and put a pointer to that
; into the MBXTAB entry.  B-D, P1, P2 may contain arguments to be used in
; the expansion.
DOMBEX:	PUSH P,P3
	PUSH P,P4
	HRRZ P4,0(A)		; Get pointer to FTPM argument
	MOVE P3,MBXFRE		; Buffer FTPM control word here
	MOVE A,0(P4)
	MOVEM A,0(P3)
	MOVE A,[ASCIZ /%2S/]	; Template to use when message is ultimately sent
	MOVEM A,1(P3)		; (avoids problems if message contains "%" !)
	HRROI P3,2(P3)		; Expand message here
	HRRZ A,MBXIDX		; Index to be included in message
	UWRITE P3,1(P4)
	IBP P3			; Update free storage pointer
	MOVEI P3,1(P3)
	EXCH P3,MBXFRE		; Get start of resulting FTPM argument
	HRLI P3,(1B1)		; Mark as mailbox-exception
	MOVEM P3,MBXTAB(A)	; Put in table
	POP P,P4
	POP P,P3
	JRST MLBXOK		; Go give normal return


; (Sender <name>)
; We make no attempt to parse or validate the sender name.

PPSNDR::HRROI B,P.SNDR(P1)	; Where to put string
	MOVEI C,SNDSTL		; Max # of characters
	PUSHJ P,GTPVAL##	; Collect and store string
	 FTPM(NO,42,<Malformed Sender property>,1)
	JRST SKPRET##

; Parse mailbox path
;	A/ string ptr to path
;	D/ string ptr to start of storage in which to put result text
; Returns +1: syntax error
;	+2: normal:
;	   A/ string ptr to local-part
;	   B/ string ptr to domain (0 if none)
;	   C/ string ptr to source-route (0 if none)
;	   D/ updated to last byte of storage used
; Strips out quotes (" or \)
; Clobbers A-D

PRSPTH:	PUSH P,D		; Potential start of local-part
	PUSH P,[0]		; Domain not seen yet
	PUSH P,[0]		; Source-route not seen yet
	TRZ F,QUOTEF		; Not inside quotes

	ILDB B,A		; Get first char
	CAIE B,"@"		; Start of source-route?
	 JRST PRSPT2
	SETZM -2(P)		; Yes, zero start of local-part
	MOVEM D,0(P)		; And set start of source-route instead
	JRST PRSPT2

PRSPT1:	ILDB B,A
PRSPT2:	JUMPE B,PRSPT9		; Done on null
	CAIN B,42
	 JRST [	TRC F,QUOTEF	; Double quote, flip flag
		JRST PRSPT1]
	CAIN B,"\"
	 JRST [	ILDB B,A	; Take char after "\" literally
		JRST PRSPT3]
	TRNE F,QUOTEF
	 JRST PRSPT3		; Take chars inside "" literally
	CAIN B,"@"
	 JRST PRSPT4		; Start of domain
	CAIN B,":"
	 JRST PRSPT5		; End of source-route
; **********
; Crock to cope with senders who think the source-route ends with comma instead of colon:
	CAIN B,","		; Comma
	SKIPE -2(P)		; And source-route in progress?
	 JRST PRSPT3		; No, treat as ordinary char
	PUSH P,A
	ILDB B,A		; Get char after comma
	POP P,A
	CAIE B,"@"		; Start of another domain?
	 JRST PRSPT5		; No, end of source-route
	MOVEI B,","		; Yes, continue with source-route
; **********
PRSPT3:	IDPB B,D		; Nothing special.  Append to current dest string
	JRST PRSPT1

; "@" could be either the start of the mailbox domain or a component of the source-route.
PRSPT4:	SKIPN -2(P)		; Begun local-part yet?
	 JRST PRSPT3		; No, still in source-route; continue
	IDPB B,D		; Yes, put "@" between local-part and domain
; Note that this will remember the position of the last "@" in the mailbox name, which
; will be zapped with null when we are done.  This allows for "@" to appear in the
; local-part, even though that's not strictly legal according to the protocol.
	MOVEM D,-1(P)		; Begin domain
	JRST PRSPT1

; ":" terminates the source-route and begins the local-part.
PRSPT5:	SKIPE -2(P)		; Already have local-part?
	 JRST PRSPTE		; Yes, syntax error
	SETZ B,			; No, terminate source-route
	IDPB B,D
	MOVEM D,-2(P)		; Set start of local-part
	JRST PRSPT1

; Here at end of path
PRSPT9:	SKIPE -2(P)		; Local-part begun yet?
	TRNE F,QUOTEF		; Outside quotes?
	 JRST PRSPTE		; No, syntax error
	SETZ B,
	IDPB B,D		; Terminate destination string
	SKIPE -1(P)		; Domain begun yet?
	 DPB B,-1(P)		; Yes, terminate local-part by overwriting "@"
	AOS -3(P)		; Preset skip return
PRSPTE:	POP P,C			; Return source-route
	POP P,B			; Return domain
	POP P,A			; Return local-part
	POPJ P,

; Parse domain expression
;	A/ string ptr to domain expression, terminated by null, comma, or colon
; Returns +1: Syntax error
;	+2: Name not found or different root domain from ourselves
;	+3: Normal, A/ host number of principal domain element (immediately below root)
; Clobbers A-D

; Parsing rules are as follows (these admit all legal domain expressions, and also
; some illegal ones which nevertheless are quite common):
; If there is precisely one element, or the last element is a domain literal instead
; of a name, then that is the element of interest and is assumed to belong to the
; local root domain.  Otherwise (more than one element and the last one is a name),
; if the last element is the local root domain then the next-to-last element is looked
; up as a host name.  If the last element is not the local root domain then it is
; looked up as a host name; if this succeeds then the last element is considered to
; be the one of interest and is assumed to belong to the local root domain.

PRSDMN:	PUSH P,[0]		; No name scanned yet
	PUSH P,[0]		; No host number corresponding to it
	PUSH P,A		; Save start of string currently being considered

; Here to consider next domain element
; -2(P) string ptr to start of preceding element, if one exists and is a name (0 = none)
; -1(P) host number from preceding element if it was a domain literal (0 = none)
;  0(p) string ptr to start of next element
PRSD00:	MOVE A,0(P)
	ILDB C,A		; Get first char
	CAIN C,"["
	 JRST PRSD10		; Domain literal of form "[a.b.c.d]"
	CAIN C,"#"
	 JRST PRSD20		; Domain literal of form "#n"
	JRST PRSD02		; Start of name

; Domain name
PRSD01:	ILDB C,A		; Scan for end
PRSD02:	CAIN C,"."		; End of element (with more to come)?
	 JRST [	EXCH A,0(P)	; Yes, save new start
	 	MOVEM A,-2(P)	; Save start of element just scanned
	 	SETZM -1(P)	; Previous domain literal no longer relevant
	 	JRST PRSD00]	; Consider next element
	CAIE C,","		; End of entire domain?
	CAIN C,":"
	 CAIA			; Yes
	JUMPN C,PRSD01		; No, continue

; Reached end of domain expression, and final (or only) element was a name.
	SKIPN -2(P)		; Was there a previous element (name or literal)?
	SKIPE -1(P)
	 JRST PRSD04		; Yes
	EXCH A,0(P)		; No, save current point and get start of this element
	MOVEM A,-2(P)		; Say this is the one of interest
	JRST PRSD06		; Bypass local root domain check

; Assume element just scanned is the root domain.  See if it is the local root domain
PRSD04:	PUSH P,A		; Save position
	PUSH P,C		; Save terminator
	SETZ C,			; Temporarily zap with null
	DPB C,A
	MOVE A,-2(P)		; See if it is the local root domain
	HRROI B,ROTDMN
	PUSHJ P,NAMCHK
	 TDZA B,B		; No
	 SETO B,		; Yes
	POP P,C
	POP P,A
	DPB C,A			; Restore terminator
	JUMPN B,PRSD06		; If local root domain, look up previous element as host name

; Last element is not the local root domain.  Look it up as a host name; if this
; succeeds then it is the host name of interest.
	EXCH A,0(P)		; Save current position, get start of name just scanned
	MOVEM A,-2(P)		; Put it in position to be looked up
	SETZM -1(P)		; Previous literal no longer relevant

; Look up previous element as host name of interest.
PRSD06:	SKIPE -1(P)		; Was it a domain literal?
	 JRST PRSD93		; Yes, done
	LDB C,0(P)		; Save terminator
	PUSH P,C
	SETZ C,			; Temporarily zap with null
	DPB C,-1(P)
	MOVEI A,.GTHSN		; Translate name to number
	MOVE B,-3(P)
	GTHST
	 SETZ C,		; Failed
	POP P,B			; Restore terminator
	DPB B,0(P)
	MOVEM C,-1(P)		; Save result
	JRST PRSD93		; Return +3 if succeeded, +2 if failed

; Parse domain literal of form "[a.b.c.d]"
PRSD10:	SETZ D,
PRSD11:	MOVEI C,^D10
	NIN
	 JRST PRSD91		; Syntax error, return +1
	CAIL B,0
	CAIL B,^D256
	 JRST PRSD91
	LSH D,^D8
	IORI D,0(B)
	LDB B,A
	CAIN B,"."
	 JRST PRSD11
	CAIN B,"]"
	TLNE D,(17B3)
	 JRST PRSD91
	ILDB B,A		; Skip over "]"
	JRST PRSD30

; Parse domain literal of form "#n"
PRSD20:	MOVEI C,^D10
	NIN
	 JRST PRSD91
	MOVE D,B
	TLNE D,(17B3)
	 JRST PRSD91

; End of domain literal; current string ptr in A, host number in D.
PRSD30:	JUMPE D,PRSD91		; Zero is illegal
	MOVEM D,-1(P)		; Save host number
	SETZM -2(P)		; No previous string
	MOVEM A,0(P)		; Current point
	LDB C,A			; Get terminator
	JUMPE C,PRSD93		; Jump if end of string
	CAIE C,","
	CAIN C,":"
	 JRST PRSD93		; End of string, success
	JRST PRSD00		; Back around to parse next element

PRSD93:	SKIPE A,-1(P)		; Get answer
	 AOS -3(P)		; Return +3
PRSD92:	AOS -3(P)		; Return +2
PRSD91:	SUB P,[3,,3]
	POPJ P,

; Check for existence of local mailbox
;	B/ String ptr to recipient name
; Returns +1: Doesn't exist
;	+2: Exists
; Clobbers A-C, TEMP buffer

CKLMBX:	MOVSI A,(1B0+1B2+1B8+1B17)  ; Output, old file, ign deleted
	PUSHJ P,GTJMBX		; Get JFN for mailbox
	 POPJ P,
	MOVE B,[1,,1]		; Is alleged mailbox permanent?
	MOVEI C,C
	GTFDB
	RLJFN
	 PUSHJ P,SCREWUP##
	SKIPL MBXIDX		; Is context Retrieve?
	TLNE C,(1B1)		; No, is alleged mailbox permanent?
	 JRST SKPRET##		; Yes or yes, allow
	POPJ P,			; No, disallow delivery of new mail


; Get JFN for local mailbox
;	A/ GTJFN flags
;	B/ String ptr to recipient name
; Returns +1: Doesn't exist, A/ error code
;	+2: Exists, A/ JFN
; Clobbers A-C, TEMP buffer

GTJMBX:	HLLM A,0(P)		; Save GTJFN flags
	TLC B,-1
	TLCN B,-1
	 HRLI B,(POINT 7)
	MOVE A,[POINT 7,TEMP]	; Make mailbox filename
	MOVEI C,"<"
GTJMB1:	IDPB C,A
	ILDB C,B		; Copy recipient name thru "." or null
	CAIE C,"."
	 JUMPN C,GTJMB1
	PUSH P,A
	SETZ C,
	IDPB C,A
	HRROI A,TEMP		; Disallow System
	HRROI B,[ASCIZ /<SYSTEM/]
	PUSHJ P,NAMCHK
	 CAIA
	  JRST [MOVEI A,GJFX24	; Fake error code
		SUB P,[1,,1]
	  	POPJ P,]
	POP P,A
	UWRITE A,[ASCIZ />MESSAGE.TXT;1/]
	HLLZ A,0(P)		; Recover GTJFN flags
	HRROI B,TEMP
	GTJFN			; See if it exists
	 POPJ P,		; No
	JRST SKPRET##		; Yes

; Check registry name
;	A/ string ptr to registry name
; Returns +1: Error, illegal registry
;	+2: Non-local registry
;	+3: Local registry
; Clobbers A-D

CHKREG:	TLC A,-1
	TLCN A,-1
	 HRLI A,(POINT 7)
	PUSH P,A		; Save start of registry name
	HRROI B,LCLREG		; Is it the local registry?
	PUSHJ P,NAMCHK
	 JRST CHKRE3		; No
	POP P,A			; Yes, return +3
	JRST SK2RET##

CHKRE3:	POP P,A
	MOVE B,[1B0+2B17+C]	; Try to parse tail as Pup address expression
	PUPNM
	 JRST [	CAIN A,PUPNX7	; Failed, because no name lookup server responded?
		 JRST SKPRET##	; Yes, accept as non-local registry name
		POPJ P,]	; No, reject
	TRNE C,-1		; Real host address?
	CAIE D,7		; Real mail registry (socket 7)?
	 POPJ P,		; No, illegal
	MOVE B,LCLHPT##		; Yes, compare with local host address(es)
	CAMN C,0(B)
	 JRST SK2RET##		; Local registry, return +3
	AOBJN B,.-2
	JRST SKPRET##		; Non-local registry, return +2



; Compare names
;	A/ one string pointer
;	B/ another string pointer
; Returns +1:  not equal
;	+2:  equal
; Case differences are ignored
; In not equal case, A and B point to first non-matching characters.
; In equal case, A and B point to trailing nulls.

NAMCHK:	PUSH P,C
	PUSH P,D
	TLC A,-1		; Convert -1 lh to string ptr
	TLCN A,-1
	 HRLI A,(POINT 7)
	TLC B,-1
	TLCN B,-1
	 HRLI B,(POINT 7)
NAMCH1:	ILDB C,A		; Get chars to compare
	ILDB D,B
	CAIE C,(D)		; Try exact match first
	 JRST [	XORI C,40	; Not equal, try flipping case
		CAIE C,(D)	; Now equal?
		 JRST NAMCH2	; No, definitely a mismatch
		TRZ C,40	; Maybe, see if alphabetic
		CAIL C,"A"
		CAILE C,"Z"
		 JRST NAMCH2	; No, fail
		JRST NAMCH1]	; Yes, continue
	JUMPN C,NAMCH1		; Exact match, end?
	AOS -2(P)		; Yes, preset skip return
NAMCH2:	POP P,D
	POP P,C
	POPJ P,

; Initialize hash table
; Returns +1
; Clobbers A

INIHSH:	SETZM HSHTAB
	MOVE A,[HSHTAB,,HSHTAB+1]
	BLT A,HSHTAB+LHSHTB-1
	MOVEI A,HOVTAB
	MOVEM A,HOVFRE
	POPJ P,


; Insert string into hash table
;	A/ pointer to name (ASCIZ, starts at word boundary)
; Returns +1: Duplicate name
;	+2: Normal (not duplicate)
; Note: upon +2 return, hash table retains pointer to string passed in A,
; so caller must not modify it thereafter.
; Clobbers A-D

INSHSH:	HRLM A,0(P)		; Save name ptr
	HRLI A,(POINT 7)
	SETZ B,
INSHS1:	ILDB C,A		; Hash all characters of name
	JUMPE C,INSHS2
	ANDCMI C,40		; Hash function insensitive to case
	ADDI B,0(C)		; Add and cycle
	ROT B,1
	JRST INSHS1

INSHS2:	TLZ B,(1B0)		; Hash done, make sure positive
	IDIVI B,LHSHTB		; Remainder is HSHTAB probe
	MOVEI C,HSHTAB(C)
	SKIPN 0(C)		; Check HSHTAB entry
	 JRST INSHS4		; Empty, insert new name here

; Non-empty hash table entry.  Compare our name with all names in list.
INSHS3:	HLRO A,0(P)		; Our name
	HLRO B,0(C)		; Name from list
	PUSHJ P,NAMCHK		; Compare name strings
	 SKIPA D,C		; Not equal
	  POPJ P,		; Return +1: duplicate
	HRRZ C,0(C)		; Next entry in list
	JUMPN C,INSHS3		; Jump if there is one

; Did not match any name in list.  Append new name to end.
; D points to last existing entry in list.
	MOVE C,HOVFRE		; Allocate cell in overflow table
	AOS HOVFRE
	HRRM C,0(D)		; Append cell to last entry
INSHS4:	HLRZ A,0(P)		; Put pointer to name in new cell
	HRLZM A,0(C)
	JRST SKPRET##		; Return +2: normal

; Miscellaneous server routines called from top fork in PUPSRV.MAC

; Mail check
MAICHK::HRLM A,0(P)		; Save request type
	HRROI A,TEMP+100	; Where to put name string
	MOVEI B,PBCONT(PB)	; Where to get it from
	HRLI B,(POINT 8)
	LDB C,PUPLEN		; Compute # of Pup content bytes
	MOVNI C,-MNPLEN(C)
	JUMPE C,MAICHF
	SOUT
	HRROI A,TEMP+100	; Check for local registry
	PUSHJ P,CKLREG
	 JRST MAICHF		; Not local, fail
	HRROI B,TEMP+100	; Where to get user name from
	MOVSI A,(1B2+1B17)	; Old file, name from string
	PUSHJ P,GTJMBX		; Get JFN for mailbox file
	 JRST [	CAIL A,GJFX18	; Not there, see why
		CAILE A,GJFX21
		 CAIN A,GJFX24
		  JRST NOMAIL	; File not found error, just say no new mail
		JRST MAICHF]	; Syntax error or no such dir, complain
	MOVE B,[25,,0]		; Ok, read the FDB
	MOVEI C,TEMP
	GTFDB
	RLJFN			; Get rid of the JFN
	 PUSHJ P,SCREWUP##
	HLRZ A,0(P)		; Get request type
	CAIN A,214		; Laurel variant?
	 JRST [	SKIPN TEMP+12	; Yes, just check for non-emptiness
		 JRST NOMAIL
		MOVEI B,MNPLEN	; Don't do time/user stuff --
		DPB B,PUPLEN	; just send empty reply Pup
		JRST OKMAI1]
	MOVE B,TEMP+14		; Msg variant, get write date/time
	CAMG B,TEMP+15		; Written later than read?
	 JRST NOMAIL		; No

; New mail exists
OKMAIL:	MOVEI A,PBCONT(PB)	; Init byte ptr into packet
	HRLI A,(POINT 8)
	HLRZ C,TEMP+6		; Get last writer dir #
	WRITE <%2T %3U>		; Write date/time and user into Pup
	PUSHJ P,ENDPUP##	; Compute and store length
OKMAI1:	PUSHJ P,SWPPRT##	; Swap source and destination
	MOVEI A,211		; Reply Pup Type
	JRST MAICH2		; Join common code

; Here if no mail
NOMAIL:	MOVEI A,MNPLEN		; Minimum length
	DPB A,PUPLEN
	PUSHJ P,SWPPRT##	; Swap source and destination
	MOVEI A,212		; Pup Type for reply

MAICH2:	PUSHJ P,SNDPUP##	; Send it out
	 POPJ P,		; Failed
	HRROI B,TEMP+100	; Ok, recover user name string
	TLNE F,(DEBUGF)		; Log only if debugging
	 LOG <Mail Check "%2S" for %1P>
	POPJ P,

; Here if failed to find mailbox
MAICHF:	LOG <Mail check "%C" failed for %2P>
	MOVEI A,213		; Pup type for Mail Check error
	HRROI B,[ASCIZ /No such mailbox exists/]
	JRST REPSTR##		; Send the reply and return

; Authenticate User request
; Pup contains user name and password as two Mesa strings (!!)

AUTHUS::PUSHJ P,SAVE1##
	HRROI A,TEMP		; Transfer user name to temp buffer
	MOVEI B,PBCONT(PB)
	HRLI B,(POINT 16)
	TRZ F,RAISEF
	PUSHJ P,GMESTR
	 JRST ILLSTR
	MOVE P1,B		; Save source pointer
	HRROI A,TEMP		; Check and strip off local registry name
	PUSHJ P,CKLREG
	 JRST ILLREG		; Illegal
	SETZ A,			; Convert string to dir number
	HRROI B,TEMP
	STDIR
	 CAI			; No such user name
	 JRST [	HRROI B,[ASCIZ /Illegal user name/]
		JRST AUFAIL]
	JUMPL A,[HRROI B,[ASCIZ /Files-only directory name not permitted/]
		JRST AUFAIL]
	HRLM A,0(P)		; Save dir number
	HRROI A,TEMP+100	; Transfer password
	MOVE B,P1
	TRO F,RAISEF		; Raise lower-case letters
	PUSHJ P,GMESTR
	 JRST ILLSTR
	HLRZ A,0(P)		; Recover dir number
	HRLI A,(1B0)		; Just check password
	HRROI B,TEMP+100	; Where the password is
	CNDIR
	 JRST [	HRROI B,[ASCIZ /Incorrect password/]
		JRST AUFAIL]
	MOVEI A,MNPLEN		; Ok, set up reply
	DPB A,PUPLEN
	PUSHJ P,SWPPRT##
	MOVEI A,251		; Positive response type
	PUSHJ P,SNDPUP##
	 POPJ P,
IFN RECPWF,<
	HLRZ A,0(P)		; Dir number
	HRROI B,TEMP+100	; Password
	PUSHJ P,RECPAS
>
	HRROI A,TEMP
	TLNE F,(DEBUGF)		; Log only if debugging
	 LOG <Authenticate user "%1S">
	POPJ P,

; Error conditions
ILLSTR:	ELOG <Malformed Mesa string in request Pup from %2P>
	POPJ P,

ILLREG:	HRROI B,[ASCIZ /Invalid registry name/]

; B/ string ptr to error message
AUFAIL:	HRROI A,TEMP
	LOG <Authenticate "%1S" failed for %2P%/ - %2S>
	MOVEI A,252		; Negative response type
	JRST REPSTR##		; Append string and send Pup

; Validate Recipient request
; Pup contains recipient name as a Mesa string (!!)

VALREC::HRROI A,TEMP		; Transfer user name to temp buffer
	MOVEI B,PBCONT(PB)
	HRLI B,(POINT 16)
	TRZ F,RAISEF
	PUSHJ P,GMESTR
	 JRST ILLSTR
	HRROI A,TEMP		; Check and strip off local registry name
	PUSHJ P,CKLREG
	 JRST VALRNO		; Illegal

; Answer "Yes" if recipient is a registered Maxc user -- but don't actually
; look for mailbox, since it could be on the other machine.
	SETZ A,			; Convert string to dir number
	HRROI B,TEMP
	STDIR
	 CAI			; No such user name
	 JRST VRFAIL
	
VALROK:	MOVEI A,267		; Positive response type
	PUSHJ P,REPNUL##
	HRROI A,TEMP
	TLNE F,(DEBUGF)		; Log only if debugging
	 LOG <Validate Recipient "%1S">
	POPJ P,

; Here if not a registered Maxc user.  Now look in forwarding data base.
; *** For now, punt and return "No" ***
VRFAIL:

; Return "No" response
VALRNO:	HRROI A,TEMP
	LOG <Validate Recipient "%1S" failed for %2P>
	MOVEI A,270		; Negative response type
	JRST REPNUL##		; Append string and send Pup
	
	
; Check recipient name for local registry
;	A/ string ptr to recipient name, with optional ".registry"
; Returns +1: error, illegal registry
;	+2: normal, ".registry" stripped off if present
; Clobbers A-D

CKLREG:	TLC A,-1
	TLCN A,-1
	 HRLI A,(POINT 7)
	ILDB C,A
	JUMPE C,SKPRET##	; No registry, implicitly local
	CAIE C,"."
	 JRST .-3
	SETZ C,			; Smash with null
	DPB C,A
	PUSHJ P,CHKREG		; Ok, check registry name
	 POPJ P,		; Illegal
	 POPJ P,		; Legal but not local
	JRST SKPRET##		; Local

; Get Mesa string
;	A/ Destination string pointer
;	B/ 16-bit byte pointer to Mesa string structure
;	RAISEF set in F iff lower-case letters are to be raised
; Returns +1:  Error, string malformed
;	+2:  Successful:
;	A/ Updated string pointer
;	B/ Updated 16-bit byte pointer (advanced past end of Mesa string)
; Clobbers C, D

GMESTR:	TLC A,-1		; Convert destination pointer if necessary
	TLCN A,-1
	 HRLI A,(POINT 7)
	ILDB C,B		; Get length
	CAIL C,0		; Ensure in range
	CAILE C,^D39
	 POPJ P,
	ILDB D,B		; Get maxLength
	TRNE D,1		; Force it to be even
	 ADDI D,1
	CAIL D,0		; Ensure in range
	CAILE D,^D40
	 POPJ P,
	SUB D,C			; Compute maxLength-length
	JUMPL D,CPOPJ##		; Ensure length <= maxLength
	HRLM D,0(P)		; Save maxLength-length
	TLC B,(30B11)		; Convert source pointer to 8-bit bytes
	JUMPE C,GMEST2		; In case empty string
GMEST1:	ILDB D,B		; Get a byte
	CAIL D,"a"		; Lower-case?
	CAILE D,"z"
	 JRST .+3		; No
	TRNE F,RAISEF		; Yes, want to raise it?
	 SUBI D,40		; Yes, do so
	IDPB D,A		; Store in destination string
	SOJG C,GMEST1		; Repeat for all
GMEST2:	MOVE D,A		; Store null at end
	IDPB C,D
	HLRZ D,0(P)		; Recover maxLength-length
	JUMPE D,.+3
	IBP B			; Advance source pointer to maxLength
	SOJG D,.-1
	TLC B,(30B11)		; Convert back to 16-bit bytes
	JRST SKPRET##		; Return +2

IFN RECPWF,<	; Password-recording hack

; Initialize password-recording file
; Returns +1
; Clobbers A, B
; Password file format:  password for directory number i is stored
; as an ASCIZ string starting at byte position 40*i in the file.

INIPAS:	MOVSI A,(1B0+1B17)
	HRROI B,[ASCIZ /<SYSTEM>PUPSRV.PAS;1;P770000/]
	GTJFN
	 POPJ P,
	MOVEM A,PASJFN
	MOVE B,[7B5+1B19+1B20+1B25] ; R+W, thawed
	OPENF
	 JRST [	MOVE A,PASJFN
		RLJFN
		 PUSHJ P,SCREWUP##
		SETZM PASJFN
		POPJ P,]
	POPJ P,


; Record password
;	A/ directory number
;	B/ string ptr to password
; Returns +1 always
; Clobbers A-C

RECPAS::SKIPN PASJFN
	 POPJ P,
	PUSH P,B
	MOVE B,A
	IMULI B,^D40
	MOVE A,PASJFN
	SFPTR
	 PUSHJ P,SCREWUP##
	POP P,B
	SETZ C,
	SOUT
	POPJ P,

GS PASJFN
> ; End IFN RECPWF

; Initialize mail server
; Returns +1

INIMLS::MOVEI A,.GTHSZ		; Get local Arpanet host number
	GTHST
	 SETZ D,
	MOVEM D,LHOSTN		; Remember it

	TLNN F,(ENABLF)		; Are we the system server?
	 POPJ P,		; No, nothing to do
	MOVSI A,(1B2+1B17)	; Look for <SYSTEM>MAILER.FLAGS
	HRROI B,[ASCIZ /<SYSTEM>MAILER.FLAGS;1/]
	GTJFN
	 JRST INIML9		; Failed
	MOVE C,A
	MOVEI B,1B19+1B20+1B25	; R+W, thawed
	OPENF
	 JRST INIML8		; Failed
	MOVSI A,0(A)		; JFN ,, page 0
	MOVEI B,MFLAGS
	LSH B,-9
	HRLI B,400000		; This fork ,, page number
	MOVSI C,(1B2+1B3)	; R+W
	PMAP			; Map flag page into this fork
INIMLX:
IFN RECPWF,<
	PUSHJ P,INIPAS
>
	POPJ P,

; Failures
INIML8:	EXCH A,C
	RLJFN
	 PUSHJ P,SCREWUP##
	MOVE A,C
INIML9:	ELOG <Failed to open <SYSTEM>MAILER.FLAGS%/ - %1J>
	JRST INIMLX


; Local registry name -- Maxc is a repository for mailboxes in this registry,
; even though Maxc may not be a member of this registry according
; to the name lookup data base.
LCLREG:	ASCIZ /PA/

; ArpaGateway registry name
ARPREG:	ASCIZ /ArpaGateway/

; Mail forwarding host name (i.e., Grapevine)
FWDHST:	ASCIZ /GV/

; Root of local ARPA Internet domain
ROTDMN:	ASCIZ /ARPA/

; Storage

LS MBXFRK		; Fork handle for mailbox finder
LS MBXLEN		; Length of mailbox
LS MBXPGN		; Current page number
LS MBXCNT		; Byte count
LS MBXBYT		; Byte pointer
LS DATREC		; Date received
LS MSGLEN		; Length of message in bytes
LS MSGFLG		; Message flags in stamp
LS NDELIV		; Number of copies delivered
LS NQUEUE		; Number of copies queued
LS NDUPLI		; Number of duplicate copies suppressed
LS QUEJFN		; JFN for [--UNDISTRIBUTED-MAIL--] file
LS QUEPTR		; File pointer to start of current message
LS ARCJFN		; JFN for MESSAGE.ARCHIVE file

; Temps during recipient name parsing
LS LCLPRT		; Local-prt
LS DOMAIN		; Domain
LS SRCROU		; Source-route

GS LHOSTN		; Local Arpanet host number

; Mailbox (recipient) list:
; MBXTAB format: flags ,, pointer
; B0 => must queue message for this recipient
; B1 => mailbox exception
; RH: pointer to recipient name or mailbox exception text (ASCIZ string)

LS MBXFRE		; -> first free word in MBXBUF
LS MBXIDX		; Current mailbox index
LS MBXTAB,LMBXTB	; Table of pointers to mailbox names
LSP MBXBUF,<LMBXTB*20>/1000 ; Storage for names and Mailbox-exception text

; Hash table, for duplicate elimination:
; HSHTAB is primary table, HOVTAB is overflow table.
; HSHTAB or HOVTAB entry format:
;	pointer to name string ,, pointer to (next) overflow entry (0 => none)

LS HOVFRE		; -> first free entry in HOVTAB
LS HSHTAB,LHSHTB	; Hash table
LS HOVTAB,LMBXTB	; Hash overflow table

GSP MFLAGS		; Page mapped into <SYSTEM>MAILER.FLAGS

	END