<> <> <> <> <> <> DIRECTORY ArpaConfig USING [ourLocalName, specialDomains, validDomains], ArpaMT USING [Info, ParseHeaders, TranslateMessage, TranslateToGrapevine], ArpaName USING [AliasToName], ArpaSMTPDescr USING [Descr, GetFormat, GetGvSender, GetPrecedeMsgText, GetReturnPathLine, GetSource, RetrieveMsgStream, UniqueID, Unparse], ArpaSMTPGVSend USING [WithItemAction], ArpaSMTPSupport USING [HeaderParseError, Log], ArpaSMTPSyntax USING [EnumerateGVItems, GVItemProc], ArpaSMTPQueue USING [DLWithoutUpArrow], Convert USING [RopeFromInt], FS USING [Delete, Error, StreamOpen], GVBasics USING [Connect, ItemType, maxGVStringLength, RName], GVNames USING [Expand, MemberInfo, GetMembers, NameType, RListHandle, GetConnect], GVSend USING [AddRecipient, AddToItem, CheckValidity, Create, Handle, Send, SendFailed, SetMailDropList, StartItem, StartSend, StartSendInfo], GVProtocol USING [GetSocket], IO USING [Close, GetBlock, GetLength, RopeFromROS, ROS, STREAM], RefText USING [ObtainScratch, ReleaseScratch, TrustTextAsRope], Pup USING [Address], PupName USING [Error, NameLookup], Rope USING [Cat, Concat, Equal, Fetch, Find, IsEmpty, Length, ROPE, Substr], GVSendImpl USING [serverAddr, serverKnown]; ArpaSMTPGVSendImpl: CEDAR PROGRAM IMPORTS ArpaConfig, ArpaMT, ArpaName, ArpaSMTPDescr, ArpaSMTPSupport, ArpaSMTPSyntax, ArpaSMTPQueue, Convert, FS, GVNames, GVProtocol, GVSend, GVSendImpl, IO, PupName, RefText, Rope EXPORTS ArpaSMTPGVSend SHARES GVSendImpl = -- Need to manipulate GV server cache to avoid overloading server BEGIN ROPE: TYPE = Rope.ROPE; STREAM: TYPE = IO.STREAM; totalGvMsgsSent: PUBLIC INT _ 0; totalGvBytesSent: PUBLIC INT _ 0; gvMsgCounter: INT _ 0; gvMsgCountSwitch: INT _ 1; arpaMailDropAddresses: PupAddresses; PupAddresses: TYPE = REF PupAddressSeq; PupAddressSeq: TYPE = RECORD [SEQUENCE possible: CARDINAL OF Pup.Address]; thisServer: CARDINAL _ 0; maxServer: CARDINAL _ 0; Connection: TYPE = REF ConnectionRep; -- so it can be opaque ConnectionRep: PUBLIC TYPE = RECORD[stream: GVSend.Handle, bytes: INT]; Open: PUBLIC PROC RETURNS [conn: Connection] = { RETURN[NEW[ConnectionRep _ [GVSend.Create[], 0]]]; -- no errors; connection not opened until item sent }; <> <> SendItem: PUBLIC PROC [descr: ArpaSMTPDescr.Descr, recipList: LIST OF ROPE, conn: Connection] = { handle: GVSend.Handle = conn.stream; numAttempts: INT _ 0; BEGIN ENABLE GVSend.SendFailed => IF NOT notDelivered THEN { ArpaSMTPSupport.Log[noteworthy, "GVSend had difficulty sending the following item:\n", ArpaSMTPDescr.Unparse[descr, long], "Last error was ", why, "."]; CONTINUE; -- i.e. RETURN } ELSE IF (numAttempts _ numAttempts + 1) > 10 THEN { ArpaSMTPSupport.Log[important, "GVSend failed 10 times to send the following item:\n", ArpaSMTPDescr.Unparse[descr, long], "Last error was ", why, ".\nWill try again later."]; ERROR Failed[withItem: retryLater, reason: Rope.Concat["GVSend failed 10 times: ", why], problemWithGV: FALSE]; } ELSE { ArpaSMTPSupport.Log[noteworthy, "GVSend failed to send the following item: ", ArpaSMTPDescr.Unparse[descr], ".\nLast error was ", why, ". Retrying."]; RETRY; }; sender: ROPE _ ArpaSMTPDescr.GetGvSender[descr]; returnTo: ROPE _ ArpaSMTPDescr.GetGvSender[descr]; <> badRecipients: ROPE _ NIL; good: INT _ 0; getPrecedeMsgText: ROPE _ ArpaSMTPDescr.GetPrecedeMsgText[descr]; getReturnPathLine: ROPE _ ArpaSMTPDescr.GetReturnPathLine[descr]; buffer: REF TEXT; bufferRope: ROPE; -- these two are punned startResult: GVSend.StartSendInfo; msgStream: STREAM; SendGVMsgItem: ArpaSMTPSyntax.GVItemProc = { -- GV format only, for the Enumerate proc iType: GVBasics.ItemType = itemHeader.type; IF iType = PostMark OR iType = Sender OR iType = ReturnTo OR iType = Recipients OR iType = LastItem THEN RETURN; IF iType = Tioga1 OR iType IN [Smalltalk..lastSmallTalk] OR iType IN [Interlisp..lastInterlisp] OR iType = GGW THEN RETURN; GVSend.StartItem[handle~handle, type~itemHeader.type]; IF iType = Text THEN { IF getReturnPathLine # NIL THEN { -- Not likely GVSend.AddToItem[handle: handle, buffer: getReturnPathLine]; GVSend.AddToItem[handle: handle, buffer: "\n"]; conn.bytes _ conn.bytes + getReturnPathLine.Length[] + 1; getReturnPathLine _ NIL; }; IF getPrecedeMsgText # NIL THEN { GVSend.AddToItem[handle: handle, buffer: getPrecedeMsgText]; GVSend.AddToItem[handle: handle, buffer: "\n"]; conn.bytes _ conn.bytes + getPrecedeMsgText.Length[] + 1; getPrecedeMsgText _ NIL; }; }; SendGVMsgItemData[handle, msgStream, itemHeader.length]; }; SendGVMsgItemData: PROC [handle: GVSend.Handle, itemStream: STREAM, nBytes: INT] = { WHILE nBytes > 0 DO nBytesRead: INT; <> nBytesRead _ itemStream.GetBlock[ block: buffer, count: MIN[nBytes, buffer.maxLength]]; IF nBytesRead = 0 THEN EXIT; -- Grapevine error (item length wrong), ignore nBytes _ nBytes - nBytesRead; GVSend.AddToItem[handle~handle, buffer~bufferRope]; conn.bytes _ conn.bytes + nBytesRead; ENDLOOP; }; AddBadRecip: PROC [positionInList: INT, name: ROPE] = { good _ good - 1; IF badRecipients # NIL THEN badRecipients _ Rope.Concat[badRecipients, "\n"]; badRecipients _ Rope.Cat[badRecipients, "\t\"", name, "\" => invalid recipient"]; }; <> FOR list: LIST OF ROPE _ recipList, list.rest UNTIL list = NIL DO recipient: ROPE _ list.first; IF (Rope.Find[recipient, "^"] # -1 AND ValidDL[recipient]) OR ArpaSMTPQueue.DLWithoutUpArrow[recipient] THEN { returnTo _ Rope.Cat["Owners-", recipient]; EXIT; }; ENDLOOP; sender _ ValidSender[sender, descr]; returnTo _ ValidSender[returnTo, descr]; SELECT ArpaSMTPDescr.GetFormat[descr] FROM gv => NULL; arpa => { <> input: IO.STREAM _ ArpaSMTPDescr.RetrieveMsgStream[descr]; errors: IO.STREAM = IO.ROS[]; info: ArpaMT.Info _ ArpaMT.ParseHeaders[input, errors]; input.Close[]; ArpaMT.TranslateToGrapevine[info]; }; ENDCASE => ERROR; <> startResult _ GVSend.StartSend[ handle: handle, sender: sender, senderPwd: "", returnTo: returnTo, validate: TRUE]; SELECT startResult FROM ok => NULL; badSender, badPwd => { -- something is wrong! ArpaSMTPSupport.Log[ CRITICAL, "Grapevine refused input, claiming \"bad ", IF startResult = badSender THEN "sender" ELSE "password", "\" for sender \"", sender, "\".\nWill try again later, though intervention is probably required."]; ERROR Failed[ withItem: retryLater, reason: "Grapevine said bad sender/password", problemWithGV: FALSE]; }; badReturnTo => { <> ArpaSMTPSupport.Log[ATTENTION, "Grapevine StartSend failed, claiming \"bad ReturnTo\" for the name \"", returnTo, "\"\nwhen I tried to send the following item:\n", ArpaSMTPDescr.Unparse[descr, long], "Will place that item on the BadQueue. Edit the file and requeue."]; ERROR Failed[ withItem: retryLater, reason: "Grapevine said bad ReturnTo", problemWithGV: FALSE]; }; allDown => { ArpaSMTPSupport.Log[important, "Grapevine StartSend failed, claiming \"all down\" ", "when I tried to send the following item: ", ArpaSMTPDescr.Unparse[descr], ".\nWill try again later."]; ERROR Failed[ withItem: retryLater, reason: "All GV servers are down", problemWithGV: TRUE]; }; ENDCASE => ERROR; <> FOR restRecips: LIST OF ROPE _ recipList, restRecips.rest UNTIL restRecips = NIL DO who: ROPE _ restRecips.first; good _ good + 1; {bad: BOOLEAN _ FALSE; FOR list: LIST OF Rope.ROPE _ ArpaConfig.validDomains, list.rest UNTIL list = NIL DO domain: Rope.ROPE _ list.first; IF DotTailed[who, domain] THEN {bad _ TRUE; EXIT}; ENDLOOP; IF bad THEN {AddBadRecip[0,who]; LOOP}; }; GVSend.AddRecipient[handle: handle, recipient: who]; ENDLOOP; [] _ GVSend.CheckValidity[handle: handle, notify: AddBadRecip]; <> conn.bytes _ 0; msgStream _ ArpaSMTPDescr.RetrieveMsgStream[descr]; buffer _ RefText.ObtainScratch[512]; bufferRope _ RefText.TrustTextAsRope[buffer]; SELECT ArpaSMTPDescr.GetFormat[descr] FROM gv => { ArpaSMTPSyntax.EnumerateGVItems[GVStream: msgStream, proc: SendGVMsgItem]; }; arpa => { DeleteVersions: PROC[name: Rope.ROPE, nVersions: CARDINAL] = {FOR i: CARDINAL IN [0..nVersions) DO FS.Delete[name]; ENDLOOP;}; tempName: ROPE = "///MG/ToGrapevine"; keep: CARDINAL = 5; temp: IO.STREAM; errors: IO.STREAM = IO.ROS[]; temp _ FS.StreamOpen[fileName: tempName, accessOptions: $create, keep: keep ! FS.Error => {IF error.code = $noMoreVersions THEN {DeleteVersions[tempName, keep]; RETRY}}]; ArpaMT.TranslateMessage[in: msgStream, out: temp, error: errors, direction: toGrapevine, id: ArpaSMTPDescr.UniqueID[descr] ]; msgStream.Close[]; temp.Close[]; msgStream _ FS.StreamOpen[tempName, $read]; GVSend.StartItem[handle, Text]; IF getReturnPathLine # NIL THEN { GVSend.AddToItem[handle: handle, buffer: getReturnPathLine]; GVSend.AddToItem[handle: handle, buffer: "\n"]; conn.bytes _ conn.bytes + getReturnPathLine.Length[] + 1; }; IF getPrecedeMsgText # NIL THEN { GVSend.AddToItem[handle: handle, buffer: getPrecedeMsgText]; GVSend.AddToItem[handle: handle, buffer: "\n"]; conn.bytes _ conn.bytes + getPrecedeMsgText.Length[] + 1; }; IF errors.GetLength[] # 0 THEN { IF FALSE THEN { comment: ROPE = "Comment: ***** Troubles parsing headers. Fixups may look strange.\n"; GVSend.AddToItem[ handle: handle, buffer: comment]; GVSend.AddToItem[handle: handle, buffer: IO.RopeFromROS[errors]]; conn.bytes _ conn.bytes + comment.Length[]; }; ArpaSMTPSupport.HeaderParseError[recipList, descr]; }; SendGVMsgItemData[ handle: handle, itemStream: msgStream, nBytes: msgStream.GetLength[]]; }; ENDCASE => ERROR; msgStream.Close[]; GVSend.Send[handle]; RefText.ReleaseScratch[buffer]; <<>> <<>> IF badRecipients = NIL THEN { totalGvMsgsSent _ totalGvMsgsSent +1; totalGvBytesSent _ totalGvBytesSent + conn.bytes; MaybeRotateGvServer[]; ArpaSMTPSupport.Log[noteworthy, ArpaSMTPDescr.Unparse[descr], Bytes[conn.bytes], "Grapevine."]; } ELSE { reason: ROPE; IF badRecipients # NIL THEN reason _ Rope.Cat[reason, "Unable to deliver msg to the following recipients:\n", badRecipients, "."]; IF good > 0 THEN reason _ Rope.Cat[ reason, "\nSuccessfully delivered to some recipients."]; ArpaSMTPSupport.Log[ noteworthy, ArpaSMTPDescr.Unparse[descr], " will be returned because.\n", reason]; ERROR Failed[withItem: returnToSender, reason: reason, problemWithGV: FALSE]; } END; }; MaybeRotateGvServer: PROC = { gvMsgCounter _ gvMsgCounter +1; IF gvMsgCounter = gvMsgCountSwitch THEN { gvMsgCounter _ 0; IF thisServer >= maxServer THEN thisServer _ 0 ELSE thisServer _ thisServer +1; GVSendImpl.serverAddr _ arpaMailDropAddresses[thisServer]; GVSendImpl.serverKnown _ TRUE}; }; SetMailDropAddresses: PROC[who: GVBasics.RName] = { mInfo: GVNames.MemberInfo = GVNames.GetMembers[who]; count: INT _ -1; SELECT mInfo.type FROM notFound, individual => ERROR; allDown => ERROR; group => { m: group GVNames.MemberInfo = NARROW[mInfo, group GVNames.MemberInfo]; IF m.count = 0 THEN ERROR; maxServer _ m.count-1; arpaMailDropAddresses _ NEW[PupAddressSeq[m.count]]; FOR member: GVNames.RListHandle _ m.members, member.rest UNTIL member = NIL DO cInfo: GVNames.NameType; connect: GVBasics.Connect; [cInfo, connect] _ GVNames.GetConnect[member.first]; SELECT cInfo FROM individual => BEGIN addr: Pup.Address = PupName.NameLookup[connect, GVProtocol.GetSocket[RSEnquiry] ! PupName.Error => GOTO Cant]; count _ count +1; arpaMailDropAddresses[count] _ addr; EXITS Cant => NULL; END; ENDCASE => NULL; -- ignore others ENDLOOP; }; ENDCASE => ERROR; IF count < 0 THEN ERROR; -- need at least one server GVSendImpl.serverAddr _ arpaMailDropAddresses[thisServer]; GVSendImpl.serverKnown _ TRUE; }; Failed: PUBLIC ERROR [withItem: ArpaSMTPGVSend.WithItemAction, reason: ROPE, problemWithGV: BOOL] = CODE; Bytes: PROC [bytes: INT] RETURNS [rope: ROPE] = { rope _ Rope.Cat[" sent ", Convert.RopeFromInt[bytes], " bytes to "]; }; ValidSender: PROC [raw: ROPE, descr: ArpaSMTPDescr.Descr] RETURNS [arpa: ROPE] = BEGIN tmp: ROPE; IF raw = NIL THEN RETURN[NIL]; arpa _ MinimalValidPath[raw]; -- @Foo:X@Y case SELECT TRUE FROM Rope.Find[arpa, ","] # -1 => { <<@A,@B:User@Host => comma would be bogus in rejection msgs>> tmp _ Rope.Cat["\"", arpa, "\"@", ArpaConfig.ourLocalName]; IF Rope.Length[tmp] > GVBasics.maxGVStringLength THEN arpa _ MinimalValidPath[arpa] ELSE arpa _ tmp; }; arpa.Fetch[0] = '@ => { <> tmp _ Rope.Cat["\"", arpa, "\"@", ArpaConfig.ourLocalName]; IF Rope.Length[tmp] > GVBasics.maxGVStringLength THEN arpa _ MinimalValidPath[arpa] ELSE arpa _ tmp; }; SpecialDomain[arpa] => NULL; -- User@Host.bitnet, .csnet, or .uucp ENDCASE => <> <> BEGIN user, host, newHost: ROPE; [user, host] _ BreakName[arpa, '@]; IF ~Rope.IsEmpty[host] THEN IF host.Fetch[0] = '[ THEN host _ Rope.Cat[host, ".ARPA"]; -- [36,1,2,6] IF Rope.Find[host, ".",, FALSE] = -1 THEN host _ Rope.Cat[host, ".ARPA"]; newHost _ ArpaName.AliasToName[host].name; IF Rope.IsEmpty[newHost] THEN { <> <> arpa _ Rope.Cat["\"", arpa, "\"@", ArpaConfig.ourLocalName]; } ELSE arpa _ Rope.Cat[user, "@", newHost]; END; IF arpa.Fetch[0] = '@ THEN arpa _ Rope.Cat["\"", arpa, "\"@", ArpaConfig.ourLocalName]; IF Rope.Length[arpa] > GVBasics.maxGVStringLength THEN { IF Rope.Length[raw] > GVBasics.maxGVStringLength OR raw.Fetch[0] = '@ THEN arpa _ Rope.Cat["SenderNameTooLong@", ArpaSMTPDescr.GetSource[descr]] ELSE arpa _ raw; }; END; MinimalValidPath: PROC [raw: ROPE] RETURNS [minPath: ROPE] = { left, right: ROPE; user, host, gateway: ROPE; IF raw = NIL THEN RETURN[NIL]; IF raw.Fetch[0] # '@ THEN RETURN[raw]; [left, right] _ BreakName[raw, ':]; IF Rope.IsEmpty[left] OR Rope.IsEmpty[right] THEN RETURN[raw]; [user, host] _ BreakName[right, '@]; IF Rope.IsEmpty[user] OR Rope.IsEmpty[host] THEN RETURN[raw]; IF Rope.Find[host, ".",, FALSE] = -1 THEN host _ Rope.Cat[host, ".ARPA"]; IF ~ SpecialDomain[host] THEN { newHost: ROPE; newHost _ ArpaName.AliasToName[host].name; IF ~Rope.IsEmpty[newHost] THEN host _ newHost; RETURN[Rope.Cat[user, "@", host]]; }; [, gateway] _ BreakName[left, '@]; IF Rope.IsEmpty[gateway] THEN RETURN[Rope.Cat[user, "@", host]]; IF Rope.Find[gateway, ".",, FALSE] = -1 THEN gateway _ Rope.Cat[gateway, ".ARPA"]; gateway _ ArpaName.AliasToName[gateway].name; IF Rope.IsEmpty[gateway] THEN RETURN[raw]; minPath _ Rope.Cat["@", gateway]; minPath _ Rope.Cat[minPath, ":", user, "@", host]; }; SpecialDomain: PROC [raw: ROPE] RETURNS [BOOLEAN] = { FOR list: LIST OF Rope.ROPE _ ArpaConfig.specialDomains, list.rest UNTIL list = NIL DO domain: Rope.ROPE _ list.first; IF DotTailed[raw, domain] THEN RETURN[TRUE]; ENDLOOP; RETURN[FALSE];}; BreakName: PROC[name: Rope.ROPE, char: CHAR _ '.] RETURNS[left, right: Rope.ROPE] = BEGIN length: INT = name.Length[]; FOR i: INT DECREASING IN [0..length) DO IF name.Fetch[i] = char THEN RETURN[ left: name.Substr[start: 0, len: i], right: name.Substr[start: i+1, len: length-(i+1)] ]; ENDLOOP; RETURN[left: NIL, right: NIL]; END; Tailed: PROC [body, tail: ROPE] RETURNS [match: BOOL] = { bodyLength: INT = body.Length[]; tailLength: INT = tail.Length[]; back: ROPE; IF bodyLength <= tailLength THEN RETURN[FALSE]; back _ Rope.Substr[body, bodyLength-tailLength, tailLength]; IF Rope.Equal[back, tail, FALSE] THEN RETURN[TRUE]; RETURN[FALSE]; }; DotTailed: PROC [body, tail: ROPE] RETURNS [match: BOOL] = { IF ~Tailed[body, tail] THEN RETURN[FALSE]; IF Rope.Fetch[body, Rope.Length[body]-Rope.Length[tail]-1] # '. THEN RETURN[FALSE]; RETURN[TRUE]; }; <<>> cacheOfKnownBadDLs: LIST OF ROPE; cacheOfKnownGoodDLs: LIST OF ROPE; ValidDL: PROC [dl: ROPE] RETURNS [valid: BOOL] = { FOR list: LIST OF ROPE _ cacheOfKnownGoodDLs, list.rest UNTIL list = NIL DO IF Rope.Equal[dl, list.first, FALSE] THEN RETURN[TRUE]; ENDLOOP; FOR list: LIST OF ROPE _ cacheOfKnownBadDLs, list.rest UNTIL list = NIL DO IF Rope.Equal[dl, list.first, FALSE] THEN RETURN[FALSE]; ENDLOOP; SELECT GVNames.Expand[dl].type FROM noChange => ERROR; group => { cacheOfKnownGoodDLs _ CONS[dl, cacheOfKnownGoodDLs]; RETURN[TRUE]; }; individual, notFound => { cacheOfKnownBadDLs _ CONS[dl, cacheOfKnownBadDLs]; RETURN[FALSE]; }; protocolError, wrongServer => ERROR; allDown => RETURN[TRUE]; ENDCASE => ERROR; }; GVSend.SetMailDropList["ArpaMailDrop.ms"]; SetMailDropAddresses["ArpaMailDrop.ms"]; END.