<> <> <> <> <> <> <> <<>> 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 ."], 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]; <<-- 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 <> <> 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]; }; <<"- 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]; }; <> <<>> << -------------------------->> << | 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>> 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