<> <> <> <> <> <> DIRECTORY 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], IPConfig USING [validDomains], RefText USING [ObtainScratch, ReleaseScratch, TrustTextAsRope], Pup USING [Address], PupName USING [Error, NameLookup], Rope USING [Cat, Concat, Equal, Fetch, Find, Length, ROPE, Substr], MT USING [Info, ParseHeaders, TranslateMessage, TranslateToGrapevine], SMTPDescr USING [Descr, GetFormat, GetGvSender, GetPrecedeMsgText, GetReturnPathLine, GetSource, RetrieveMsgStream, UniqueID, Unparse], SMTPGVSend USING [WithItemAction], SMTPSupport USING [HeaderParseError, Log], SMTPSyntax USING [EnumerateGVItems, GVItemProc], SMTPQueue USING [DLWithoutUpArrow], GVSendImpl USING [serverAddr, serverKnown]; SMTPGVSendImpl: CEDAR PROGRAM IMPORTS Convert, FS, GVNames, GVProtocol, GVSend, GVSendImpl, IPConfig, IO, PupName, RefText, Rope, MT, SMTPDescr, SMTPSupport, SMTPSyntax, SMTPQueue EXPORTS SMTPGVSend 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: SMTPDescr.Descr, recipList: LIST OF ROPE, conn: Connection] = { handle: GVSend.Handle = conn.stream; numAttempts: INT _ 0; BEGIN ENABLE GVSend.SendFailed => IF NOT notDelivered THEN { SMTPSupport.Log[noteworthy, "GVSend had difficulty sending the following item:\n", SMTPDescr.Unparse[descr, long], "Last error was ", why, "."]; CONTINUE; -- i.e. RETURN } ELSE IF (numAttempts _ numAttempts + 1) > 10 THEN { SMTPSupport.Log[important, "GVSend failed 10 times to send the following item:\n", SMTPDescr.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 { SMTPSupport.Log[noteworthy, "GVSend failed to send the following item: ", SMTPDescr.Unparse[descr], ".\nLast error was ", why, ". Retrying."]; RETRY; }; sender: ROPE _ SMTPDescr.GetGvSender[descr]; returnTo: ROPE _ SMTPDescr.GetGvSender[descr]; <> badRecipients: ROPE _ NIL; good: INT _ 0; getPrecedeMsgText: ROPE _ SMTPDescr.GetPrecedeMsgText[descr]; getReturnPathLine: ROPE _ SMTPDescr.GetReturnPathLine[descr]; buffer: REF TEXT; bufferRope: ROPE; -- these two are punned startResult: GVSend.StartSendInfo; msgStream: STREAM; SendGVMsgItem: SMTPSyntax.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 SMTPQueue.DLWithoutUpArrow[recipient] THEN { returnTo _ Rope.Cat["Owners-", recipient]; EXIT; }; ENDLOOP; sender _ ValidSender[sender, descr]; returnTo _ ValidSender[returnTo, descr]; SELECT SMTPDescr.GetFormat[descr] FROM gv => NULL; arpa => { <> input: IO.STREAM _ SMTPDescr.RetrieveMsgStream[descr]; errors: IO.STREAM = IO.ROS[]; info: MT.Info _ MT.ParseHeaders[input, errors]; input.Close[]; MT.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! SMTPSupport.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 => { <> SMTPSupport.Log[ATTENTION, "Grapevine StartSend failed, claiming \"bad ReturnTo\" for the name \"", returnTo, "\"\nwhen I tried to send the following item:\n", SMTPDescr.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 => { SMTPSupport.Log[important, "Grapevine StartSend failed, claiming \"all down\" ", "when I tried to send the following item: ", SMTPDescr.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 _ IPConfig.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 _ SMTPDescr.RetrieveMsgStream[descr]; buffer _ RefText.ObtainScratch[512]; bufferRope _ RefText.TrustTextAsRope[buffer]; SELECT SMTPDescr.GetFormat[descr] FROM gv => { SMTPSyntax.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}}]; MT.TranslateMessage[in: msgStream, out: temp, error: errors, direction: toGrapevine, id: SMTPDescr.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[]; }; SMTPSupport.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[]; SMTPSupport.Log[noteworthy, SMTPDescr.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."]; SMTPSupport.Log[ noteworthy, SMTPDescr.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: SMTPGVSend.WithItemAction, reason: ROPE, problemWithGV: BOOL] = CODE; Bytes: PROC [bytes: INT] RETURNS [rope: ROPE] = { rope _ Rope.Cat[" sent ", Convert.RopeFromInt[bytes], " bytes to "]; }; ValidSender: PROC [sender: ROPE, descr: SMTPDescr.Descr] RETURNS [valid: ROPE] = { IF Rope.Length[sender] <= GVBasics.maxGVStringLength THEN RETURN[sender]; valid _ Rope.Cat["SenderNameTooLong@", SMTPDescr.GetSource[descr]]; IF Rope.Length[valid] > GVBasics.maxGVStringLength THEN valid _ "SenderNameTooLong@[1.2.3.4].ARPA"; FOR list: LIST OF Rope.ROPE _ IPConfig.validDomains, list.rest UNTIL list = NIL DO domain: Rope.ROPE _ list.first; IF DotTailed[valid, domain] THEN RETURN; ENDLOOP; <> valid _ Rope.Cat[valid, ".ARPA"]; IF Rope.Length[valid] > GVBasics.maxGVStringLength THEN valid _ "SenderNameTooLong@[1.2.3.4].ARPA"; }; 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.