DIRECTORY
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],
IPDefs USING [DByte, Address, nullAddress],
IPName USING [AddressToName, AddressToRope],
SMTPControl USING [arpaMSPort, OKToAcceptSMTPInput, xeroxDomain],
SMTPDescr USING [Create, CreateFailed, Descr, Unparse],
SMTPQueue USING [AddNewMessage, StartNewMessage],
SMTPRcvr USING [],
SMTPSupport USING [Log, Now],
SMTPSyntax USING [BlessReturnPath],
TCP USING [AbortTCPStream, CreateTCPStream, Error, ErrorFromStream, GetRemoteAddress, TCPInfo, Timeout, WaitForListenerOpen];
SMTPRcvrImpl: CEDAR PROGRAM
IMPORTS
IO, Process, RefText, Rope, RuntimeError,
IPName, SMTPControl, SMTPDescr, SMTPQueue, SMTPSupport, SMTPSyntax, TCP
EXPORTS SMTPRcvr =
BEGIN
ROPE: TYPE = Rope.ROPE;
STREAM: TYPE = IO.STREAM;
xeroxDomain: ROPE = SMTPControl.xeroxDomain;
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[xeroxDomain, " Simple Mail Transfer Service ready"]],
rc221: ReplyRec["221", Rope.Concat[xeroxDomain, " 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 <CRLF>.<CRLF>"],

rc421: ReplyRec["421", Rope.Concat[xeroxDomain, "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];
SMTPSupport.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, xeroxDomain];
SMTPSupport.Log[verbose,
"Incoming SMTP conversation begun with ", session.sourceTxt,
" = ", IPName.AddressToRope[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
SMTPSupport.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 SMTPDescr.CreateFailed => {
SMTPSupport.Log[important,
"Failed to create descriptor for input from ",
session.sourceTxt, " = ", IPName.AddressToRope[session.source],
". Rejecting request."];
Reply[session.SMTPout, rc452]; -- insuffient storage
session.cmdState _ ReadyState;
CONTINUE; -- i.e. RETURN
};

descr: SMTPDescr.Descr;
timeStampLine, returnPathLine: ROPE;
gvSender: ROPE _ SMTPSyntax.BlessReturnPath[session.reversePath];
NoArgsToEOL[session.inputLine, session.lastScanned];
SMTPQueue.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 ", xeroxDomain, " ;"];
timeStampLine _ Rope.Cat[timeStampLine, " ", SMTPSupport.Now[].rope];
returnPathLine _ Rope.Cat["Return-Path: <", session.reversePath, ">"];
descr _ SMTPDescr.Create[
arpaReversePath: session.reversePath,
gvSender: gvSender,
rawRecipients: session.recipients,
source: session.sourceTxt,
format: arpa,
msgStream: CreateMailDataStream[session.SMTPin],
precedeMsgText: timeStampLine,
returnPathLine: returnPathLine];
Reply[session.SMTPout, rc250];
session.cmdState _ ReadyState;
SMTPQueue.AddNewMessage[descr, session.sourceTxt];
SMTPSupport.Log[
noteworthy,
SMTPDescr.Unparse[descr], " accepted from ",
session.sourceTxt, "."];
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];
SMTPSupport.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 SMTPDescr.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: IPDefs.Address _ IPDefs.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: IPDefs.Address] =
BEGIN
session: REF SessionRec ~ NEW[SessionRec _ [stream, stream]];
BEGIN
ENABLE {
TCP.Timeout => {
SMTPSupport.Log[
noteworthy, 
"TCP.Timeout from ", 
session.sourceTxt, 
" = ", IPName.AddressToRope[source], "."];
GOTO Kill; };
IO.Error => {
SMTPSupport.Log[
noteworthy,
"IO.Error from ",
session.sourceTxt,
" = ", IPName.AddressToRope[source], ": ",
SELECT TCP.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 => {
SMTPSupport.Log[
noteworthy,
"IO.EndOfStream from ", session.sourceTxt,
" = ", IPName.AddressToRope[source], ": ",
SELECT TCP.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 _ IPName.AddressToName[source];
SMTPSupport.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 => TCP.AbortTCPStream[stream];
END;
END;
Filter: PROC [from: IPDefs.Address] =
BEGIN
ok: BOOL; whyNot: ROPE;
[ok, whyNot] _ SMTPControl.OKToAcceptSMTPInput[];
IF ~ok THEN {
SMTPSupport.Log[important, "SMTP input request rejected: ", whyNot, "."];
ERROR RejectThisRequest; };
SMTPQueue.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: SMTPControl.arpaMSPort,
proc: NewSession,
timeout: LONG[5]*60000, -- 60 secs
filter: Filter];
SMTPSupport.Log[important, "SMTP/TCP-Stream listener started."];
listenerInOperation _ TRUE; };
Finalize: PUBLIC PROC ~ {
IF ~listenerInOperation THEN ERROR Error["No SMTP listener in operation."];
DestroyTCPListener[inputListener];
SMTPSupport.Log[important, "SMTP listener destroyed."];
listenerInOperation _ FALSE; };
CreateTCPStreamListener: PROC [local: IPDefs.DByte, proc: PROC [STREAM, IPDefs.Address],
 timeout: INT --msecs--, filter: PROC [IPDefs.Address]]
 RETURNS [handle: PROCESS] ~ {
smtpTCPInfo: TCP.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, IPDefs.Address], filter: PROC [IPDefs.Address], smtpTCPInfo: TCP.TCPInfo] ~ {
DO
ENABLE TCP.Error => {
SMTPSupport.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 = TCP.CreateTCPStream[smtpTCPInfo];
remote: IPDefs.Address;
TCP.WaitForListenerOpen[tcpStream];
remote _ TCP.GetRemoteAddress[tcpStream];
filter[remote ! RejectThisRequest => {TCP.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
ΘSMTPRcvrImpl.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, April 15, 1986 0:04:58 am PST

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 <a>       is [a..z], [A..Z]
       <c>       is <x> except <special> or <SP>
       <d>       is [0..9]
       <q>       is <x> except <CR>, <LF>, ", or \
       <x>       is any of the 128 ASCII chars
       <special> is one of <>()[]\.,;:@" or ASCII 0 through 31
       <snum>    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)
Gandalf (ARPAnet Imp connection) must be notified that TCP packets are to be sent to this machine. Gandalf simply latches onto the most recent mc from which an IP packet has come. I assume that calling TCP.CreateTCPStream will cause this to happen. If not, some packet should be sent to Gandalf here. I also assume that some idle handshake occurs while waiting for a new TCP stream so that Gandalf will not "forget" to whom it should be talking. If not, the timeout parameter to TCP.WaitForListenerOpen should be about 15 mins (currently unlimited), at the expiry of which Gandalf should be prodded and the signal resumed.
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™<J™4J™1J™5L™&L™*L™š
Οk	˜	Icode2šžœ
žœjžœ˜–
Mšœžœ˜Mšœžœ0˜=Mšœžœ;žœ˜cMšœ
žœ˜!Mšœžœ˜+Mšœžœ ˜,Mšœžœ0˜AMšœ
žœ(˜7Mšœ
žœ"˜1Mšœ	žœ˜Mšœžœ˜Mšœžœ˜#Mšžœ
žœt˜}——šΠlnœžœ
ž˜š
ž˜Mšžœ'˜)MšœDž˜G—Mšžœ˜Mš
ž˜Mšžœžœžœ
˜Mšžœžœžœ
žœ
˜Mš
œ™Mšœ
žœ˜,šžœžœ˜Mš
œ)˜)Mš
œ˜Mš
œ˜Mš
œF˜F—Mšœ
žœžœžœ˜)šΟnœžœ
žœ
žœ
˜!Mš
œ(˜(Mš
œ'˜'Mš
œX˜XMš
œZ˜ZMš
œ@˜@Mš
œ*˜*Mš
œD˜DMš
œ[˜[Mš
œO˜OMš
œN˜NMš
œS˜SMš
œ=˜=Mš
œB˜BMš
œ3˜3Mš
œ3˜3Mš
œ<˜<Mš
œJ˜JMš
œ)˜)Mš
œU˜UMš
œO˜OMš
œ.˜.—š œžœžœ
žœžœ"žœžœ˜TM˜Mš"žœžœ
žœžœ
žœžœ
žœžœ
žœžœ
žœžœ
žœžœ
žœžœ
žœ
˜xM˜M˜M˜M˜M˜M˜M˜M˜M˜M˜M˜M˜MšœΟc˜—Mš
œ™MšžœžœX˜aMšœ
žœžœžœ
˜3Mš	œžœžœžœ œ˜Fš œžœ
žœ
žœ˜%Mš
œ"˜"Mš
œ"˜"Mš
œ"˜"Mš
œ"˜"Mš
œ"˜"Mš
œ˜Mš
œ˜Mš
œ˜Mš
œ˜Mš
œ˜Mš
œ˜Mš
œ"˜"Mš
œ"˜"Mš
œ˜—Mš
œΚ™ΚMšœžœžœ
˜"Mšœ
žœžœ
žœ
žœ
žœ
˜#M™=Mš 	œžœ:˜XMš 
œžœ:˜YMš 	œžœ:˜Xš 	œžœ:˜XMš 
œžœžœ
˜Mš 
œžœžœ˜—š œ˜Mš
ž˜Mšœžœ'˜6Mš
œ^˜^Mš
œ˜Mšžœ‘˜—š œ˜Mš
ž˜Mšœžœ
žœ˜#Mšœžœ˜ M˜Mš
œ0˜0Mš
œ˜M˜+˜M˜<Mš
œ2˜2—Mš
œ˜Mšžœ‘˜—š œ˜Mš
ž˜Mšœžœ
žœ˜#Mšœžœ˜ M˜M˜%šžœžœžœ‘˜SM˜dMš
œA˜AM˜—Mšžœ3˜7Mš
œ˜Mšœžœ
˜M˜$Mš
œ˜Mšžœ‘˜—š œ˜Mš
ž˜Mšœžœ
žœ˜#Mšœžœ˜ Mšœžœ
˜M˜M˜#Mš
œ+˜+Mš
œ˜Mšœžœ#˜<Mš
œm™mM˜$Mš
œ˜Mšžœ‘˜—š œ˜Mš
ž˜šžœ˜"š
œ˜Mš
œ.˜.Mš
œ?˜?Mš
œ˜—Mšœ‘˜4Mš
œ˜Mšžœ‘˜M˜M˜—Mš
œ˜Mšœžœ
˜$Mšœ
žœ3˜AMš
œ4˜4Mš
œ-˜-M˜Mš
œ=˜=šžœ1žœž˜>Mš
œF˜F—Mš
œC˜CMš
œE˜EMš
œF˜Fš
œ˜Mš
œ%˜%Mš
œ˜Mš
œ"˜"Mš
œ˜Mš
œ
˜
Mš
œ0˜0Mš
œ˜Mš
œ ˜ —M˜Mš
œ˜Mš
œ2˜2š
œ˜Mš
œ˜Mš
œ,˜,Mš
œ˜—Mšžœ‘˜—š œ˜Mš
ž˜Mš
œ4˜4Mš
œ?™?M˜6Mš
œ˜Mšžœ‘˜—š œ˜Mš
ž˜Mš
œ4˜4Mš
œ˜Mšžœ‘˜—š œ˜Mš
ž˜Mš
œ4˜4šžœžœžœ˜GMš
œ˜M˜]Mšžœ‘˜%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š
œˆ
™ˆ
M™Ί
š œžœ 	œžœ
žœ
žœ
žœ˜;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™Mš
Πfr.™.Mš
’/™/Mš
’E™EMš
’(™(Mš
’'™'M™M™Mš
’&™&Mš
’'™'Mš
’F™FMš
’1™1Mš
’1™1Mš
’1™1Mš
’0™0Mš
’&™&Mš
’%™%M™M™Mš
’+™+Mš
’E™EMš
’F™FMš
’I™IMš
’*™*Mš
’*™*Mš
’)™)M™M™Mš
’F™FM™M™Mš
’™Mš
’J™JMš
’K™KMš
’M™MMš
’J™JMš
’I™IMš
’™M™M™Mš
’"™"Mš
’0™0Mš
’™Mš
’2™2Mš
’.™.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š œžœžœ
˜š 
œžœ
žœ˜;Mš
ž˜Mšœ	žœžœ ˜=š
ž˜šžœ˜šžœ
˜˜M˜Mš
œ˜M˜Mš
œ*˜*—Mšžœ	˜
—šžœ˜
š
œ˜Mš
œ˜Mš
œ˜Mš
œ˜Mš
œ*˜*šžœ
žœž˜'Mš
œ˜Mš
œ˜Mš
œ˜Mš
œ˜Mš
œ˜Mš
œ.˜.Mš
œ*˜*Mšžœ
˜—Mš
œ˜—Mšžœ	˜
—šžœ˜š
œ˜Mš
œ˜Mš
œ*˜*Mš
œ*˜*šžœ
žœž˜'Mš
œ˜Mš
œ˜Mš
œ˜Mš
œ˜Mš
œ˜Mš
œ.˜.Mš
œ*˜*Mšžœ
˜—Mš
œ˜—Mšžœ	˜
—M˜——˜Mšœ	žœ
˜Mšœžœ
˜	Mš
œ˜Mš
œ1˜1Mš
œT˜TMš
œ˜šžœ
‘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š
œ1˜1šžœžœ˜
Mš
œI˜IMšžœ˜—Mš
œ,˜,Mšžœ
˜—Mšœžœžœ
˜Mšœžœžœ
˜"Mš
 œžœ
žœ
žœžœ
˜*š 
œžœ
žœ˜Mšžœžœ
žœ.˜OMš
œξ™ξš
œ(˜(Mš
œ˜Mš
œ˜MšΟb	Πbk€Πbc
˜"Mš
œ˜—M˜@Mšœžœ˜—š œžœ
žœ˜Mšžœžœ
žœ)˜KM˜"M˜7Mšœžœ˜—š œžœžœžœžœ
‘	œ
žœžœ
žœ˜―
MšœnΟrœ§œ=™Ί
Mš
œ
žœžœžœ‘œ$žœžœ˜₯
Mšžœžœ0˜UMšœ‘˜!—š œžœžœžœžœ žœ
˜zš
ž˜šžœ
žœ˜Mš	œžœJžœžœžœ†
˜Mš
œ™Mšžœ
˜M˜—Mšœžœžœ˜5Mš
œ˜Mšžœ ˜#Mšœ	žœ˜)šœ&žœžœ˜LMš
œQ™Q—Mšžœžœ˜7Mšžœ
˜—Mšœ‘˜—Mš œžœžœ
˜ š œžœžœ˜0Mš
œ>™>Mšžœ˜"M˜—Mšžœ‘˜——…—T¬ƒ0