DIRECTORY Arpa USING [Address, nullAddress], ArpaConfig USING [ourLocalName, resolv], ArpaSMTPControl USING [arpaMSPort, OKToAcceptSMTPInput], ArpaSMTPDescr USING [Create, CreateFailed, Descr, Unparse], ArpaSMTPQueue USING [AddNewMessage, StartNewMessage], ArpaSMTPRcvr USING [], ArpaSMTPSupport USING [Log, Now], ArpaSMTPSyntax USING [BlessReturnPath], ArpaTCP USING [DByte, AbortTCPStream, CreateTCPStream, Error, ErrorFromStream, GetRemoteSocket, TCPInfo, Timeout, WaitForListenerOpen], ConvertExtras USING [RopeFromArpaAddress], IO USING [Close, CreateStream, CreateStreamProcs, EndOfStream, Error, Flush, GetChar, PeekChar, PutChar, PutRope, STREAM, StreamProcs, StreamVariety], Process USING [Abort, Detach], RefText USING [Fetch, Find, InlineAppendChar, New, SkipOver], Rope USING [Cat, Concat, Equal, Find, FromRefText, IsEmpty, NewText, ROPE, SkipOver, Substr, Text], RuntimeError USING [BoundsFault]; ArpaSMTPRcvrImpl: CEDAR PROGRAM IMPORTS ArpaConfig, ArpaSMTPControl, ArpaSMTPDescr, ArpaSMTPQueue, ArpaSMTPSupport, ArpaSMTPSyntax, ArpaTCP, ConvertExtras, IO, Process, RefText, Rope, RuntimeError EXPORTS ArpaSMTPRcvr = BEGIN ROPE: TYPE = Rope.ROPE; STREAM: TYPE = IO.STREAM; RC: TYPE = { rc211, rc214, rc220, rc221, rc250, rc251, rc354, rc421, rc450, rc451, rc452, rc500, rc501, rc502, rc503, rc504, rc550, rc551, rc552, rc553, rc554}; ReplyRec: TYPE ~ RECORD [rc, text: ROPE]; Replies: ARRAY RC OF ReplyRec = [ rc211: ReplyRec["211", "System status"], rc214: ReplyRec["214", "Help Message"], rc220: ReplyRec["220", Rope.Concat[ArpaConfig.ourLocalName, " Simple Mail Transfer Service ready"]], rc221: ReplyRec["221", Rope.Concat[ArpaConfig.ourLocalName, " Service closing transmission channel"]], rc250: ReplyRec["250", "Requested mail action okay, completed"], rc251: ReplyRec["251", "User not local"], rc354: ReplyRec["354", "Start mail input; end with ."], rc421: ReplyRec["421", Rope.Concat[ArpaConfig.ourLocalName, "Service not available, closing channel"]], rc450: ReplyRec["450", "Requested mail action not taken: mailbox unavailable"], rc451: ReplyRec["451", "Requested action aborted: local error in processing"], rc452: ReplyRec["452", "Requested action not taken: insufficient system storage"], rc500: ReplyRec["500", "Syntax error, command unrecognized"], rc501: ReplyRec["501", "Syntax error in parameters or arguments"], rc502: ReplyRec["502", "Command not implemented"], rc503: ReplyRec["503", "Bad sequence of commands"], rc504: ReplyRec["504", "Command parameter not implemented"], rc550: ReplyRec["550", "Requested action not taken: mailbox unavailable"], rc551: ReplyRec["551", "User not local"], rc552: ReplyRec["552", "Requested mail action aborted: exceeded storage allocation"], rc553: ReplyRec["553", "Requested action not taken: mailbox name not allowed"], rc554: ReplyRec["554", "Transaction failed"]]; Reply: PROC [out: IO.STREAM, rc: RC, t1, t2, t3, t4, t5, t6, t7, t8: ROPE _ NIL] = { r: ReplyRec ~ Replies[rc]; IF t1 = NIL AND t2 = NIL AND t3 = NIL AND t4 = NIL AND t5 = NIL AND t6 = NIL AND t7 = NIL AND t8 = NIL THEN t1 _ r.text; out.PutRope[r.rc]; out.PutChar[' ]; out.PutRope[t1]; out.PutRope[t2]; out.PutRope[t3]; out.PutRope[t4]; out.PutRope[t5]; out.PutRope[t6]; out.PutRope[t7]; out.PutRope[t8]; out.PutRope["\n\l"]; out.Flush[]; }; -- end Reply CMD: TYPE = {helo, mail, rcpt, data, rset, send, soml, saml, vrfy, expn, help, noop, quit, turn}; CommandProc: TYPE = PROC [session: REF SessionRec]; CommandRec: TYPE = RECORD [name: ROPE, Action: CommandProc _ NotImpl]; Commands: ARRAY CMD OF CommandRec = [ helo: CommandRec["HELO", HELOcmd], mail: CommandRec["MAIL", MAILcmd], rcpt: CommandRec["RCPT", RCPTcmd], data: CommandRec["DATA", DATAcmd], rset: CommandRec["RSET", RSETcmd], send: CommandRec["SEND"], soml: CommandRec["SOML"], saml: CommandRec["SAML"], vrfy: CommandRec["VRFY"], expn: CommandRec["EXPN"], help: CommandRec["HELP"], noop: CommandRec["NOOP", NOOPcmd], quit: CommandRec["QUIT", QUITcmd], turn: CommandRec["TURN"] ]; CommandState: TYPE = REF CmdRestr; CmdRestr: TYPE = ARRAY CMD OF BOOL; InitState: CommandState = NEW[CmdRestr _ [ T, F, F, F, F, F, F, F, F, F, F, F, T, F ]]; ReadyState: CommandState = NEW[CmdRestr _ [ T, T, F, F, T, T, T, T, T, T, T, T, T, T ]]; RcptState: CommandState = NEW[CmdRestr _ [ F, F, T, F, T, F, F, F, F, F, F, T, T, F ]]; DataState: CommandState = NEW[CmdRestr _ [ F, F, T, T, T, F, F, F, F, F, F, T, T, F ]]; T: BOOL = TRUE; F: BOOL = FALSE; NotImpl: CommandProc = BEGIN inputLine: ROPE = Rope.FromRefText[session.inputLine]; ArpaSMTPSupport.Log[important, "Unimplemented command from ", session.sourceTxt, ": ", inputLine]; Reply[session.SMTPout, rc502]; END; -- end NotImpl HELOcmd: CommandProc = BEGIN line: REF TEXT = session.inputLine; last: INT _ session.lastScanned; last _ SkipWhite[line, last]; [session.heloTxt, last] _ GetDomain[line, last]; NoArgsToEOL[line, last]; Reply[session.SMTPout, rc250, ArpaConfig.ourLocalName]; ArpaSMTPSupport.Log[verbose, "Incoming SMTP conversation begun with ", session.sourceTxt, " = ", ConvertExtras.RopeFromArpaAddress[session.source], "."]; session.cmdState _ ReadyState; END; -- end HELOcmd MAILcmd: CommandProc = BEGIN line: REF TEXT = session.inputLine; last: INT _ session.lastScanned; last _ SkipWhite[line, last]; last _ SkipWord[line, last, "FROM:"]; IF line.length = 12 AND RefText.Fetch[line, 11] = '> THEN { -- Yetch, hack for MAXC ArpaSMTPSupport.Log[verbose, "\"MAIL FROM:<>\" from ", session.sourceTxt, ", fudging via Postmaster."]; session.reversePath _ Rope.Cat["Postmaster@", session.sourceTxt]; last _ 12; } ELSE [session.reversePath, last] _ GetPath[line, last]; NoArgsToEOL[line, last]; session.recipients _ NIL; Reply[session.SMTPout, rc250, "OK"]; session.cmdState _ RcptState; END; -- end MAILcmd RCPTcmd: CommandProc = BEGIN line: REF TEXT = session.inputLine; last: INT _ session.lastScanned; newRecipient: ROPE; last _ SkipWhite[line, last]; last _ SkipWord[line, last, "TO:"]; [newRecipient, last] _ GetPath[line, last]; NoArgsToEOL[line, last]; session.recipients _ CONS[newRecipient, session.recipients]; Reply[session.SMTPout, rc250, "OK"]; session.cmdState _ DataState; END; -- end RCPTcmd DATAcmd: CommandProc = BEGIN ENABLE ArpaSMTPDescr.CreateFailed => { ArpaSMTPSupport.Log[important, "Failed to create descriptor for input from ", session.sourceTxt, " = ", ConvertExtras.RopeFromArpaAddress[session.source], ". Rejecting request."]; Reply[session.SMTPout, rc452]; -- insuffient storage session.cmdState _ ReadyState; CONTINUE; -- i.e. RETURN }; descr: ArpaSMTPDescr.Descr; timeStampLine, returnPathLine: ROPE; gvSender: ROPE _ ArpaSMTPSyntax.BlessReturnPath[session.reversePath]; NoArgsToEOL[session.inputLine, session.lastScanned]; ArpaSMTPQueue.StartNewMessage[session.sourceTxt]; Reply[session.SMTPout, rc354]; timeStampLine _ Rope.Cat["Received: from ", session.heloTxt]; IF ~Rope.Equal[session.heloTxt, session.sourceTxt, FALSE] THEN timeStampLine _ Rope.Cat[timeStampLine, " (", session.sourceTxt, ")"]; timeStampLine _ Rope.Cat[timeStampLine, " by ", ArpaConfig.ourLocalName, " ;"]; timeStampLine _ Rope.Cat[timeStampLine, " ", ArpaSMTPSupport.Now[].rope]; returnPathLine _ Rope.Cat["Return-Path: <", session.reversePath, ">"]; descr _ ArpaSMTPDescr.Create[ arpaReversePath: session.reversePath, gvSender: gvSender, rawRecipients: session.recipients, source: session.sourceTxt, format: arpa, msgStream: CreateMailDataStream[session.SMTPin], precedeMsgText: timeStampLine, returnPathLine: returnPathLine]; ArpaSMTPQueue.AddNewMessage[descr, session.sourceTxt]; ArpaSMTPSupport.Log[ noteworthy, ArpaSMTPDescr.Unparse[descr], " accepted from ", session.sourceTxt, "."]; Reply[session.SMTPout, rc250]; session.cmdState _ ReadyState; END; -- end DATAcmd RSETcmd: CommandProc = BEGIN NoArgsToEOL[session.inputLine, session.lastScanned]; Reply[session.SMTPout, rc250, "Reset to ready state"]; session.cmdState _ ReadyState; END; -- end RSETcmd NOOPcmd: CommandProc = BEGIN NoArgsToEOL[session.inputLine, session.lastScanned]; Reply[session.SMTPout, rc250]; END; -- end NOOPcmd QUITcmd: CommandProc = BEGIN NoArgsToEOL[session.inputLine, session.lastScanned]; IF session.cmdState = InitState OR session.cmdState = ReadyState THEN { Reply[session.SMTPout, rc221]; ArpaSMTPSupport.Log[verbose, "Incoming SMTP conversation with ", session.sourceTxt, " ending."]; ERROR SMTPquit; -- proper session end } ELSE RSETcmd[session]; -- doc says to treat as RSET END; -- end QUITcmd CreateMailDataStream: PROC [stream: STREAM] RETURNS [STREAM] = { RETURN[IO.CreateStream[streamProcs: SMTPfilteredMsgProcs, backingStream: stream, streamData: NEW[MDSdata _ []]]]; }; MDSdata: TYPE = RECORD [line: REF TEXT _ RefText.New[1001], ptr: INT _ 0]; SMTPfilteredMsgProcs: REF IO.StreamProcs ~ IO.CreateStreamProcs[variety~IO.StreamVariety[input], class~$MsgData, getChar~MDSgetChar]; MDSgetChar: PROC [self: STREAM] RETURNS [CHAR] = { data: REF MDSdata ~ NARROW[self.streamData]; returnChar: CHAR; IF data.ptr >= data.line.length THEN { line: REF TEXT _ data.line; full: BOOL; line.length _ data.ptr _ 0; BEGIN ENABLE IO.EndOfStream => ERROR ArpaSMTPDescr.CreateFailed; [line, full] _ MyGetLine[self.backingStream, line]; IF self.backingStream.PeekChar[] = '\l THEN [] _ self.backingStream.GetChar[]; -- LF END; IF ~ full THEN line _ RefText.InlineAppendChar[line, '\n]; data.line _ line; IF (line.length = 2) AND (RefText.Fetch[line, 0] = '.) AND (RefText.Fetch[line, 1] = '\n) THEN { ERROR IO.EndOfStream[self]; }; -- normal exit; end of mail data IF RefText.Fetch[line, 0] = '. THEN data.ptr _ 1; -- remove . at beginning of line }; returnChar _ RefText.Fetch[data.line, data.ptr]; data.ptr _ data.ptr + 1; RETURN[returnChar]; }; -- end MDSgetChar MyGetLine: PROC [stream: STREAM, buffer: REF TEXT] RETURNS [line: REF TEXT, full: BOOL] = { buffer.length _ 0; DO char: CHAR _ IO.GetChar[stream ! IO.EndOfStream => IF buffer.length > 0 THEN EXIT ELSE REJECT]; IF char = '\n THEN RETURN[buffer, FALSE]; buffer _ RefText.InlineAppendChar[buffer, char]; IF buffer.length > 1000 THEN RETURN[buffer, TRUE]; ENDLOOP; }; ReadLine: PROC [InpStream: IO.STREAM, buffer: REF TEXT] ~ { quit, include, anySeen, nextCharEscaped: BOOL _ FALSE; buffer.length _ 0; DO char: CHAR ~ InpStream.GetChar[]; SELECT char FROM '\\ => {include _ anySeen _ TRUE; nextCharEscaped _ ~nextCharEscaped}; '\n => {IF nextCharEscaped THEN include _ TRUE ELSE { IF InpStream.PeekChar[] # '\l THEN ERROR SMTPerror[rc501, "CR must be followed by LF"]; [] _ InpStream.GetChar[]; -- Read LF include _ FALSE; quit _ anySeen; }; nextCharEscaped _ FALSE}; ENDCASE => {include _ anySeen _ TRUE; nextCharEscaped _ FALSE}; IF include THEN buffer _ RefText.InlineAppendChar[buffer, char]; IF quit THEN EXIT; ENDLOOP; }; -- end ReadLine SkipWord: PROC [inputLine: REF TEXT, last: INT, word: REF TEXT] RETURNS [INT] ~ { IF last+1 # RefText.Find[inputLine, word, last+1, FALSE] THEN ERROR SMTPerror[rc501]; -- bad parms last _ last + word.length; RETURN[last]; }; -- end SkipWord SkipWhite: PROC [inputLine: REF TEXT, last: INT] RETURNS [INT] ~ { RETURN[RefText.SkipOver[inputLine, last+1, " \t"] - 1]; }; GetPath: PROC [inputLine: REF TEXT, last: INT] RETURNS [ROPE, INT] ~ { start: INT ~ last+1; last _ CheckPath[inputLine, last]; RETURN[MakeRope[inputLine, start+1, last-1], last]; }; -- Prune <> GetDomain: PROC [inputLine: REF TEXT, last: INT] RETURNS [ROPE, INT] ~ { start: INT ~ last+1; last _ CheckDomain[inputLine, last]; RETURN[MakeRope[inputLine, start, last], last]; }; GetString: PROC [inputLine: REF TEXT, last: INT] RETURNS [ROPE, INT] ~ { start: INT ~ last+1; last _ CheckString[inputLine, last]; RETURN[MakeRope[inputLine, start, last], last]; }; NoArgsToEOL: PROC [inputLine: REF TEXT, last: INT] ~ { last _ SkipWhite[inputLine, last]; IF last < inputLine.length-1 THEN ERROR SyntaxErr[last]; }; MakeRope: PROC [buffer: REF TEXT, start, last: INT] RETURNS [ROPE] ~ { len: INT _ last+1-start; new: Rope.Text _ Rope.NewText[len]; FOR i: INT IN [0..len) DO new[i] _ buffer[start+i]; ENDLOOP; RETURN[new]; }; Enum: TYPE ~ {aChar, cChar, dChar, qChar, xChar}; Bounds: ERROR ~ RuntimeError.BoundsFault; FetchIt: PROC [self: REF TEXT, i: INT] RETURNS [CHAR] = { RETURN[RefText.Fetch[self, i]]; }; -- Inlines don't like ! Bounds => Fetch: PROC [self: REF TEXT, i: INT] RETURNS [CHAR] = { RETURN[FetchIt[self, i ! Bounds => ERROR SyntaxErr[self.length-1]]]}; CheckPath: PROC [path: REF TEXT, last: INT] RETURNS [INT] ~ { IF Fetch[path, last _ last+1] # '< THEN ERROR SyntaxErr[last]; WHILE Fetch[path, last+1] = '@ DO last _ last + 1; last _ CheckDomain[path, last]; last _ last + 1; IF Fetch[path, last] = ': THEN EXIT; IF Fetch[path, last] # ', THEN ERROR SyntaxErr[last]; IF Fetch[path, last+1] # '@ THEN ERROR SyntaxErr[last+1]; ENDLOOP; last _ CheckMailbox[path, last]; IF Fetch[path, last _ last+1] # '> THEN ERROR SyntaxErr[last]; RETURN[last]; }; -- end CheckPath CheckMailbox: PROC [mbox: REF TEXT, last: INT] RETURNS [INT] ~ { IF Fetch[mbox, last+1] = '" THEN { -- quoted-string last _ last+1; IF Fetch[mbox, last+1] = '" THEN ERROR SyntaxErr[last+1]; DO IF Fetch[mbox, last _ last+1] = '\\ --SyntaxErr if Bounds: should at least be a "-- THEN {IF ~CharIs[Fetch[mbox, last _ last+1], xChar] THEN ERROR SyntaxErr[last]} ELSE {IF ~CharIs[Fetch[mbox, last], qChar] THEN ERROR SyntaxErr[last]}; IF Fetch[mbox, last+1] = '" THEN {last _ last+1; EXIT}; ENDLOOP; } ELSE { -- dot-string DO last _ CheckString[mbox, last]; IF Fetch[mbox, last+1] # '. THEN EXIT; -- normal dot-string exit last _ last+1; ENDLOOP; }; IF Fetch[mbox, last _ last+1] # '@ THEN ERROR SyntaxErr[last]; last _ CheckDomain[mbox, last]; RETURN[last]; }; -- end CheckMailbox CheckDomain: PROC [domain: REF TEXT, last: INT] RETURNS [INT] ~ { DO -- read an element, and repeat if it is followed by a "." (and another element) c: CHAR = Fetch[domain, last+1]; SELECT c FROM '# => last _ CheckNumber[domain, last+1]; '[ => { last _ CheckDotnum[domain, last+1]; IF Fetch[domain, last _ last+1] # '] THEN ERROR SyntaxErr[last]; }; ENDCASE => last _ CheckName[domain, last]; IF FetchIt[domain, last+1 ! Bounds => EXIT] # '. THEN EXIT; -- normal exit last _ last+1; ENDLOOP; RETURN[last]; }; -- end CheckDomain CheckNumber: PROC [num: REF TEXT, last: INT] RETURNS [INT] ~ { last _ last + 1; IF ~CharIs[FetchIt[num, last], dChar] THEN SyntaxErr[last]; DO IF ~CharIs[FetchIt[num, last+1 ! Bounds => EXIT], dChar] THEN EXIT; last _ last + 1; ENDLOOP; RETURN[last]; }; -- end CheckNumber CheckDotnum: PROC [dotn: REF TEXT, last: INT] RETURNS [INT] ~ { last _ CheckSnum[dotn, last]; THROUGH [0..3) DO IF Fetch[dotn, last _ last+1] # '. THEN ERROR SyntaxErr[last]; last _ CheckSnum[dotn, last]; ENDLOOP; RETURN[last]; }; -- end CheckDotnum CheckName: PROC [name: REF TEXT, last: INT] RETURNS [INT] ~ { validName: BOOL _ TRUE; c: CHAR _ Fetch[name, last _ last+1]; IF ~CharIs[c, aChar] THEN ERROR SyntaxErr[last]; DO c _ FetchIt[name, (last _ last+1) ! Bounds => EXIT]; IF ~(c = '- OR CharIs[c, aChar] OR CharIs[c, dChar]) THEN EXIT; ENDLOOP; IF c = '- THEN ERROR SyntaxErr[last]; last _ last-1; RETURN[last]; }; -- end CheckName CheckSnum: PROC [snum: REF TEXT, last: INT] RETURNS [INT] ~ { start: INT ~ last+1; val: INT _ 0; last _ CheckNumber[snum, last]; -- assuming an snum is never followed by a digit FOR i: INT IN [start..last] DO val _ (10*val) + (Fetch[snum, i]-'0) ENDLOOP; IF val > 255 THEN ERROR SyntaxErr[last]; RETURN[last]; }; CheckString: PROC [str: REF TEXT, last: INT] RETURNS [INT] ~ { start: INT = last; last _ last + 1; DO IF FetchIt[str, last ! Bounds => EXIT] = '\\ THEN { last _ last + 2; IF ~CharIs[Fetch[str, last], xChar] THEN ERROR SyntaxErr[last]} ELSE { IF ~CharIs[Fetch[str, last+1], cChar] THEN EXIT; last _ last + 1; }; ENDLOOP; IF last = start THEN ERROR SyntaxErr[last+1]; -- nothing read RETURN[last]; }; CharIs: PROC [c: CHAR, t: Enum] RETURNS [BOOL] = { subType: TYPE = {alpha, digit, space, crlf, quoteSlosh, subSpecial, others}; cSubType: subType _ SELECT c FROM IN['a..'z], IN['A..'Z] => alpha, IN['0..'9] => digit, ' --sp-- => space, '\n, '\l => crlf, '", '\\ => quoteSlosh, '<, '>, '(, '), '[, '], '., ',, ';, ':, '@, '\177 --127--, IN['\000..'\012), IN('\012..'\015), IN('\015..'\034] --0..31 less LF and CR-- => subSpecial, -- special = crlf + quoteSlosh + subSpecial ENDCASE => others; -- Cedar chars include only the 128 ASCII chars RETURN[SELECT t FROM aChar => cSubType = alpha, cChar => cSubType = alpha OR cSubType = digit OR cSubType = others, dChar => cSubType = digit, qChar => cSubType # crlf AND cSubType # quoteSlosh, xChar => TRUE, ENDCASE => ERROR] }; SessionRec: TYPE ~ RECORD [ SMTPin, SMTPout: IO.STREAM, cmdState: CommandState _ InitState, inputLine: REF TEXT _ RefText.New[512], lastScanned: INT _ -1, source: Arpa.Address _ Arpa.nullAddress, sourceTxt: ROPE _ NIL, heloTxt: ROPE _ NIL, reversePath: ROPE _ NIL, recipients: LIST OF ROPE _ NIL]; SyntaxErr: ERROR [where: INT _ -1, reason: ROPE _ NIL] = CODE; SMTPerror: ERROR [rc: RC, reason: ROPE _ NIL] = CODE; SMTPquit: ERROR = CODE; NewSession: PROC [stream: STREAM, source: Arpa.Address] = BEGIN session: REF SessionRec ~ NEW[SessionRec _ [stream, stream]]; BEGIN ENABLE { ArpaTCP.Timeout => { ArpaSMTPSupport.Log[ noteworthy, "ArpaTCP.Timeout from ", session.sourceTxt, " = ", ConvertExtras.RopeFromArpaAddress[source], "."]; GOTO Kill; }; IO.Error => { ArpaSMTPSupport.Log[ noteworthy, "IO.Error from ", session.sourceTxt, " = ", ConvertExtras.RopeFromArpaAddress[source], ": ", SELECT ArpaTCP.ErrorFromStream[stream] FROM neverOpen => "never open", localClose => "local close", localAbort => "local abort", remoteClose => "remote close", remoteAbort => "remote abort", transmissionTimeout => "transmission timeout", protocolViolation => "protocol violation", ENDCASE => "???", "."]; GOTO Kill; }; IO.EndOfStream => { ArpaSMTPSupport.Log[ noteworthy, "IO.EndOfStream from ", session.sourceTxt, " = ", ConvertExtras.RopeFromArpaAddress[source], ": ", SELECT ArpaTCP.ErrorFromStream[stream] FROM neverOpen => "never open", localClose => "local close", localAbort => "local abort", remoteClose => "remote close", remoteAbort => "remote abort", transmissionTimeout => "transmission timeout", protocolViolation => "protocol violation", ENDCASE => "???", "."]; GOTO Kill; }; }; cmdName: ROPE; cmd: CMD; session.source _ source; session.sourceTxt _ ConvertExtras.RopeFromArpaAddress[session.source]; ArpaSMTPSupport.Log[verbose, "Start of SMTP connection from ", session.sourceTxt, "."]; Reply[stream, rc220]; DO -- sit in a loop parsing command names, checking they are allowed, and execing them ENABLE { SMTPerror => {Reply[stream, rc, reason]; CONTINUE}; SyntaxErr => { input: ROPE _ Rope.FromRefText[session.inputLine]; IF where < 0 THEN Reply[stream, rc501, "Syntax error", IF Rope.IsEmpty[reason] THEN NIL ELSE ", ", reason] ELSE Reply[stream, rc501, "Syntax error", IF Rope.IsEmpty[reason] THEN NIL ELSE ", ", reason, " - \"", Rope.Substr[input, 0, where], "", Rope.Substr[input, where], "\""]; CONTINUE}; SMTPquit => {stream.Close[]; EXIT}; -- proper session end }; ReadLine[stream, session.inputLine]; [cmdName, session.lastScanned] _ GetString[session.inputLine, -1]; FOR cmd IN CMD DO IF Rope.Equal[Commands[cmd].name, cmdName, FALSE] THEN EXIT; REPEAT FINISHED => { reason: ROPE = Rope.Cat["Unrecognized command: ", cmdName]; ERROR SMTPerror[rc500, reason]; }; -- command not found ENDLOOP; IF ~session.cmdState^[cmd] THEN ERROR SMTPerror[rc503]; -- commands out of order (Commands[cmd].Action)[session]; ENDLOOP; EXITS Kill => ArpaTCP.AbortTCPStream[stream]; END; END; Filter: PROC [from: Arpa.Address] = BEGIN ok: BOOL; whyNot: ROPE; [ok, whyNot] _ ArpaSMTPControl.OKToAcceptSMTPInput[]; IF ~ok THEN { ArpaSMTPSupport.Log[important, "SMTP input request rejected: ", whyNot, "."]; ERROR RejectThisRequest; }; ArpaSMTPQueue.StartNewMessage["Check ML Early"]; END; inputListener: PROCESS _ NIL; listenerInOperation: BOOL _ FALSE; Error: PUBLIC ERROR [reason: ROPE] = CODE; Initialize: PUBLIC PROC = { IF listenerInOperation THEN ERROR Error["SMTP listener already in operation."]; inputListener _ CreateTCPStreamListener[ local: ArpaSMTPControl.arpaMSPort, proc: NewSession, timeout: LONG[24]*60*60000, -- 1 day(!). Sometimes throughput is as low as 30 bps to UK sites filter: Filter]; ArpaSMTPSupport.Log[important, "SMTP/TCP-Stream listener started."]; listenerInOperation _ TRUE; }; Finalize: PUBLIC PROC ~ { IF ~listenerInOperation THEN ERROR Error["No SMTP listener in operation."]; DestroyTCPListener[inputListener]; ArpaSMTPSupport.Log[important, "SMTP listener destroyed."]; listenerInOperation _ FALSE; }; CreateTCPStreamListener: PROC [local: ArpaTCP.DByte, proc: PROC [STREAM, Arpa.Address], timeout: INT --msecs--, filter: PROC [Arpa.Address]] RETURNS [handle: PROCESS] ~ { smtpTCPInfo: ArpaTCP.TCPInfo ~ [matchLocalPort~TRUE, localPort~local, active~FALSE, -- i.e. listener timeout~timeout, matchForeignAddr~FALSE, matchForeignPort~FALSE]; TRUSTED {Process.Detach[handle _ FORK TCPStreamListener[proc, filter, smtpTCPInfo]]}; }; -- end CreateTCPStreamListener TCPStreamListener: PROC [proc: PROC [STREAM, Arpa.Address], filter: PROC [Arpa.Address], smtpTCPInfo: ArpaTCP.TCPInfo] ~ { DO ENABLE ArpaTCP.Error => { ArpaSMTPSupport.Log[CRITICAL, "TCP stream listener unable to \"open\" stream for SMTP reception, ", IF reason = localConflict THEN "local conflict" ELSE "unspecified remote end", ".\nIt is possibly a program bug.\n", "Will try again later, though intervention is probably required."]; RETRY; }; tcpStream: STREAM = ArpaTCP.CreateTCPStream[smtpTCPInfo]; remote: Arpa.Address; ArpaTCP.WaitForListenerOpen[tcpStream]; remote _ ArpaTCP.GetRemoteSocket[tcpStream].addr; filter[remote ! RejectThisRequest => {ArpaTCP.AbortTCPStream[tcpStream]; LOOP}]; TRUSTED {Process.Detach[FORK proc[tcpStream, remote]]}; ENDLOOP; }; -- end TCPStreamListener RejectThisRequest: ERROR ~ CODE; DestroyTCPListener: PROC [listener: PROCESS] ~ { TRUSTED {Process.Abort[listener]}; }; END. -- SMTPRcvrImpl dArpaSMTPRcvrImpl.mesa Copyright c 1985 by Xerox Corporation. All rights reserved. Last Edited by: HGM, December 9, 1984 1:43:02 am PST Last Edited by: DCraft, December 14, 1983 5:18 pm Last Edited by: Taft, January 23, 1984 2:18:03 pm PST Hal Murray July 2, 1985 1:33:31 am PDT John Larson, August 10, 1988 1:09:19 pm PDT ArpaName USING [AddressToName], Reply codes Commands available The command order is restricted according to the current CommandState, which is a boolean array indicating which commands are allowed next. The current state is changed by commands which move the machinery through the FSM. This "stack frame" is only one deep because there can be no nested command sequences (though a few single commands which do not affect the state may occur at any time). The values are recorded here so that command additions/ changes/ deletions (which will affect all CmdRestr values) are in one place. Commands out of sequence are defined not to affect the state. command successors: HE MA RC DA RS SE SO SA VR EX HE NO QU TU possibly, this should be checked for validity before responding; currently just compose failure message later -- discard sender, recipients, and mail data, and clear buffers Mail Data Stream To read mail data, the SMTP input stream is overlayed with a stream which signals EndOfStream when it encounters a line consisting of a single period, and strips periods from the front of the line which were added for transparency. Would you believe that somebody sent us a line that was longer than 32K? Command Line & Parameter decoding The strategy is first to read a line into a TEXT buffer and then pick a command and parameters out of it using the Skip- and Get- procs. Throughout this area, last is the last character that has ALREADY been processed. I think it started out to be 1 different, but that got tangled up with a bounds fault that was off by 2. "- 1" since SkipOver returns "next" The following parameter decoding procedures implement the pictured syntax diagrams, which were derived from the BNF productions for SMTP. Notation: (terminals), [non-terminals]. -------------------------- | v path: --->(<)---->(@)--->[domain]--->(:)--->[mailbox]--->(>)---> ^ | -------(,)<------- -------------- v | mailbox: ------>(")---->(\)-->[x]---->(")------>(@)--->[domain]---> | | ^ ^ | ---->[q]---- | | | ----------->[string]------------- ^ | -----(.)---- -------------(.)<------------ v | ------ domain: -------------->[name]--------------> v | | ^ number: ---->[d]----> |---->(#)-->[number]----->| | | -->([)-->[dotnum]-->(])-- dotnum: --->[snum]-->(.)-->[snum]-->(.)-->[snum]-->(.)-->[snum]---> ------------- v | -------------- name: --->[a]------>[a]---------->[a]-----> v | | ^ | ^ string: ------->[c]-------> |-->[d]-->| -->[d]-- | ^ | | ->(\)-->[x]- -->(-)--- where is [a..z], [A..Z] is except or is [0..9] is except , , ", or \ is any of the 128 ASCII chars is one of <>()[]\.,;:@" or ASCII 0 through 31 is 1, 2, or 3 digits representing a decimal integer in the range 0 through 255 simply turns Bounds into SyntaxErr Sessions (with this host as receiver) nameRope: ROPE _ NIL; nameRope _ ArpaName.AddressToName[source, ArpaConfig.resolv^].name; IF ~Rope.IsEmpty[nameRope] THEN session.sourceTxt _ nameRope ELSE session.sourceTxt _ ConvertExtras.RopeFromArpaAddress[session.source]; Provides an interface similar to PupStream.CreatePupByteStreamListener. WARNING: The remote addresses to both proc and filter are null because the TCP listener doesn't provide that info. wait 15 mins Abort stream since close might hang because of unread data. Should seldom reject. Provides an interface similar to PupStream.DestroyPupListener. Κΰ– "cedar" style˜headšœ™Icodešœ Οmœ1™MšœF˜F—MšœO˜OMšœI˜IMšœF˜Fšœ˜Mšœ%˜%Mšœ˜Mšœ"˜"Mšœ˜Mšœ ˜ Mšœ0˜0Mšœ˜Mšœ ˜ —Mšœ6˜6šœ˜Mšœ ˜ Mšœ0˜0Mšœ˜M˜Mšœ˜—Mšžœ‘˜—š œ˜Mšž˜Mšœ4˜4Mš‘?™?M˜6Mšœ˜Mšžœ‘˜—š œ˜Mšž˜Mšœ4˜4Mšœ˜Mšžœ‘˜—š œ˜Mšž˜Mšœ4˜4šžœžœžœ˜GMšœ˜Mšœa˜aMšžœ ‘˜%Mšœ˜—Mšžœ‘˜3Mšžœ‘˜—Mšœ™MšœžœΜ™ηš  œžœ žœžœžœ˜@MšžœžœVžœ˜v—Mš œ žœžœžœžœžœ˜JMš  œžœžœžœžœ;˜…š   œžœžœžœžœ˜2Mšœžœ žœ˜,Mšœ žœ˜šžœžœ˜&Mšœžœžœ ˜Mšœžœ˜ M˜Mšžœžœžœžœ˜@Mšœ3˜3šžœ%ž˜+Mšœ#‘˜(—Mšžœ˜Mšžœžœ,˜:Mšœ˜šžœžœ žœ žœ˜aMšžœžœ‘ ˜?—Mšžœžœ‘ ˜RM˜—Mšœ0˜0M˜Mšžœ ˜Mšœ‘˜—L˜LšœH™Hš  œžœ žœ žœžœžœžœžœžœ˜[L˜šž˜Lšœžœžœžœžœžœžœžœžœ˜_Lšžœ žœžœ žœ˜)Lšœ0˜0Lšžœžœžœ žœ˜2Lšžœ˜ ——Mšœ!™!Mšœ,žœX™ˆMšœ:žœy™Ίš œžœ  œžœžœ žœžœ˜;Mšœ)žœžœ˜6M˜šž˜Mšœžœ˜!šžœž˜šœžœ˜!Mšœ%˜%—šœžœž˜Mšœ ž˜šœžœ˜šœžœž˜#Mšœžœ/˜5—Mšœ‘ ˜%Mšœ žœ˜M˜M˜—Mšœžœ˜—šžœžœ˜%Mšœžœ˜——Mšžœ žœ1˜@Mšžœžœžœ˜Mšžœ˜—Mšœ‘˜—š œžœ žœžœžœžœžœžœžœ˜Qšžœ0žœž˜=Mšžœ‘ ˜$—Mšœ˜Mšžœ˜ Mšœ‘˜—š  œžœ žœžœžœžœžœ˜BMšžœ4˜:Mšœ#™#—š œžœ žœžœžœžœžœžœ˜FMšœžœ ˜Mšœ"˜"Mšžœ1‘ ˜B—š  œžœ žœžœžœžœžœžœ˜HMšœžœ ˜Mšœ$˜$Mšžœ,˜2—š  œžœ žœžœžœžœžœžœ˜HMšœžœ ˜Mšœ$˜$Mšžœ,˜2—š   œžœ žœžœžœ˜6M˜"Mšžœžœžœ˜;—š œžœ žœžœžœžœžœ˜FMšœžœ˜Mšœ#˜#Mš žœžœžœ žœžœ˜™>Mš’_™_—Mšœžœ'˜1Mš œžœ˜)š œžœžœžœžœžœžœ˜9Mšžœ‘!˜D—š œžœžœžœžœžœžœ˜7Mšœ"™"Mšžœžœ˜E—š  œžœžœžœžœžœžœ˜=Mšžœ!žœžœ˜>šžœž˜!Mšœ˜Mšœ˜Mšœ˜Mšžœžœžœ˜$Mšžœžœžœ˜5Mšžœžœžœ˜9Mšžœ˜—Mšœ ˜ Mšžœ!žœžœ˜>Mšžœ˜ Mšœ‘˜—š  œžœžœžœžœžœžœ˜@šžœžœ‘˜3Mšœ˜Mšžœžœžœ˜9šž˜šžœ"‘/œž˜XMšœžœ,žœžœ˜J—šž˜Mšœžœ#žœžœ˜B—Mšžœžœžœ˜7Mšžœ˜—M˜—šžœ‘ ˜šž˜M˜Mšžœžœžœ‘˜@Mšœ˜Mšžœ˜ ——Mšžœ!žœžœ˜>M˜Mšžœ˜ Mšœ‘˜—š  œžœ žœžœžœžœžœ˜Ašžœ‘O˜RMšœžœ˜ šžœž˜ Mšœ)˜)šœ˜M˜#Mšžœ#žœžœ˜C—Mšžœ#˜*—Mš žœ$žœžœžœ‘˜JMšœ˜Mšžœ˜—Mšžœ˜ Mšœ‘˜—š  œžœžœžœžœžœžœ˜>Mšœ˜Mšžœ$žœ˜;šž˜Mšžœ)žœ žœžœ˜CMšœ˜Mšžœ˜—Mšžœ˜ Mšœ‘˜—š  œžœžœžœžœžœžœ˜?M˜šžœž˜Mšžœ!žœžœ˜>M˜Mšžœ˜—Mšžœ˜ Mšœ‘˜—š  œžœžœžœžœžœžœ˜=Mšœ žœžœ˜Mšœžœ˜%Mšžœžœžœ˜0šž˜Mšœ.žœ˜4Mš žœ žœžœžœžœ˜?Mšžœ˜—Mšžœžœžœ˜%Mšœ˜Mšžœ˜ Mšœ‘˜—š  œžœžœžœžœžœžœ˜=Mšœžœ ˜Mšœžœ˜ Mšœ ‘0˜PMš žœžœžœžœ&žœ˜LMšžœ žœžœ˜(Mšžœ ˜—š  œžœžœžœžœžœžœ˜>Mšœžœ˜Mšœ˜šž˜šžœžœžœ˜3Mšœ˜Mšžœ"žœžœ˜?—šžœ˜Mšžœ%žœžœ˜1Mšœ˜—Mšžœ˜—Mšžœžœžœ‘˜=Mšžœ ˜—š  œžœžœ žœžœ˜2Mšœ žœ?˜Lšœžœž˜!Mšžœ žœ˜ Mšžœ˜Mšœ‘œ ˜M˜M˜Mš œ2‘œžœžœžœ‘œ‘+˜ΕMšžœ ‘/˜B—šžœžœž˜M˜Mšœžœžœ˜CM˜Mšœžœ˜3Mšœ žœ˜Mšžœžœ˜—Mšœ˜—Mšœ Πrsœ₯™%šœ žœžœ˜Mšœ œžœžœ˜Mšœ#˜#Mšœ žœžœ˜'Mšœ žœ˜Mšœ(˜(Mšœ žœžœ˜Mšœ žœžœ˜Mšœ žœžœ˜Mš œ žœžœžœžœ˜ —Mš   œžœ žœžœžœžœ˜>Mš   œžœžœ žœžœžœ˜5Mš œžœžœ˜š  œžœ žœ˜9Mšž˜Mšœ žœžœ ˜=šž˜šžœ˜šœ˜šœ˜M˜ Mšœ˜M˜Mšœ7˜7—Mšžœ ˜ —šžœ ˜ šœ˜Mšœ ˜ Mšœ˜Mšœ˜Mšœ7˜7šžœ!ž˜+Mšœ˜Mšœ˜Mšœ˜Mšœ˜Mšœ˜Mšœ.˜.Mšœ*˜*Mšžœ ˜—Mšœ˜—Mšžœ ˜ —šžœ˜šœ˜Mšœ ˜ Mšœ*˜*Mšœ7˜7šžœ!ž˜+Mšœ˜Mšœ˜Mšœ˜Mšœ˜Mšœ˜Mšœ.˜.Mšœ*˜*Mšžœ ˜—Mšœ˜—Mšžœ ˜ —M˜——˜Mšœ žœ˜Mšœžœ˜ Mšœ žœžœ™Mšœ˜MšœC™CMšžœžœ™>MšžœG™KMšœF˜FMšœX˜XMšœ˜šžœ‘S˜Všžœ˜Mšœ)žœ˜3šœ˜Mšœžœ'˜2šžœ ž˜Mš œ'žœžœžœžœ˜Z—šž˜Mš œ(žœžœžœžœ_˜¬—Mšžœ˜ —Mšœžœ‘˜9M˜—M˜M˜$MšœB˜Bšžœžœžœž˜Mšžœ)žœžœžœ˜<šž˜šžœ˜ Mšœžœ/˜;Mšžœ‘˜7——Mšžœ˜—Mšžœžœžœ‘˜PMšœ ˜ Mšžœ˜—Mšžœ(˜-Mšžœ˜—Mšžœ˜—š œžœ˜#Mšž˜Mšœžœ žœ˜Mšœ5˜5šžœžœ˜ MšœM˜MMšžœ˜—Mšœ0˜0Mšžœ˜—Mšœžœžœ˜Mšœžœžœ˜"Mš  œžœžœ žœžœ˜*š  œžœžœ˜Mšžœžœžœ.˜Ošœ(˜(Mšœ"˜"Mšœ˜MšΟb Πbk¦ΠbcA˜]Mšœ˜—MšœD˜DMšœžœ˜—š œžœžœ˜Mšžœžœžœ)˜KM˜"Mšœ;˜;Mšœžœ˜—š œžœžœžœžœ‘ œ žœžœ žœ˜¬Mš œHžœΟrœ©œžœ$™ΊMš œ/žœžœ‘œ%žœžœ˜©Mšžœžœ0˜UMšœ‘˜!—š  œžœžœžœžœ2˜zšž˜šžœ˜Mš œžœJžœžœžœ†˜‘Mšœ ™ Mšžœ˜M˜—Mšœ žœ(˜9Mšœ˜Mšœ'˜'Mšœ1˜1šœIžœ˜PMšœQ™Q—Mšžœžœ˜7Mšžœ˜—Mšœ‘˜—Mš œžœžœ˜ š œžœ žœ˜0Mšœ>™>Mšžœ˜"M˜—Mšžœ‘˜——…—V>„‚