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;
Reply codes
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
Commands available
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"] ];
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.
CommandState: TYPE = REF CmdRestr;
CmdRestr: TYPE = ARRAY CMD OF BOOL;
command successors: HE MA RC DA RS SE SO SA VR EX HE NO QU TU
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];
possibly, this should be checked for validity before responding; currently just compose failure message later
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];
-- discard sender, recipients, and mail data, and clear buffers
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
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.
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
Would you believe that somebody sent us a line that was longer than 32K?
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; };
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.
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]; };
"- 1" since SkipOver returns "next"
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]; };
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
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] = {
simply turns Bounds into SyntaxErr
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]
};
Sessions (with this host as receiver)
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."];
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.
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] ~ {
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.
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."];
wait 15 mins
RETRY;
};
tcpStream: STREAM = TCP.CreateTCPStream[smtpTCPInfo];
remote: IPDefs.Address;
TCP.WaitForListenerOpen[tcpStream];
remote ← TCP.GetRemoteAddress[tcpStream];
filter[remote ! RejectThisRequest => {
TCP.AbortTCPStream[tcpStream];
LOOP}];
Abort stream since close might hang because of unread data. Should seldom reject.
TRUSTED {Process.Detach[FORK proc[tcpStream, remote]]};
ENDLOOP;
}; -- end TCPStreamListener
RejectThisRequest: ERROR ~ CODE;
DestroyTCPListener:
PROC [listener:
PROCESS] ~ {
Provides an interface similar to PupStream.DestroyPupListener.
TRUSTED {Process.Abort[listener]};
};
END. -- SMTPRcvrImpl