SMTPGVSendImpl.mesa
Copyright c 1985 by Xerox Corporation. All rights reserved.
Last Edited by: DCraft, December 21, 1983 1:11 pm
Last Edited by: Taft, February 3, 1984 11:12:08 am PST
Last Edited by: HGM, July 26, 1985 1:38:05 pm PDT
John Larson, July 21, 1987 11:06:57 am PDT
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
};
Close: PROC [gvStream: Connection] = {};
Close is not a defined procedure because of the way Grapevine views "connections". The handle is only storage space; the connection is opened and closed by the GVSend calls StartSend and Send, respectively (called by SendItem). Since the stream is only opened by StartSend and is only closed by Send or if SendFailed is raised, we do not have to worry about closing the stream.
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];
bangs: ROPE ← NIL;
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;
Beware of bounds fault - count is a NAT
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"]; };
This might confuse somebody if a msg is sent to several DLs, but that's better than having the confusion go back out the the net when a msg is sent to a DL and a person.
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 => {
With the new Domain naming scheme, normalizing names can take long enough so that sending a msg to GV times out while we are negotiating with the ARPA name servers. An extra translation here will load the cache.
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;
Order must be: StartSend, AddRecipient..., CheckValidity, [StartItem, AddToItem...]..., Send. Try StartSend and decode the result. Note that the StartSend..Send "loop" is only broken when an item is successfully sent, StartSend fails, or there are too many retries.
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 => {
This happens occasionally. I guess it's a server bug.
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;
Send and validate all the recipients, constructing a BadRecipients rope.
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];
Now send the message body.
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;
Mumble, unknown top level domain. GV will reject this.
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.