-- Transport Mechanism Mail Server - Return Undeliverable Mail --

-- [Indigo]<Grapevine>MS>ReturnMail.mesa

-- Randy Gobbel19-May-81 23:38:50 --
-- Andrew Birrell 4-Mar-82 14:42:33 --
-- Michael Schroeder August 18, 1982 9:15 PM --

DIRECTORY
AsciiUSING[ CR ],
BodyDefsUSING[ ItemHeader, ItemLength, maxRNameLength,
RName, Timestamp ],
HeapDefsUSING[ GetReaderOffset, HeapAbandonWrite, HeapEndRead,
HeapEndWrite, HeapReadData, HeapReadRName,
HeapStartRead, ObjectNumber, ObjectOffset,
objectStart, ReaderHandle, SetReaderOffset,
WriterHandle ],
InlineUSING[ LowHalf ],
LocalNameDefsUSING[ ReadMSName ],
LogDefsUSING[ WriteLogEntry ],
ProtocolDefsUSING[ AppendTimestamp ],
ReturnDefsUSING[] --EXPORT only--,
SendDefsUSING[ Abort, AddRecipient, AddToItem, Create, Destroy,
CheckValidity, Handle, StartSend, StartText, Send ],
StringUSING[ AppendDecimal, AppendString ],
TimeUSING[ Append, Current, Packed, Unpack ],
VMDefsUSING[ AllocatePage, Page, pageSize, Release ];

ReturnMail: PROGRAM
IMPORTS HeapDefs, Inline, LocalNameDefs, LogDefs,
ProtocolDefs, SendDefs, String, Time, VMDefs
EXPORTS ReturnDefs =

BEGIN

ParseBody: PUBLIC PROCEDURE[ reader: HeapDefs.ReaderHandle,
stamp: POINTER TO BodyDefs.Timestamp ← NIL,
sender: BodyDefs.RName ← NIL,
returnTo: BodyDefs.RName ← NIL ]
RETURNS[ BodyDefs.ItemLength ] =
BEGIN
textStart: HeapDefs.ObjectOffset;
textFound: BOOLEAN ← FALSE;
textLength: BodyDefs.ItemLength;
header: BodyDefs.ItemHeader;
found: CARDINAL ← 0;
UNTIL found = 4 -- postmark, sender, returnto, text/end --
DO [] ← HeapDefs.HeapReadData[reader, [@header,SIZE[BodyDefs.ItemHeader]] ];
BEGIN
itemStart: HeapDefs.ObjectOffset = HeapDefs.GetReaderOffset[reader];
found ← found + 1;
SELECT header.type FROM
PostMark =>
IF stamp # NIL
THEN [] ← HeapDefs.HeapReadData[reader,
[stamp,SIZE[BodyDefs.Timestamp]] ];
Sender =>
IF sender # NIL
THEN [] ← HeapDefs.HeapReadRName[reader, sender];
ReturnTo =>
IF returnTo # NIL
THEN [] ← HeapDefs.HeapReadRName[reader, returnTo];
Text =>
BEGIN
textStart ← itemStart;
textLength ← header.length;
textFound ← TRUE; EXIT
END;
LastItem =>
NULL;
ENDCASE => found ← found - 1;
--skip past item--
HeapDefs.SetReaderOffset[reader, itemStart + (1+header.length)/2 ];
END
ENDLOOP--each item of a message--;
IF textFound
THEN BEGIN
HeapDefs.SetReaderOffset[reader, textStart];
RETURN[textLength]
END
ELSE RETURN[0]
END;

CopyItem: PUBLIC PROCEDURE[reader: HeapDefs.ReaderHandle,
length: BodyDefs.ItemLength,
sendBlock: PROCEDURE[UNSPECIFIED, POINTER, CARDINAL],
sendBlockData: UNSPECIFIED ] =
BEGIN
data: VMDefs.Page = VMDefs.AllocatePage[];
WHILE length > 0
DO BEGIN
ENABLE UNWIND => VMDefs.Release[data];
--messy because we’re reading words and sending bytes--
wanted: CARDINAL;
given: CARDINAL;
used: CARDINAL;
wanted ← IF VMDefs.pageSize*2 < length
THEN VMDefs.pageSize*2
ELSE Inline.LowHalf[length];
[,used] ← HeapDefs.HeapReadData[reader, [data,(1+wanted)/2] ];
given ← MIN[used*2, wanted];
sendBlock[sendBlockData, data, given];
length ← length - given;
END;
ENDLOOP;
VMDefs.Release[data];
END;

AppendOwner: PROC[s: STRING, group: STRING] =
BEGIN
String.AppendString[s, "Owners-"L];
FOR i: CARDINAL IN [0..MIN[s.maxlength-s.length,group.length] )
DO s[s.length] ← group[i]; s.length ← s.length+1; ENDLOOP;
END;



BadRecipients: PUBLIC PROC[list: HeapDefs.WriterHandle,
body: HeapDefs.ObjectNumber] =
{ Return[list, body, user, NIL, NIL, NIL] };

BadGroup: PUBLIC PROC[list: HeapDefs.WriterHandle,
body: HeapDefs.ObjectNumber,
group: BodyDefs.RName] =
{ Return[list, body, owner, group, NIL, NIL] };

RejectedByMTP: PUBLIC PROC[list: HeapDefs.WriterHandle,
body: HeapDefs.ObjectNumber,
server: STRING,
text: STRING] =
{ Return[list, body, mtp, NIL, server, text] };

LongTerm: PUBLIC PROC[list: HeapDefs.WriterHandle,
body: HeapDefs.ObjectNumber] =
{ Return[list, body, longTerm, NIL, NIL, NIL] };


NoDeadLetterRName: SIGNAL = CODE;
LooksLikeImDown: ERROR = CODE;
MyNameIsWrong: ERROR = CODE;
maxReturnDays: CARDINAL = 7; -- discard messages older than this --

Return: PROCEDURE[ list: HeapDefs.WriterHandle,
body: HeapDefs.ObjectNumber,
case: { user, owner, mtp, longTerm },
group: BodyDefs.RName,
server, text: STRING ] =
BEGIN OPEN SendDefs;
bodyReader: HeapDefs.ReaderHandle = HeapDefs.HeapStartRead[body];
sendHandle: Handle = Create[];
wsBuffer: STRING = [64];
ws: PROCEDURE[s: STRING] =
BEGIN
OPEN Ascii;
FOR index: CARDINAL IN [0..s.length)
DO IF wsBuffer.length = wsBuffer.maxlength --must be even--
THEN BEGIN
AddToItem[sendHandle,
DESCRIPTOR[@(wsBuffer.text), wsBuffer.length] ];
wsBuffer.length ← 0;
END;
wsBuffer[wsBuffer.length] ← IF s[index] = ’~ THEN CR ELSE s[index];
wsBuffer.length ← wsBuffer.length + 1;
ENDLOOP;
END;
FlushWS: PROC =
BEGIN
IF wsBuffer.length MOD 2 # 0 THEN ws[" "L];
AddToItem[sendHandle,
DESCRIPTOR[@(wsBuffer.text), wsBuffer.length] ];
wsBuffer.length ← 0;
END;
wt: PROCEDURE[t: Time.Packed] =
BEGIN
s: STRING = [30];
Time.Append[s, Time.Unpack[t], TRUE];
ws[s];
END;
textLength: BodyDefs.ItemLength;
badCount: CARDINAL ← 0;
stamp: BodyDefs.Timestamp;
returnTo: BodyDefs.RName = [BodyDefs.maxRNameLength];
sender: BodyDefs.RName = [BodyDefs.maxRNameLength];
textLength ← ParseBody[bodyReader, @stamp, sender,
IF case = owner THEN NIL ELSE returnTo];
IF stamp.time + maxReturnDays * 24 * LONG[60*60] < Time.Current[]
THEN BEGIN
HeapDefs.HeapAbandonWrite[list];
LogDiscard[stamp, sender];
END
ELSE BEGIN
textStart: HeapDefs.ObjectOffset =
HeapDefs.GetReaderOffset[bodyReader];
myName: BodyDefs.RName;
password: STRING;
dead: BodyDefs.RName = "DeadLetter.MS"L;
badReader: HeapDefs.ReaderHandle;
Start: PROC[validate: BOOLEAN] =
BEGIN
SELECT StartSend[handle: sendHandle, sender:myName,
senderPwd: password,
returnTo: dead, validate:validate] FROM
ok => NULL;
badReturnTo => ERROR NoDeadLetterRName[];
badSender, badPwd => ERROR MyNameIsWrong[];
allDown => ERROR LooksLikeImDown[] --silly: I’m not down!--;
ENDCASE => ERROR;
END;
[myName,password,] ← LocalNameDefs.ReadMSName[];
IF case = owner THEN AppendOwner[returnTo, group];
Start[TRUE];
AddRecipient[sendHandle,returnTo];
BEGIN
bad: BOOLEAN ← FALSE;
Notify: PROCEDURE[number:CARDINAL, who:STRING] =
BEGIN bad ← TRUE; END;
[] ← CheckValidity[sendHandle, Notify];
IF bad
THEN BEGIN
Abort[sendHandle];
returnTo.length ← 0;
String.AppendString[returnTo, dead];
Start[TRUE];
AddRecipient[sendHandle,returnTo];
bad ← FALSE;
[] ← CheckValidity[sendHandle, Notify];
IF bad THEN ERROR NoDeadLetterRName[];
END;
END;
StartText[sendHandle];
ws["Subject: Undelivered mail~From: "L];
ws[myName];
ws[" (a Grapevine mail server)~To: "L];
ws[returnTo];
ws["~Date: "L];
wt[Time.Current[]];
ws["~~The message sent by "L];
ws[sender];
ws[" at "L];
wt[LOOPHOLE[stamp.time]];
ws[" could not be delivered to the following recipients "L];
SELECT case FROM
user =>
ws["because their names are invalid."L];
owner =>
BEGIN
ws["because they are invalid names in the distribution list """L];
ws[group];
ws[""". Please remove them from that list."L];
END;
mtp =>
BEGIN
ws["because they were rejected by the MTP server """L];
ws[server]; ws[""". "L];
IF text = NIL
THEN ws["No reason was given."L]
ELSE { ws["The reason given was: "L]; ws[text] };
END;
longTerm =>
ws["within a reasonable time, because of network failures or the unavailability of other servers."L];
ENDCASE => ERROR;
ws["~~"L];
BEGIN
name: BodyDefs.RName = [BodyDefs.maxRNameLength];
ended: BOOLEAN;
GetReader: PROCEDURE[ obj: HeapDefs.ObjectNumber ] =
BEGIN badReader ← HeapDefs.HeapStartRead[obj]; END;
HeapDefs.HeapEndWrite[list, GetReader];
[ended] ← HeapDefs.HeapReadData[badReader,[name,0]];
UNTIL ended
DO ended ← HeapDefs.HeapReadRName[badReader,name];
badCount ← badCount + 1;
ws[name]; IF NOT ended THEN ws[", "L];
ENDLOOP;
END;
ws["~~"L];
IF case = owner
THEN FlushWS[]
ELSE BEGIN
IF textLength > 0
THEN BEGIN
SillySend: PROCEDURE[u:UNSPECIFIED, p:POINTER, c:CARDINAL] =
{ AddToItem[u,DESCRIPTOR[p,c]] };
ws["----------------~~"L];
IF wsBuffer.length MOD 2 # 0 THEN ws["~"L];
FlushWS[];
CopyItem[bodyReader, textLength, SillySend, sendHandle];
END
ELSE { ws["There was no message text."L]; FlushWS[] };
END;
LogReturn[stamp, returnTo, badCount];
Send[sendHandle];
BEGIN
-- Send summary to DeadLetter.ms --
Start[FALSE];
AddRecipient[sendHandle,dead];
StartText[sendHandle];
ws["Subject: Undelivered mail notification~From: "L];
ws[myName];
ws["~To: "L];
ws[dead];
ws["~Date: "L];
wt[Time.Current[]];
ws["~~Reason: "L];
ws[SELECT case FROM
user => "Invalid recipients(s)"L,
owner => "Invalid recipients(s) in DL"L,
mtp => "Name(s) rejected by MTP server"L,
longTerm => "Message time-out"L,
ENDCASE => ERROR];
ws["~Notification sent to: "L];
ws[returnTo];
ws["~Original postmark: "L];
wt[LOOPHOLE[stamp.time]];
ws[" = "L];
{s:STRING = [18]; ProtocolDefs.AppendTimestamp[s,stamp]; ws[s]};
ws["~Sender: "L]; ws[sender];
SELECT case FROM
user => NULL;
owner => { ws["~Group: "L]; ws[group] };
mtp => { ws["~MTP host: "L]; ws[server];
ws["~MTP complaint: "L];
ws[IF text = NIL THEN "none"L ELSE text] };
longTerm => NULL;
ENDCASE => ERROR;
ws["~Undeliverable recipient(s): "L];
HeapDefs.SetReaderOffset[badReader, HeapDefs.objectStart];
FOR i: CARDINAL IN [1..badCount]
DO name: BodyDefs.RName = [BodyDefs.maxRNameLength];
IF i # 1 THEN ws[", "L];
[] ← HeapDefs.HeapReadRName[badReader,name]; ws[name];
ENDLOOP;
IF textLength > 0
THEN BEGIN
length: BodyDefs.ItemLength ← textLength;
crSeen: BOOLEAN ← FALSE; -- end on double CR --
ws["~Text header:~~"L];
HeapDefs.SetReaderOffset[bodyReader, textStart];
WHILE length > 0
DO buff: STRING = [64];
wanted: CARDINAL = IF buff.maxlength < length
THEN buff.maxlength
ELSE Inline.LowHalf[length];
[] ← HeapDefs.HeapReadData[bodyReader,
[@buff.text,(wanted+1)/2]];
length ← length - wanted;
buff.length ← wanted;
FOR i: CARDINAL IN [0..buff.length)
DO IF buff[i] = Ascii.CR
THEN{ IF crSeen
THEN{ buff.length ← i; ws[buff]; GOTO ended }
ELSE crSeen ← TRUE }
ELSE crSeen ← FALSE;
ENDLOOP;
ws[buff];
REPEAT ended => NULL;
ENDLOOP;
END
ELSE ws["~No text~"L];
FlushWS[];
Send[sendHandle];
END;
HeapDefs.HeapEndRead[badReader];
END;
HeapDefs.HeapEndRead[bodyReader];
Destroy[sendHandle];
END;

LogDiscard: PROC[stamp: BodyDefs.Timestamp, sender: BodyDefs.RName] =
BEGIN
len: CARDINAL = sender.length;
log: STRING = [128];
String.AppendString[log, "Discarded undeliverable msg "L];
ProtocolDefs.AppendTimestamp[log, stamp ];
String.AppendString[log, " because of extreme age. Sender="L];
sender.length ← MIN[len, log.maxlength - log.length];
String.AppendString[log, sender];
sender.length ← len;
LogDefs.WriteLogEntry[log];
END;

LogReturn: PROC[stamp: BodyDefs.Timestamp, returnTo: BodyDefs.RName,
badCount: CARDINAL] =
BEGIN
len: CARDINAL = returnTo.length;
log: STRING = [128];
String.AppendString[log, "Returned "L];
ProtocolDefs.AppendTimestamp[log, stamp ];
String.AppendString[log, " to "L];
returnTo.length ← MIN[len, log.maxlength - log.length - 10];
String.AppendString[log, returnTo];
returnTo.length ← len;
String.AppendString[log, ": "L];
String.AppendDecimal[log, badCount];
String.AppendString[log, " bad"L];
LogDefs.WriteLogEntry[log];
END;

END.