-- Copyright (C) 1981, 1982, 1983, 1984, 1985 by Xerox Corporation. All rights reserved.
-- ReturnMail.mesa, Transport Mechanism Mail Server - Return Undeliverable Mail --
-- HGM, 15-Sep-85 3:41:57
-- Randy Gobbel 19-May-81 23:38:50 --
-- Andrew Birrell 4-Mar-82 14:42:33 --
-- Michael Schroeder 25-Jan-83 15:54:32 --
DIRECTORY
Ascii USING [CR],
BodyDefs USING [ItemHeader, ItemLength, maxRNameLength, RName, Timestamp],
Heap USING [systemZone],
HeapDefs USING [
GetReaderOffset, HeapAbandonWrite, HeapEndRead, HeapEndWrite, HeapReadData,
HeapReadRName, HeapStartRead, ObjectNumber, ObjectOffset, objectStart,
ReaderHandle, SetReaderOffset, WriterHandle],
Inline USING [LowHalf],
LocalNameDefs USING [ReadMSName],
LogDefs USING [ShowLine],
NameInfoDefs USING [IsMemberDirect, Membership],
ProtocolDefs USING [AppendTimestamp],
ReturnDefs USING [],
SendDefs USING [
Abort, AddRecipient, AddToItem, Create, Destroy, CheckValidity, Handle,
StartSend, StartText, Send],
String USING [AppendChar, AppendDecimal, AppendNumber, AppendString],
Time USING [Append, Current, Packed, Unpack],
VMDefs USING [AllocatePage, Page, pageSize, Release];
ReturnMail: PROGRAM
IMPORTS
Heap, HeapDefs, Inline, LocalNameDefs, LogDefs, NameInfoDefs, 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 [SendDefs.Handle, LONG POINTER, CARDINAL],
sendBlockData: SendDefs.Handle] =
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: LONG STRING, group: LONG 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]};
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, longTerm}, group: BodyDefs.RName,
server, text: LONG STRING] =
BEGIN OPEN SendDefs;
bodyReader: HeapDefs.ReaderHandle = HeapDefs.HeapStartRead[body];
sendHandle: Handle = Create[];
wsBuffer: STRING = [64];
ws: PROCEDURE [s: LONG 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: LONG 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: LONG 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;
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: SendDefs.Handle, p: LONG 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
who: LONG STRING ← "GGWMsgs↑.MS";
IF case # user OR Filter[stamp] THEN who ← dead;
Start[FALSE];
AddRecipient[sendHandle, who];
StartText[sendHandle];
ws["Subject: Undelivered mail notification~From: "L];
ws[myName];
ws["~To: "L];
ws[who];
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,
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]};
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;
-- Hack to filter out crap because GGW injects invalid recipients
Filter: PROC [stamp: BodyDefs.Timestamp] RETURNS [go: BOOLEAN] =
BEGIN
group: BodyDefs.RName = "GGWFilter↑.MS"L;
source: STRING = [8];
m: NameInfoDefs.Membership;
String.AppendNumber[source, stamp.net, 8];
String.AppendChar[source, '#];
String.AppendNumber[source, stamp.host, 8];
String.AppendChar[source, '#];
m ← NameInfoDefs.IsMemberDirect[group, source];
IF m = yes THEN RETURN[FALSE];
RETURN[TRUE];
END;
LogDiscard: PROC [stamp: BodyDefs.Timestamp, sender: BodyDefs.RName] =
BEGIN
len: CARDINAL = sender.length;
log: LONG STRING ← Heap.systemZone.NEW[StringBody[128]];
String.AppendString[log, "Discarded old "L];
ProtocolDefs.AppendTimestamp[log, stamp];
String.AppendString[log, " Sender="L];
sender.length ← MIN[len, log.maxlength - log.length];
String.AppendString[log, sender];
sender.length ← len;
LogDefs.ShowLine[log];
Heap.systemZone.FREE[@log];
END;
LogReturn: PROC [
stamp: BodyDefs.Timestamp, returnTo: BodyDefs.RName, badCount: CARDINAL] =
BEGIN
len: CARDINAL = returnTo.length;
log: LONG STRING ← Heap.systemZone.NEW[StringBody[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.ShowLine[log];
Heap.systemZone.FREE[@log];
END;
END.