ArpaSMTPGVSendImpl.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, March 9, 1988 11:37:46 am PST
DIRECTORY
ArpaConfig USING [ourLocalName, specialDomains, validDomains],
ArpaMT USING [Info, ParseHeaders, TranslateMessage, TranslateToGrapevine],
ArpaSMTPDescr USING [Descr, GetFormat, GetGvSender, GetPrecedeMsgText, GetReturnPathLine, GetSource, RetrieveMsgStream, UniqueID, Unparse],
ArpaSMTPGVSend USING [WithItemAction],
ArpaSMTPSupport USING [HeaderParseError, Log],
ArpaSMTPSyntax USING [EnumerateGVItems, GVItemProc, NormalizeName],
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, 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
};
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: 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];
bangs: ROPENIL;
badRecipients: ROPENIL;
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;
gvDL: BOOLFALSE;
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;
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 ArpaSMTPQueue.DLWithoutUpArrow[recipient] THEN {
returnTo ← Rope.Cat["Owners-", recipient];
gvDL ← TRUE;
EXIT; };
ENDLOOP;
sender ← ValidSender[sender, descr];
IF ~gvDL THEN returnTo ← ValidSender[returnTo, descr];
SELECT ArpaSMTPDescr.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 ← ArpaSMTPDescr.RetrieveMsgStream[descr];
errors: IO.STREAM = IO.ROS[];
info: ArpaMT.Info ← ArpaMT.ParseHeaders[input, errors];
input.Close[];
ArpaMT.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!
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 => {
This happens occasionally. I guess it's a server bug.
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;
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: BOOLEANFALSE;
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];
Now send the message body.
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] = '@ => {
Can't hack reverse path, so add ourLocalName
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 =>
User@Host (no .ARPA)
Somebody fed us an alias rather than the truth. Normalize it.
BEGIN
user, host, newHost: ROPE;
[user, host] ← BreakName[arpa, '@];
newHost ← ArpaSMTPSyntax.NormalizeName[host];
IF Rope.IsEmpty[newHost] THEN {
Yetch. Somebody fed us a bogus name in a return path.
Rejection msgs from GV will probably not work.
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 ← ArpaSMTPSyntax.NormalizeName[host];
IF ~Rope.IsEmpty[newHost] THEN RETURN[Rope.Cat[user, "@", newHost]];
};
[, gateway] ← BreakName[left, '@];
IF Rope.IsEmpty[gateway] THEN RETURN[raw];
gateway ← ArpaSMTPSyntax.NormalizeName[gateway];
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.