-- Copyright (C) 1983 by Xerox Corporation. All rights reserved.
-- MailerGV.mesa, HGM, 15-Dec-83 18:24:00
DIRECTORY
Ascii USING [CR, SP, TAB],
Heap USING [Create, Delete],
String USING [AppendString, AppendChar, Equivalent, AppendNumber],
Time USING [Append, Unpack, Unpacked],
Mailer USING [Level],
PupDefs USING [AppendMyName],
SendDefs USING [
AddRecipient, AddToItem, CheckValidity, Create, Destroy, Handle, Send,
SendFailed, StartSend, StartText];
MailerGV: PROGRAM
IMPORTS Heap, String, Time, PupDefs, SendDefs EXPORTS Mailer =
BEGIN
SendGVMail: PUBLIC PROCEDURE [
subject, to, cc, body, troubles: LONG STRING,
info: PROCEDURE [s: LONG STRING, level: Mailer.Level]]
RETURNS [worked: BOOLEAN] =
BEGIN
handle: SendDefs.Handle;
recipients, rejections: CARDINAL ← 0;
nameList, nameListTail: NameHandle ← NIL;
z: UNCOUNTED ZONE = Heap.Create[4];
SendHeaderLine: PROCEDURE [field, contents: LONG STRING] =
BEGIN
IF contents = NIL OR contents.length = 0 THEN RETURN;
SendDefs.AddToItem[
handle, [LOOPHOLE[@field.text, LONG POINTER], 0, field.length]];
SendDefs.AddToItem[
handle, [LOOPHOLE[@contents.text, LONG POINTER], 0, contents.length]];
SendCR[];
END;
SendDateLine: PROCEDURE =
BEGIN
days: ARRAY [0..7) OF STRING = [
"Monday"L, "Tuesday"L, "Wednesday"L, "Thursday"L, "Friday"L, "Saturday"L,
"Sunday"L];
date: STRING = [40];
now: Time.Unpacked = Time.Unpack[];
Time.Append[date, now, TRUE];
String.AppendString[date, " ("L];
String.AppendString[date, days[now.weekday]];
String.AppendChar[date, ')];
SendHeaderLine["Date: "L, date];
END;
SendFromLine: PROCEDURE =
BEGIN
temp: STRING = [200];
PupDefs.AppendMyName[temp];
String.AppendString[temp, ".internet"L];
SendHeaderLine["From: "L, temp];
END;
SendCR: PROCEDURE =
BEGIN
endOfLine: STRING ← [1];
endOfLine.length ← 1;
endOfLine[0] ← Ascii.CR;
SendDefs.AddToItem[
handle, [LOOPHOLE[@endOfLine.text, POINTER], 0, endOfLine.length]];
END;
NameHandle: TYPE = LONG POINTER TO Name;
Name: TYPE = RECORD [next: NameHandle, name: LONG STRING];
AddName: PROCEDURE [name: LONG STRING] =
BEGIN
p: NameHandle;
FOR p ← nameList, p.next UNTIL p = NIL DO
IF String.Equivalent[p.name, name] THEN RETURN; ENDLOOP;
FOR i: CARDINAL IN [0..name.length) DO
IF name[i] = '. THEN EXIT;
REPEAT
FINISHED =>
BEGIN OPEN String;
s: STRING ← [200];
AppendString[s, "MailerGV: Registry missing: "L];
AppendString[s, name];
info[s, rejection];
RETURN;
END;
ENDLOOP;
recipients ← recipients + 1;
p ← z.NEW[Name];
p↑ ← [NIL, z.NEW[StringBody[name.length]] ];
String.AppendString[p.name, name];
IF nameList = NIL THEN nameList ← p ELSE nameListTail.next ← p;
nameListTail ← p;
END;
SendRecipientList: PROCEDURE =
BEGIN
FOR recipient: NameHandle ← nameList, recipient.next UNTIL recipient = NIL
DO
SendDefs.AddRecipient[handle, recipient.name];
ENDLOOP;
END;
CheckForRejections: PROCEDURE =
BEGIN
Complain: PROCEDURE [n: CARDINAL, who: LONG STRING] =
BEGIN
s: STRING = [100];
String.AppendString[s, "MailerGV: Invalid recipient: "L];
String.AppendString[s, who];
info[s, rejection];
rejections ← rejections + 1;
END;
recipients ← SendDefs.CheckValidity[handle, Complain];
END;
FindUsers: PROCEDURE [names: LONG STRING] =
BEGIN
name: STRING = [100];
NextName: PROCEDURE =
BEGIN
WHILE name.length > 0 AND name[name.length - 1] = Ascii.SP DO
name.length ← name.length - 1; ENDLOOP;
IF name.length > 0 THEN AddName[name];
name.length ← 0;
END;
FOR i: CARDINAL IN [0..names.length) DO
c: CHARACTER ← names[i];
SELECT c FROM
', => NextName[];
ENDCASE =>
IF c # Ascii.SP AND c # Ascii.TAB AND c # Ascii.CR THEN
String.AppendChar[name, c];
ENDLOOP;
NextName[];
END;
FreeNames: PROCEDURE =
BEGIN
next: NameHandle;
UNTIL nameList = NIL DO
next ← nameList.next;
z.FREE[@nameList.name];
z.FREE[@nameList];
nameList ← next;
ENDLOOP;
END;
TellHimItWorked: PROCEDURE =
BEGIN
temp: STRING = [100];
String.AppendString[temp, "MailerGV: Sent it"L];
String.AppendString[temp, " to "L];
String.AppendNumber[temp, recipients, 10];
String.AppendString[temp, " reciepient"L];
IF recipients # 1 THEN String.AppendString[temp, "s"L];
IF rejections # 0 THEN
BEGIN
String.AppendString[temp, ", but there were "L];
String.AppendNumber[temp, rejections, 10];
String.AppendString[temp, " rejections"L];
END;
info[temp, ok];
END;
-- Here begins the real thing
worked ← FALSE;
FindUsers[to];
IF cc # NIL THEN FindUsers[cc];
IF nameList = NIL THEN
BEGIN
info["MailerGV: No recipients in to or cc list"L, trouble];
RETURN;
END;
handle ← SendDefs.Create[];
FOR tries: CARDINAL IN [0..4) DO
ENABLE
SendDefs.SendFailed =>
BEGIN info["MailerGV: Send Failed"L, trouble]; CONTINUE; END;
SELECT SendDefs.StartSend[handle, "Portola"L, "PupGateway.auto"L, troubles, TRUE] FROM
ok => NULL;
badPwd => GOTO BadPassword;
badSender => GOTO BadSender;
badReturnTo => GOTO BadTroubles;
allDown => GOTO AllDown;
ENDCASE => GOTO Mixup;
SendRecipientList[];
CheckForRejections[];
IF recipients = 0 THEN GOTO NoValidRecipients;
SendDefs.StartText[handle];
SendDateLine[];
SendFromLine[];
SendHeaderLine["Subject: "L, subject];
SendHeaderLine["To: "L, to];
SendHeaderLine["cc: "L, cc];
SendHeaderLine["Reply-To: "L, troubles];
-- A blank line separates header from body
SendCR[];
SendDefs.AddToItem[
handle, [LOOPHOLE[@body.text, LONG POINTER], 0, body.length]];
SendCR[];
SendDefs.Send[handle];
TellHimItWorked[];
worked ← TRUE;
EXIT;
REPEAT
Mixup => info["MailerGV: Mixup someplace"L, trouble];
BadPassword => info["MailerGV: Invalid Sender password; Call GrapevineWizard"L, trouble];
BadSender => info["MailerGV: Sender rejected; Call GrapevineWizard"L, trouble];
BadTroubles => info["MailerGV: ReturnTo rejected"L, trouble];
AllDown => info["MailerGV: All Servers appear to be down"L, trouble];
NoValidRecipients => info["MailerGV: No valid recipients"L, trouble];
FINISHED => info["MailerGV: Too many retries"L, trouble];
ENDLOOP;
SendDefs.Destroy[handle];
FreeNames[];
Heap.Delete[z];
END;
END.