-- File: MailerMTP.mesa,  Last Edit: HGM  March 24, 1981  1:08 PM

DIRECTORY
  Ascii USING [CR, SP, TAB],
  Storage USING [Node, String, Free, FreeString, CopyString],
  String USING [AppendString, AppendChar, EquivalentString, AppendNumber],
  Time USING [AppendCurrent],

  Mailer USING [Level],
  PupDefs USING [AppendMyName],
  FTPDefs USING [
    FTPBeginDeliveryOfMessage, FTPCloseConnection, FTPCreateUser, FTPDestroyUser,
    FTPEndDeliveryOfMessage, FTPError, FTPFinalize, FTPSetCredentials,
    FTPIdentifyNextRejectedRecipient, FTPInitialize, FTPOpenConnection,
    FTPSendBlockOfMessage, FTPSendRecipientOfMessage, FTPUser,
    PupCommunicationPrimitives];

MailerMTP: PROGRAM IMPORTS Storage, String, Time, PupDefs, FTPDefs
  EXPORTS Mailer =
  BEGIN

  SendMailViaMTP: PUBLIC PROCEDURE [
    from, subject, to, cc: STRING, body: LONG STRING,
    sender, password: STRING,
    info: PROCEDURE [s: STRING, level: Mailer.Level]]
    RETURNS [worked: BOOLEAN] =
    BEGIN OPEN FTPDefs;

    -- This is the list of mail servers to try.
    nMailServers: CARDINAL = 11;
    mailServerNames: ARRAY [0..nMailServers) OF STRING = [
      "Erie"L,  -- Webster
      "Aklak"L,  -- Toronto
      "Aztec"L,  -- Henrietta
      "Wind"L,  -- El Segundo
      "Maxc"L,  -- Palo Alto
      "Calypso"L,  -- Leesburg
      "Eagle"L,  -- Stamford
      "RoseBowl"L,  -- Pasadena
      "Cactus"L,  -- Dallas
      "Rank"L,  -- Sweden
      "Jaws"L];  -- England

    ftpUser: FTPUser _ NIL;
    recipients, rejections: CARDINAL _ 0;
    nameList, nameListTail: NameHandle _ NIL;
    mailServerIndex: CARDINAL;

    SendHeaderLine: PROCEDURE [field, contents: STRING] =
      BEGIN
      IF contents = NIL OR contents.length = 0 THEN RETURN;
      FTPSendBlockOfMessage[ftpUser, @field.text, field.length];
      FTPSendBlockOfMessage[ftpUser, @contents.text, contents.length];
      SendCR[];
      END;

    SendDateLine: PROCEDURE =
      BEGIN
      date: STRING = [30];
      Time.AppendCurrent[date, TRUE];
      SendHeaderLine["Date: "L, date];
      END;

    SendFromLine: PROCEDURE =
      BEGIN
      temp: STRING = [200];
      String.AppendString[temp, from];
      String.AppendString[temp, " on "L];
      PupDefs.AppendMyName[temp];
      String.AppendString[temp, " (via "L];
      String.AppendString[temp, mailServerNames[mailServerIndex]];
      String.AppendString[temp, ")"L];
      SendHeaderLine["From: "L, temp];
      END;

    SendCR: PROCEDURE =
      BEGIN
      endOfLine: STRING _ [1];
      endOfLine.length _ 1;
      endOfLine[0] _ Ascii.CR;
      FTPSendBlockOfMessage[ftpUser, @endOfLine.text, endOfLine.length];
      END;

    SendLongString: PROCEDURE [s: LONG STRING] =
      BEGIN
      max: CARDINAL = 200;
      temp: PACKED ARRAY [0..max) OF CHARACTER;
      i, k: CARDINAL;
      k _ 0;
      FOR i IN [0..s.length) DO
        temp[k] _ s[i];
        k _ k + 1;
        IF k = max THEN
          BEGIN FTPSendBlockOfMessage[ftpUser, @temp, k]; k _ 0; END;
        ENDLOOP;
      IF k # 0 THEN FTPSendBlockOfMessage[ftpUser, @temp, k];
      END;

    NameHandle: TYPE = POINTER TO Name;
    Name: TYPE = RECORD [next: NameHandle, name: STRING];

    AddName: PROCEDURE [name: STRING] =
      BEGIN
      p: NameHandle;
      FOR p _ nameList, p.next UNTIL p = NIL DO
        IF String.EquivalentString[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, "MailerMTP: Registry missing: "L];
            AppendString[s, name];
            IF info # NIL THEN info[s, rejection];
            RETURN;
            END;
        ENDLOOP;
      recipients _ recipients + 1;
      p _ Storage.Node[SIZE[Name]];
      p^ _ [NIL, Storage.CopyString[name]];
      IF nameList = NIL THEN nameList _ p ELSE nameListTail.next _ p;
      nameListTail _ p;
      END;

    SendRecipientList: PROCEDURE =
      BEGIN
      recipient: NameHandle;
      recipients _ rejections _ 0;
      FOR recipient _ nameList, recipient.next UNTIL recipient = NIL DO
        recipients _ recipients + 1;
        FTPSendRecipientOfMessage[ftpUser, recipient.name];
        ENDLOOP;
      END;

    CheckForRejections: PROCEDURE =
      BEGIN
      n, errorCount: CARDINAL _ 0;
      name: NameHandle;
      THROUGH [0..recipients) DO
        why: STRING = [100];
        n _ FTPIdentifyNextRejectedRecipient[ftpUser, why].recipientNumber;
        IF n = 0 THEN EXIT;
        recipients _ recipients - 1;
        rejections _ rejections + 1;
        FOR name _ nameList, name.next UNTIL name = NIL OR (n _ n - 1) = 0 DO
          ENDLOOP;
        IF name # NIL THEN
          BEGIN OPEN String;
          s: STRING _ [200];
          AppendString[s, "MailerMTP: Bad recipient: "L];
          AppendString[s, name.name];
          AppendString[s, " - "L];
          AppendString[s, why];
          IF info # NIL THEN info[s, rejection];
          END;
        ENDLOOP;
      END;

    FindUsers: PROCEDURE [names: STRING] =
      BEGIN
      name: STRING _ Storage.String[30];
      pos: CARDINAL _ 0;
      c: CHARACTER;
      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;
      WHILE pos < names.length DO
        c _ names[pos];
        pos _ pos + 1;
        SELECT c FROM
          ', => NextName[];
          ENDCASE =>
            IF c # Ascii.SP AND c # Ascii.TAB AND c # Ascii.CR THEN
              String.AppendChar[name, c];
        ENDLOOP;
      NextName[];
      Storage.FreeString[name];
      END;

    FreeNames: PROCEDURE =
      BEGIN
      next: NameHandle;
      UNTIL nameList = NIL DO
        next _ nameList.next;
        Storage.FreeString[nameList.name];
        Storage.Free[nameList];
        nameList _ next;
        ENDLOOP;
      END;

    TellHimItWorked: PROCEDURE =
      BEGIN
      temp: STRING = [100];
      String.AppendString[temp, "MailerMTP: Sent it"L];
      String.AppendString[temp, " (via "L];
      String.AppendString[temp, mailServerNames[mailServerIndex]];
      String.AppendString[temp, ")"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;
      String.AppendString[temp, "."L];
      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["MailerMTP: No recipients in to or cc list."L, trouble];
      RETURN;
      END;

    FTPInitialize[];
    ftpUser _ FTPCreateUser[NIL, PupCommunicationPrimitives[]];
    FTPSetCredentials[ftpUser, primary, sender, password];
    FOR mailServerIndex IN [0..nMailServers) DO
      ENABLE
        FTPError =>
          BEGIN
          temp: STRING = [100];
          String.AppendString[temp, "MailerMTP: Can't send it via "L];
          String.AppendString[temp, mailServerNames[mailServerIndex]];
          IF message # NIL THEN
            BEGIN
            String.AppendString[temp, ": "L];
            String.AppendString[temp, message];
            END;
          String.AppendChar[temp, '.];
          info[temp, trouble];
          CONTINUE;
          END;
      IF mailServerNames[mailServerIndex] = NIL THEN LOOP;
      FTPCloseConnection[ftpUser];  -- can't close it in CATCH phrase
      FTPOpenConnection[
        ftpUser, mailServerNames[mailServerIndex], mail, NIL ! FTPError => LOOP];
      FTPBeginDeliveryOfMessage[ftpUser];
      SendRecipientList[];
      CheckForRejections[];
      IF recipients = 0 THEN GOTO NoValidRecipients;
      SendDateLine[];
      SendFromLine[];
      SendHeaderLine["Subject: "L, subject];
      SendHeaderLine["To: "L, to];
      SendHeaderLine["cc: "L, cc];
      -- A blank line separates header from body
      SendCR[];
      SendLongString[body];
      SendCR[];
      CheckForRejections[];
      IF recipients = 0 THEN GOTO NoValidRecipients;
      FTPEndDeliveryOfMessage[ftpUser];
      FTPCloseConnection[ftpUser];
      TellHimItWorked[];
      worked _ TRUE;
      EXIT;
      REPEAT
        NoValidRecipients => info["MailerMTP: No valid recipients."L, trouble];
        FINISHED => info["MailerMTP: No mail server responded."L, trouble];
      ENDLOOP;

    FreeNames[];
    FTPDestroyUser[ftpUser];
    FTPFinalize[];

    END;


  END.