<> <> <> <> <> <> DIRECTORY Arpa USING [Address, nullAddress], ArpaConfig USING [ourLocalName, resolv], ArpaName USING [AddressToName, DomainInfo, NameToAddressList, NameToMailHostList, ReplyStatus], ArpaNameSupport USING [AppendUniqueAddress, Tailed, StripTail], ArpaMT USING [TranslateMessage], ArpaSMTPControl USING [arpaMSPort], ArpaSMTPDescr USING [Descr, GetFormat, GetArpaReversePath, GetPrecedeMsgText, RetrieveMsgStream, UniqueID, Unparse], ArpaSMTPSend USING [WithItemAction], ArpaSMTPSupport USING [CreateSubrangeStream, HeaderParseError, Log], ArpaSMTPSyntax USING [EnumerateGVItems, GVItemProc], ArpaSMTPQueue USING [CountQueue], ArpaTCP USING [AbortTCPStream, CreateTCPStream, Error, ErrorFromStream, GetTimeout, Reason, SetTimeout, TCPInfo, Timeout], BasicTime USING [GetClockPulses, Pulses, PulsesToMicroseconds], Convert USING [RopeFromInt], ConvertExtras USING [RopeFromArpaAddress], FS USING [Delete, Error, StreamOpen], IO USING [Close, EndOf, EndOfStream, Error, Flush, GetLength, GetLine, GetChar, GetIndex, GetLineRope, int, PutChar, PutF, PutRope, PutText, RIS, rope, RopeFromROS, ROS, STREAM], RefText USING [Fetch, Length, ObtainScratch], Rope USING [Cat, Concat, Equal, Fetch, Find, Length, ROPE, Substr], RopeList USING [Length], TypeScript USING [ChangeLooks], ViewerIO USING [CreateViewerStreams, GetViewerFromStream]; ArpaSMTPSendImpl: CEDAR PROGRAM IMPORTS ArpaConfig, ArpaMT, ArpaSMTPControl, ArpaSMTPDescr, ArpaSMTPSupport, ArpaSMTPSyntax, ArpaSMTPQueue, ArpaTCP, BasicTime, Convert, ConvertExtras, FS, IO, ArpaName, ArpaNameSupport, RefText, Rope, RopeList, TypeScript, ViewerIO EXPORTS ArpaSMTPSend = BEGIN ROPE: TYPE = Rope.ROPE; STREAM: TYPE = IO.STREAM; Descr: TYPE = ArpaSMTPDescr.Descr; Connection: TYPE = REF ConnectionRep; -- so it can be opaque ConnectionRep: PUBLIC TYPE = RECORD[ stream: STREAM, start: BasicTime.Pulses, used: BOOLEAN, bytes: INT, addr: Arpa.Address, name: ROPE]; busySwitch: INT _ 5; -- > this number of hosts in ARPA queue causes connection limit timeOutSwitch: INT _ 5; -- > this number of hosts in ARPA queue for long timeout shortTimeOut: INT _ 30000; -- 30 seconds longTimeOut: INT _ 250000; -- 3.5 minutes cloopsListExpander: ROPE _ "parcvax.xerox.com"; -- To solve problem with long CLoops Vaxc alias expansion causing timeouts totalArpaMsgsSent: PUBLIC INT _ 0; totalArpaBytesSent: PUBLIC INT _ 0; <> Open: PUBLIC PROC [hostName: ROPE] RETURNS [hostStream: Connection] = { hostStr: STREAM; hello: ROPE; hostAddrList: LIST OF Arpa.Address; sourceAddr: Arpa.Address; source: ROPE; bogus: BOOL_FALSE; down: BOOL_FALSE; other: BOOL_FALSE; IF Rope.Find[hostName, "."] = -1 THEN hostName _ Rope.Concat[hostName, ".ARPA"]; IF Rope.Fetch[hostName, 0] = '[ THEN { -- It's an address already status: ArpaName.ReplyStatus; IF ArpaNameSupport.Tailed[hostName, ".ARPA"] THEN hostName _ ArpaNameSupport.StripTail[hostName, ".ARPA"]; [hostAddrList, status, sourceAddr] _ ArpaName.NameToAddressList[hostName, ArpaConfig.resolv^]; SELECT status FROM bogus => bogus _ TRUE; down => down _ TRUE; ENDCASE; } ELSE [hostAddrList, bogus, down, other, sourceAddr] _ GetAddressList[hostName]; IF down THEN { ArpaSMTPSupport.Log[ noteworthy, "TCP open failed: Can't load cache for ", hostName, "."]; ERROR Failed[ withItem: retryLater, reason: Rope.Cat["Unable to load name cache for ", hostName, "."], problemWithHost: TRUE]; }; IF other THEN { contact: ROPE _ NIL; primaryServer: ROPE _ NIL; contactMsg: Rope.ROPE _ NIL; [contact, primaryServer,,] _ ArpaName.DomainInfo[hostName, ArpaConfig.resolv^]; IF primaryServer # NIL THEN contactMsg _ Rope.Cat["Primary name server: ", primaryServer]; IF contact # NIL THEN contactMsg _ Rope.Cat[contactMsg, ", Domain contact: ", contact]; contactMsg _ Rope.Cat[contactMsg, "\n\nIf you are sure that the name above is actually a valid host name for Arpanet mail, there may be a problem with the name server at ", primaryServer]; contactMsg _ Rope.Cat[contactMsg, ". If you forward the header of this message to Postmaster.pa@Xerox.COM the maintainers of this name server will be notified about the problem.\n"]; ArpaSMTPSupport.Log[ noteworthy, "TCP open failed: unable to find address for ", hostName, "."]; ERROR Failed[ withItem: returnToSender, reason: Rope.Cat["Unable to deliver msg to ", hostName, ". Could not find address for this name. This is either a domain name with no mail support, or some name server is confused.\n\n", contactMsg], problemWithHost: TRUE]; }; IF bogus THEN { contact: ROPE _ NIL; contactMsg: Rope.ROPE; source _ ArpaName.AddressToName[sourceAddr, ArpaConfig.resolv^].name; IF source # NIL THEN { contact _ ArpaName.DomainInfo[source, ArpaConfig.resolv^].domainContact; contactMsg _ Rope.Cat["Domain name server: ", source]; IF contact # NIL THEN contactMsg _ Rope.Cat[contactMsg, ", Domain contact: ", contact]; contactMsg _ Rope.Cat[contactMsg, "\n\nIf you are sure that the unknown host above is actually a valid Arpanet name, there may be a problem with the name server at ", source]; contactMsg _ Rope.Cat[contactMsg, ". If you forward the header of this message to Postmaster.pa@Xerox.COM the maintainers of this name server will be notified about the problem.\n"]} ELSE { source _ "???"; contactMsg _ "If you are sure that the unknown host above is actually a valid Arpanet name, there may be a problem with one of name servers for this host's domain. If you forward the header of this message to Postmaster.pa@Xerox.COM the maintainers of the relevant name server will be notified.\n"}; ArpaSMTPSupport.Log[ noteworthy, "TCP open failed: unknown host ", hostName, ". Loaded from: ", source, "."]; ERROR Failed[ withItem: returnToSender, reason: Rope.Cat["Unable to deliver msg to unknown host: ", hostName, ".\n\n", contactMsg], problemWithHost: TRUE]; }; IF hostAddrList = NIL THEN { ArpaSMTPSupport.Log[ noteworthy, "TCP open failed: Can't load cache for ", hostName, "."]; ERROR Failed[ withItem: retryLater, reason: Rope.Cat["Unable to load name cache for ", hostName, "."], problemWithHost: TRUE]; }; IF ArpaSMTPQueue.CountQueue["ARPA"] > busySwitch THEN hostAddrList _ LIST[hostAddrList.first]; FOR addrList: LIST OF Arpa.Address _ hostAddrList, addrList.rest UNTIL addrList = NIL DO ENABLE { ArpaTCP.Timeout => { <> ArpaSMTPSupport.Log[ noteworthy, "ArpaTCP.Timeout during SMTP open to ", hostName, " = ", ConvertExtras.RopeFromArpaAddress[addrList.first]]; CONTINUE; }; -- i.e., go around the loop again (until exhausted) IO.Error => { ArpaSMTPSupport.Log[ noteworthy, "IO.Error during SMTP open to ", hostName, " = ", ConvertExtras.RopeFromArpaAddress[addrList.first], <> ".\nTCP reason: \"", TCPErrorText[ArpaTCP.ErrorFromStream[stream]], "\". Will retry later."]; CONTINUE; }; IO.EndOfStream => { ArpaSMTPSupport.Log[ noteworthy, "IO.EndOfStream during SMTP open to ", hostName, " = ", ConvertExtras.RopeFromArpaAddress[addrList.first], ".\nTCP reason: \"", TCPErrorText[ArpaTCP.ErrorFromStream[stream]], "\". Will retry later."]; CONTINUE; }; FailureReply => { ArpaSMTPSupport.Log[ noteworthy, "FailureReply during SMTP open to ", hostName, " = ", ConvertExtras.RopeFromArpaAddress[addrList.first], ".\nReason: \"", reason, "\". Will retry later."]; ERROR Failed[ withItem: retryLater, reason: reason, problemWithHost: TRUE]; }; }; addr: Arpa.Address = addrList.first; tcpInfo: ArpaTCP.TCPInfo = [ matchForeignAddr: TRUE, foreignAddress: addr, matchForeignPort: TRUE, foreignPort: ArpaSMTPControl.arpaMSPort, active: TRUE, -- i.e. establish connection timeout: IF Rope.Equal[hostName, cloopsListExpander, FALSE] -- This is ugly, but it solves a problem with overlong CLoops Vaxc alias expansion causing timeouts OR ArpaSMTPQueue.CountQueue["ARPA"] <= timeOutSwitch THEN longTimeOut ELSE shortTimeOut, matchLocalPort~FALSE]; ArpaSMTPSupport.Log[verbose, "Opening SMTP connection to ", hostName, " = ", ConvertExtras.RopeFromArpaAddress[addr], "."]; hostStr _ ArpaTCP.CreateTCPStream[tcpInfo ! ArpaTCP.Error => { ArpaSMTPSupport.Log[ ATTENTION, -- this shouldn't occur "ArpaTCP.Error opening stream to ", hostName, ", ", " = ", ConvertExtras.RopeFromArpaAddress[addr], TCPErrorText[reason], ".\nIt is possibly a program bug.\n", "Will try again later, though intervention is probably required."]; CONTINUE}]; -- i.e. try next addr hostStream _ NEW[ConnectionRep _ [ stream: hostStr, start: BasicTime.GetClockPulses[], used: FALSE, bytes: 0, addr: addr, name: hostName]]; hello _ CheckReplyTo[hostStream]; -- check initial connection reply HELOcmd[hostStream]; EXIT; REPEAT FINISHED => ERROR Failed[ withItem: retryLater, reason: Rope.Cat["Failed to connect to ", hostName], problemWithHost: TRUE]; ENDLOOP; ArpaSMTPSupport.Log[verbose, "Opened SMTP connection to ", hostName, " = ", ConvertExtras.RopeFromArpaAddress[hostStream.addr], ".\n", hello]; }; -- end Open SendItem: PUBLIC PROC [descr: Descr, recipList: LIST OF ROPE, hostStream: Connection] = { <> ENABLE { ArpaTCP.Timeout => { ArpaSMTPSupport.Log[ noteworthy, "ArpaTCP.Timeout during SMTP conversation with ", hostStream.name, " = ", ConvertExtras.RopeFromArpaAddress[hostStream.addr], "\nwhile trying to send item ", descr.Unparse[], ". Will try again later."]; ERROR Failed[ withItem: retryLater, reason: "ArpaTCP.Timeout during conversation", problemWithHost: TRUE]; }; IO.EndOfStream => { ArpaSMTPSupport.Log[ noteworthy, "IO.EndOfStream during SMTP conversation with ", hostStream.name, " = ", ConvertExtras.RopeFromArpaAddress[hostStream.addr], "\nwhile trying to send item ", descr.Unparse[], ".\nTCP reason: ", TCPErrorText[ArpaTCP.ErrorFromStream[stream]], ". Will retry later."]; ERROR Failed[ withItem: retryLater, reason: "IO.EndOfStream during conversation", problemWithHost: TRUE]; }; IO.Error => { ArpaSMTPSupport.Log[ noteworthy, "IO.Error during SMTP conversation with ", hostStream.name, " = ", ConvertExtras.RopeFromArpaAddress[hostStream.addr], "\nwhile trying to send item ", descr.Unparse[], <> ".\nTCP reason: ", TCPErrorText[ArpaTCP.ErrorFromStream[stream]], ". Will retry later."]; ERROR Failed[ withItem: retryLater, reason: "IO.Error during conversation", problemWithHost: TRUE]; }; }; stop: BasicTime.Pulses; seconds: INT; precedeMsgText: ROPE _ descr.GetPrecedeMsgText[]; badRecipients: ROPE _ NIL; good: INT _ 0; msgStream, textStream: STREAM; buffer: REF TEXT; from: ROPE _ descr.GetArpaReversePath[]; IF descr.GetFormat[] = arpa AND ~ArpaNameSupport.Tailed[from, "@Xerox.COM"] THEN { <> glue: ROPE _ IF from.Fetch[0] = '@ THEN "," ELSE ":"; IF Rope.Find[from, "@"] = -1 THEN from _ Rope.Cat[from, "@", ArpaConfig.ourLocalName] -- Rejection messages ELSE from _ Rope.Cat["@", ArpaConfig.ourLocalName, glue, from]; }; -- Relay mode IF hostStream.used THEN RSETcmd[hostStream]; -- ensure clean state hostStream.used _ TRUE; hostStream.start _ BasicTime.GetClockPulses[]; hostStream.bytes _ 0; MAILcmd[hostStream, from]; <> FOR restRecips: LIST OF ROPE _ recipList, restRecips.rest UNTIL restRecips = NIL DO good _ good + 1; RCPTcmd[hostStream, restRecips.first ! UnknownUser => { good _ good - 1; IF badRecipients # NIL THEN badRecipients _ Rope.Concat[badRecipients, ",\n"]; badRecipients _ Rope.Cat[badRecipients, "\t", restRecips.first, " => ", reason]; CONTINUE}]; ENDLOOP; IF good # 0 THEN BEGIN timeout: INT; <> StartDATAcmd[hostStream]; buffer _ RefText.ObtainScratch[512]; <> IF precedeMsgText # NIL THEN { textStream _ IO.RIS[precedeMsgText]; UNTIL textStream.EndOf[] DO buffer _ textStream.GetLine[buffer]; SendDataBuffer[hostStream, buffer]; ENDLOOP; }; <> msgStream _ descr.RetrieveMsgStream[]; SELECT descr.GetFormat[] FROM arpa => textStream _ msgStream; gv => { -- Bletch, we really should handle more than 1 text block AssignTextStream: ArpaSMTPSyntax.GVItemProc = { currentIndex: INT; IF itemHeader.type # Text THEN RETURN; currentIndex _ msgStream.GetIndex[]; msgStream _ ArpaSMTPSupport.CreateSubrangeStream[ origStream: msgStream, min: currentIndex, max: currentIndex+itemHeader.length]; continue _ FALSE; }; DeleteVersions: PROC[name: Rope.ROPE, nVersions: CARDINAL] = {FOR i: CARDINAL IN [0..nVersions) DO FS.Delete[name]; ENDLOOP;}; errors: IO.STREAM _ IO.ROS[]; tempName: ROPE = "///MG/ToArpa"; keep: CARDINAL = 5; ArpaSMTPSyntax.EnumerateGVItems[GVStream: msgStream, proc: AssignTextStream]; textStream _ FS.StreamOpen[fileName: tempName, accessOptions: $create, keep: keep ! FS.Error => {IF error.code = $noMoreVersions THEN {DeleteVersions[tempName, keep]; RETRY}}]; ArpaMT.TranslateMessage[in: msgStream, out: textStream, error: errors, direction: toArpa, id: ArpaSMTPDescr.UniqueID[descr] ]; msgStream.Close[]; textStream.Close[]; textStream _ FS.StreamOpen[tempName, $read]; IF errors.GetLength[] # 0 THEN { IF FALSE THEN { SendDataBuffer[ hostStream, "Comment: ***** Troubles parsing header. Fixups may look strange.\n"]; errors _ IO.RIS[IO.RopeFromROS[errors]]; UNTIL errors.EndOf[] DO buffer _ errors.GetLine[buffer]; SendDataBuffer[hostStream, buffer]; ENDLOOP; errors.Close[]; }; ArpaSMTPSupport.HeaderParseError[recipList, descr]; }; }; ENDCASE => ERROR; <> UNTIL textStream.EndOf[] DO buffer _ textStream.GetLine[buffer]; SendDataBuffer[hostStream, buffer]; ENDLOOP; timeout _ ArpaTCP.GetTimeout[hostStream.stream]; ArpaTCP.SetTimeout[hostStream.stream, longTimeOut]; -- try hard to avoid generating duplicate messages EndDATAcmd[hostStream]; ArpaTCP.SetTimeout[hostStream.stream, timeout]; -- Set timeout back to previous textStream.Close[]; END; stop _ BasicTime.GetClockPulses[]; seconds _ BasicTime.PulsesToMicroseconds[stop-hostStream.start]/1000000; IF badRecipients = NIL THEN { ArpaSMTPSupport.Log[ noteworthy, ArpaSMTPDescr.Unparse[descr], Bytes[hostStream.bytes], hostStream.name, "."]; totalArpaMsgsSent _ totalArpaMsgsSent +1; totalArpaBytesSent _ totalArpaBytesSent + hostStream.bytes; } ELSE { reason: ROPE _ Rope.Cat[ "Unable to deliver msg to the following recipient(s) at ", hostStream.name, ":\n", badRecipients, "."]; IF good > 0 THEN reason _ Rope.Cat[ reason, "\nSuccessfully delivered to other recipient(s)."]; ArpaSMTPSupport.Log[ noteworthy, ArpaSMTPDescr.Unparse[descr], " will be returned because:\n", reason]; ERROR Failed[withItem: returnToSender, reason: reason, problemWithHost: FALSE]; }; }; -- end SendItem Bytes: PROC [bytes: INT] RETURNS [rope: ROPE] = { rope _ Rope.Cat[" sent ", Convert.RopeFromInt[bytes], " bytes to "]; }; GetAddressList: PROC[hostName: ROPE] RETURNS[list: LIST OF Arpa.Address, bogus, down, other: BOOL _ FALSE, sourceAddr: Arpa.Address _ Arpa.nullAddress] = { status: ArpaName.ReplyStatus; hostList: LIST OF ROPE; [hostList, status, sourceAddr] _ ArpaName.NameToMailHostList[hostName, ArpaConfig.resolv^]; IF status = bogus THEN RETURN[list: NIL, bogus: TRUE, down: FALSE, other: FALSE, sourceAddr: sourceAddr]; IF status = other OR status = down THEN { [list, status, sourceAddr] _ ArpaName.NameToAddressList[hostName, ArpaConfig.resolv^]; SELECT status FROM bogus => RETURN[list: NIL, bogus: TRUE, down: FALSE, other: FALSE, sourceAddr: sourceAddr]; down => RETURN[list: NIL, bogus: FALSE, down: TRUE, other: FALSE, sourceAddr: Arpa.nullAddress]; other => RETURN[list: NIL, bogus: FALSE, down: FALSE, other: TRUE, sourceAddr: Arpa.nullAddress]; ok => RETURN[list: list, bogus: FALSE, down: FALSE, other: FALSE, sourceAddr: sourceAddr]; ENDCASE; }; IF RopeList.Length[hostList] = 1 THEN { [list, status, ] _ ArpaName.NameToAddressList[hostList.first, ArpaConfig.resolv^]; SELECT status FROM ok => RETURN[list: list, bogus: FALSE, down: FALSE, sourceAddr: Arpa.nullAddress]; ENDCASE => RETURN[list: NIL, bogus: FALSE, down: TRUE, sourceAddr: Arpa.nullAddress]; }; FOR hl: LIST OF ROPE _ hostList, hl.rest UNTIL hl = NIL DO host: ROPE _ hl.first; addrList: LIST OF Arpa.Address; [addrList, status,] _ ArpaName.NameToAddressList[host, ArpaConfig.resolv^]; IF status = ok THEN FOR al: LIST OF Arpa.Address _ addrList, al.rest UNTIL al = NIL DO list _ ArpaNameSupport.AppendUniqueAddress[al.first, list]; ENDLOOP; ENDLOOP; IF list = NIL THEN RETURN[list: NIL, bogus: FALSE, down: TRUE, sourceAddr: Arpa.nullAddress]; RETURN[list: list, bogus: FALSE, down: FALSE, sourceAddr: Arpa.nullAddress]; }; Close: PUBLIC PROC [hostStream: Connection, trouble: BOOL] = { BEGIN ENABLE { ArpaTCP.Timeout => GOTO Abort; IO.EndOfStream, IO.Error => GOTO Return; }; IF trouble THEN GOTO Abort; QUITcmd[hostStream ! Failed => GOTO Abort]; hostStream.stream.Close[]; ArpaTCP.AbortTCPStream[hostStream.stream]; EXITS Abort => ArpaTCP.AbortTCPStream[hostStream.stream]; Return => NULL; END; IF out # NIL THEN out.PutText["*** Closed.\n\n\n"]; ArpaSMTPSupport.Log[ verbose, "Outgoing SMTP conversation with ", hostStream.name, " closed."]; }; SendDataBuffer: PROC [hostStream: Connection, line: REF TEXT] = { him: IO.STREAM = hostStream.stream; length: INT = RefText.Length[line]; IF out # NIL THEN out.PutText[" "]; IF RefText.Length[line] > 0 AND RefText.Fetch[line, 0] = '. THEN him.PutChar['.]; FOR i: INT IN [0..length) DO hostStream.bytes _ hostStream.bytes + 1; IF out # NIL THEN out.PutChar[RefText.Fetch[line, i]]; him.PutChar[RefText.Fetch[line, i]]; ENDLOOP; hostStream.bytes _ hostStream.bytes + 2; IF out # NIL THEN out.PutChar['\n]; him.PutChar['\n]; him.PutChar['\l]; }; GetLineRope: PROC [hostStr: STREAM] RETURNS [rope: ROPE] = { length: INT; rope _ hostStr.GetLineRope[]; length _ rope.Length[]; IF length > 0 AND rope.Fetch[length-1] = '\l THEN { -- NRL-CSS LFCR Krock rope _ Rope.Substr[rope, 0, length-1]; RETURN; }; [] _ hostStr.GetChar[]; }; -- Discard LF Failed: PUBLIC ERROR [withItem: ArpaSMTPSend.WithItemAction, reason: ROPE, problemWithHost: BOOL] = CODE; TCPErrorText: PROC [why: ArpaTCP.Reason] RETURNS [ROPE] = { RETURN[SELECT why FROM localConflict => "local conflict", unspecifiedRemoteEnd => "unspecified remote end", neverOpen => "never open", localClose => "local close", localAbort => "local abort", remoteClose => "remote close", remoteAbort => "remote abort", transmissionTimeout => "transmission timeout", protocolViolation => "protocol violation", ENDCASE => "???"]; }; <> <> RC: TYPE = { rc050, rc211, rc214, rc220, rc221, rc250, rc251, rc354, rc421, rc450, rc451, rc452, rc500, rc501, rc502, rc503, rc504, rc550, rc551, rc552, rc553, rc554, unknown}; Analysis: TYPE = RECORD [asLiteral: ROPE, success: BOOL, withItem: ArpaSMTPSend.WithItemAction _ irrelevant, problemWithHost: BOOL _ FALSE, logEvokingCmdLine: BOOL _ FALSE]; Replies: ARRAY RC[RC.FIRST .. RC.LAST) OF Analysis = [ rc050: Analysis["050", TRUE], -- krock/bug rc211: Analysis["211", TRUE], -- system status rc214: Analysis["214", TRUE], -- help msg rc220: Analysis["220", TRUE], -- ready rc221: Analysis["221", TRUE], -- closing channel rc250: Analysis["250", TRUE], -- ok, completed rc251: Analysis["251", TRUE], -- user not local, forwarding rc354: Analysis["354", TRUE], -- start mail text rc421: Analysis["421", FALSE, retryLater, TRUE, FALSE], -- service not avail rc450: Analysis["450", FALSE, retryLater, FALSE, TRUE], -- mailbox unavail rc451: Analysis["451", FALSE, retryLater, TRUE, FALSE], -- host error rc452: Analysis["452", FALSE, retryLater, TRUE, FALSE], -- out of store <<503, and 552 will be logged with priority ATTENTION>> rc500: Analysis["500", FALSE, returnToSender, FALSE, TRUE], -- cmd unrecognized rc501: Analysis["501", FALSE, returnToSender, FALSE, TRUE], -- syntax error in args rc502: Analysis["502", FALSE, returnToSender, TRUE, TRUE], -- cmd unimplemented rc503: Analysis["503", FALSE, retryLater, TRUE, TRUE], -- bad cmd sequence rc504: Analysis["504", FALSE, returnToSender, TRUE, TRUE], -- cmd param unimpl rc550: Analysis["550", FALSE, returnToSender, FALSE, FALSE], -- unknown rcpt rc551: Analysis["551", FALSE, returnToSender, FALSE, FALSE], -- user not local rc552: Analysis["552", FALSE, returnToSender, FALSE, TRUE], -- exceeded store alloc rc553: Analysis["553", FALSE, returnToSender, FALSE, TRUE], -- bad mailbox name rc554: Analysis["554", FALSE, returnToSender, TRUE, TRUE] ]; -- transaction failed AnalyzeUnknownRC: PROC [asLiteral: ROPE] RETURNS [analysis: Analysis] = { <> analysis _ [asLiteral: "*** Too Short", success: FALSE, withItem: retryLater]; IF asLiteral.Length[] < 3 THEN RETURN; -- Avoid BoundsFalut analysis.asLiteral _ asLiteral; SELECT Rope.Fetch[asLiteral, 0] FROM '0 => -- bug/krock {analysis.success _ TRUE; analysis.withItem _ irrelevant}; '1, '2, '3 => -- positive preliminary/completion/intermediate reply (respectively) {analysis.success _ TRUE; analysis.withItem _ irrelevant}; '4 => -- transient negative completion reply {analysis.success _ FALSE; analysis.withItem _ retryLater}; '5 => -- permanent negative completion reply {analysis.success _ FALSE; analysis.withItem _ returnToSender}; ENDCASE => -- ??? shouldn't occur {analysis.success _ FALSE; analysis.withItem _ returnToSender}; SELECT Rope.Fetch[asLiteral, 1] FROM '0 => -- syntax {analysis.problemWithHost _ FALSE; analysis.logEvokingCmdLine _ TRUE}; '1 => -- information {analysis.problemWithHost _ FALSE; analysis.logEvokingCmdLine _ FALSE}; '2 => -- connections {analysis.problemWithHost _ TRUE; analysis.logEvokingCmdLine _ FALSE}; '3, '4 => -- unspecified as yet NULL; '5 => -- mail system {analysis.problemWithHost _ TRUE; analysis.logEvokingCmdLine _ FALSE}; ENDCASE => -- ??? shouldn't occur {analysis.problemWithHost _ FALSE; analysis.logEvokingCmdLine _ TRUE}; }; CheckReplyTo: PROC [hostStream: Connection, send1, send2, send3: ROPE _ NIL] RETURNS [hostResponse: ROPE] = { <> hostStr: STREAM = hostStream.stream; replyText, rcLiteral: ROPE; rcCode: RC; rcAnalysis: Analysis; start, stop: BasicTime.Pulses; <> IF send1 = NIL THEN { -- check "reply" to initial connection only, nothing to send IF out # NIL THEN { out.PutText["\n\n\n*** Initial Connection to "]; out.PutRope[hostStream.name]; out.PutText["\n"]; out.Flush[]; }; send1 _ "initial connection"; } ELSE { IF out # NIL THEN { out.PutRope[send1]; out.PutRope[send2]; out.PutRope[send3]; out.PutRope["\n"]; out.Flush[]; }; IF send1 # NIL AND Rope.Length[send1] > 0 THEN hostStr.PutRope[send1]; IF send2 # NIL AND Rope.Length[send1] > 0 THEN hostStr.PutRope[send2]; IF send3 # NIL AND Rope.Length[send1] > 0 THEN hostStr.PutRope[send3]; hostStr.PutChar['\n]; hostStr.PutChar['\l]; hostStr.Flush[]; }; start _ BasicTime.GetClockPulses[]; replyText _ GetLineRope[hostStr]; stop _ BasicTime.GetClockPulses[]; IF out # NIL THEN { seconds: INT _ BasicTime.PulsesToMicroseconds[stop-start]/1000000; out.PutF["%03G: %G\n", IO.int[seconds], IO.rope[replyText]]; }; IF replyText.Length[] > 3 AND replyText.Fetch[3] = '- THEN { -- xxxxx DO temp: ROPE; start _ BasicTime.GetClockPulses[]; temp _ GetLineRope[hostStr]; stop _ BasicTime.GetClockPulses[]; IF out # NIL THEN { seconds: INT _ BasicTime.PulsesToMicroseconds[stop-start]/1000000; out.PutF["%03G: %G\n", IO.int[seconds], IO.rope[temp]]; }; replyText _ Rope.Cat[replyText, "\n", temp]; IF temp.Length[] > 3 AND temp.Fetch[3] # '- THEN EXIT; ENDLOOP; }; rcLiteral _ Rope.Substr[replyText, 0, 3]; FOR rc: RC IN [RC.FIRST..RC.LAST) DO IF Rope.Equal[Replies[rc].asLiteral, rcLiteral] THEN { rcCode _ rc; rcAnalysis _ Replies[rc]; EXIT; }; REPEAT FINISHED => {rcCode _ unknown; rcAnalysis _ AnalyzeUnknownRC[replyText]}; ENDLOOP; <> IF rcAnalysis.success THEN RETURN[replyText]; <> SIGNAL FailureReply[rcCode, replyText]; ArpaSMTPSupport.Log[IF rcCode = rc503 OR rcCode = rc552 THEN ATTENTION -- possible code bug ELSE IF rcAnalysis.problemWithHost THEN important ELSE noteworthy, "Error reply from ", hostStream.name, ": \"", replyText, IF rcAnalysis.logEvokingCmdLine THEN Rope.Cat["\"\nin response to: \"", send1, send2, send3, "\"."] ELSE "\"."]; ERROR Failed[ withItem: rcAnalysis.withItem, reason: Rope.Cat[hostStream.name, " said ", replyText], problemWithHost: rcAnalysis.problemWithHost]; }; <> <> HELOcmd: PROC [hostStream: Connection] = { ENABLE FailureReply => RESUME; [] _ CheckReplyTo[hostStream, "HELO ", ArpaConfig.ourLocalName]; }; MAILcmd: PROC [hostStream: Connection, reversePath: ROPE] = { ENABLE FailureReply => RESUME; [] _ CheckReplyTo[hostStream, "MAIL FROM:<", reversePath, ">"]; }; RCPTcmd: PROC [hostStream: Connection, recipient: ROPE] = { -- may raise UnknownUser ENABLE FailureReply => IF rcCode = rc550 OR rcCode = rc551 THEN ERROR UnknownUser[reason] ELSE RESUME; [] _ CheckReplyTo[hostStream, "RCPT TO:<", recipient, ">"]; }; StartDATAcmd: PROC [hostStream: Connection] = { ENABLE FailureReply => RESUME; [] _ CheckReplyTo[hostStream, "DATA"]; }; EndDATAcmd: PROC [hostStream: Connection] = { <> ENABLE FailureReply => RESUME; [] _ CheckReplyTo[hostStream, "."]; }; RSETcmd: PROC [hostStream: Connection] = { ENABLE FailureReply => RESUME; [] _ CheckReplyTo[hostStream, "RSET"]; }; QUITcmd: PROC [hostStream: Connection] = { ENABLE FailureReply => RESUME; [] _ CheckReplyTo[hostStream, "QUIT"]; }; FailureReply: SIGNAL [rcCode: RC, reason: ROPE] = CODE; UnknownUser: ERROR [reason: ROPE] = CODE; MakeViewer: PROC = { [in: in, out: out] _ ViewerIO.CreateViewerStreams[ name: "ArpaSMTPSend.log", viewer: NIL, backingFile: "ArpaSMTPSend.log", editedStream: FALSE]; TypeScript.ChangeLooks[ViewerIO.GetViewerFromStream[out], 'f]; }; showThings: BOOL _ FALSE; in, out: IO.STREAM _ NIL; IF showThings THEN MakeViewer[]; END.