-- 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.