;<PUP>PUPMLS.MAC;79 20-OCT-83 10:04:06 EDIT BY TAFT
; Fix bugs in cheeck for Arpanet host = me
;<PUP>PUPMLS.MAC;78 14-MAY-83 15:44:50 EDIT BY TAFT
; Allow "AG" as synonym for "ArpaGateway"
;<PUP>PUPMLS.MAC;77 31-JAN-83 08:33:08 EDIT BY TAFT
; If Sender property ends in ".ArpaGateway", strip it off
;<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.
MOVE C,ARPRGS ; Check table of ArpaGateway aliases
HAVRE1: MOVE A,P2
MOVE B,0(C)
PUSHJ P,NAMCHK ; Skip if match
AOBJN C,HAVRE1
JUMPL C,REGARP ; Jump if any matched: 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 A,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, except if it
; ends in ".ArpaGateway" we strip that off.
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)
PUSH P,A
MOVE A,[POINT 7,P.SNDR(P1)]
SETZ D,
PPSND1: ILDB B,A ; Search for last "."
CAIN B,"."
MOVE D,A
JUMPN B,PPSND1
JUMPE D,PPSND3 ; Jump if no "."
MOVE C,ARPRGS ; Check table of ArpaGateway aliases
PPSND2: MOVE A,0(C)
MOVE B,D
PUSHJ P,NAMCHK ; Skip if matched
AOBJN C,PPSND2
JUMPGE C,PPSND3 ; Jump if none matched
SETZ B, ; Matched, overwrite "." with null
DPB B,D
PPSND3: POP P,A
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/
; ARPA registry names (ArpaGateway and aliases)
ARPRGS: -3 ,, .+1
POINT 7,[ASCIZ /ArpaGateway/]
POINT 7,[ASCIZ /AG/]
POINT 7,[ASCIZ /ARPA/]
; 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