-- Copyright (C) 1981, 1983, 1984, 1985  by Xerox Corporation. All rights reserved. 
-- CreateMail.mesa, HGM, 19-Mar-86 20:01:50

-- Transport Mechanism Mail Server - Create mail from user --

-- Randy Gobbel		19-May-81 21:21:39 --
-- Andrew Birrell	 1-Apr-81 14:54:01 --
-- Mike Schroeder	25-Jan-83 16:18:46 --

DIRECTORY
  BodyDefs USING [
    ItemHeader, ItemLength, ItemType, maxRNameLength, Password, RName, RNameSize,
    Timestamp],
  Heap USING [systemZone],
  HeapDefs USING [
    GetWriterOffset, HeapAbandonWrite, HeapEndRead, HeapEndWrite, HeapReadData,
    HeapReadRName, HeapStartRead, HeapStartWrite, HeapWriteData, HeapWriteRName,
    ObjectNumber, ObjectOffset, ReaderHandle, ReadRList, SetWriterOffset,
    WriterHandle],
  LogDefs USING [WriteChar, WriteLogEntry],
  NameInfoDefs USING [Close, Enumerate, IsMemberDirect, IsOwnerDirect],
  ProtocolDefs USING [AppendTimestamp, MakeKey],
  PupDefs USING [PupAddress, PupNameLookup, PupPackageMake],
  SendDefs USING [ExpandInfo, StartSendInfo],
  SiteCacheDefs USING [FindMBXSite, RecipientInfo, ValidateRName],
  SLDefs USING [SLHeader, SLWrite],
  String USING [AppendDecimal, AppendLongDecimal, AppendString],
  Time USING [Current];

CreateMail: MONITOR LOCKS handle USING handle: Handle
  IMPORTS
    BodyDefs, Heap, HeapDefs, LogDefs, NameInfoDefs, PupDefs, ProtocolDefs,
    SiteCacheDefs, SLDefs, String, Time
  EXPORTS SendDefs =

  BEGIN

  RNameFromString: PROCEDURE [s: LONG STRING] RETURNS [BOOLEAN] =
    BEGIN RETURN[IF s.length > BodyDefs.maxRNameLength THEN FALSE ELSE TRUE] END;

  LogStart: PROCEDURE [handle: Handle, sender: LONG STRING] =
    BEGIN
    log: LONG STRING ¬ Heap.systemZone.NEW[StringBody[128]];
    String.AppendString[log, "Created   "L];
    ProtocolDefs.AppendTimestamp[log, handle.stamp];
    String.AppendString[log, ": sender "L];
    String.AppendString[log, sender];
    LogDefs.WriteLogEntry[log];
    Heap.systemZone.FREE[@log];
    END;

  LogCommit: PROCEDURE [handle: Handle] =
    BEGIN
    log: LONG STRING ¬ Heap.systemZone.NEW[StringBody[128]];
    String.AppendString[log, "Client input: "L];
    ProtocolDefs.AppendTimestamp[log, handle.stamp];
    String.AppendString[log, ", "L];
    String.AppendDecimal[log, handle.validRecipients];
    String.AppendString[log, " recipients, "L];
    String.AppendLongDecimal[log, HeapDefs.GetWriterOffset[handle.body]];
    String.AppendString[log, " words"L];
    IF handle.express THEN String.AppendString[log, ", express"L];
    IF handle.moderated THEN String.AppendString[log, ", moderated"L];
    LogDefs.WriteLogEntry[log];
    Heap.systemZone.FREE[@log];
    LogDefs.WriteChar[IF handle.express THEN 'E ELSE 'C];
    END;

  LogAbort: PROCEDURE [handle: Handle] =
    BEGIN
    log: LONG STRING ¬ Heap.systemZone.NEW[StringBody[128]];
    String.AppendString[log, "Abandoned "L];
    ProtocolDefs.AppendTimestamp[log, handle.stamp];
    LogDefs.WriteLogEntry[log];
    Heap.systemZone.FREE[@log];
    END;


  Handle: PUBLIC TYPE = LONG POINTER TO HandleObject;

  HandleObject: TYPE = MONITORED RECORD [
    body, SL, bad: HeapDefs.WriterHandle,
    validate: BOOLEAN,
    state: {idle, starting, inItem, dead},
    header: BodyDefs.ItemHeader,
    itemStart: HeapDefs.ObjectOffset,
    stamp: BodyDefs.Timestamp,
    recipientCount: CARDINAL,
    validRecipients: CARDINAL,
    sender: BodyDefs.RName,
    express, moderated: BOOLEAN];

  WrongCallSequence: ERROR = CODE;

  -- Defined only to satisfy the Defs. It is not signalled --
  SendFailed: PUBLIC ERROR [notDelivered: BOOLEAN] = CODE;

  Create: PUBLIC PROCEDURE RETURNS [handle: Handle] =
    BEGIN
    handle ¬ Heap.systemZone.NEW[HandleObject];
    handle.state ¬ idle;
    handle.sender ¬ Heap.systemZone.NEW[StringBody[BodyDefs.maxRNameLength]];
    END;

  Destroy: PUBLIC PROCEDURE [handle: Handle] =
    BEGIN Abort[handle]; handle.state ¬ dead; Heap.systemZone.FREE[@handle]; END;

  validationOn: BOOLEAN ¬ TRUE;  -- debugging facility--
  validateSender: BOOLEAN ¬ TRUE;  -- debugging facility--

  StartSend: PUBLIC PROCEDURE [
    handle: Handle, senderPwd: LONG STRING, sender: BodyDefs.RName,
    returnTo: BodyDefs.RName ¬ NIL, validate: BOOLEAN]
    RETURNS [info: SendDefs.StartSendInfo] =
    BEGIN
    info ¬ SendFromClient[
      handle, 0, 0, ProtocolDefs.MakeKey[senderPwd], sender,
      IF returnTo = NIL THEN sender ELSE returnTo, validate];
    END;

  SendFromClient: PUBLIC ENTRY PROCEDURE [
    handle: Handle, fromNet: [0..256), fromHost: [0..256),
    senderKey: BodyDefs.Password,  --ignored--
    sender, returnTo: BodyDefs.RName, validate: BOOLEAN]
    RETURNS [info: SendDefs.StartSendInfo] =
    BEGIN
    header: BodyDefs.ItemHeader;
    WriteHeader: PROCEDURE =
      BEGIN
      HeapDefs.HeapWriteData[handle.body, [@header, SIZE[BodyDefs.ItemHeader]]];
      END;
    IF handle.state # idle THEN ERROR WrongCallSequence[];
    handle.state ¬ starting;
    handle.SL ¬ HeapDefs.HeapStartWrite[SLinput];
    handle.body ¬ HeapDefs.HeapStartWrite[body];
    handle.bad ¬ NIL;
    handle.validate ¬ validate;
    handle.sender.length ¬ 0;
    handle.express ¬ FALSE;
    handle.moderated ¬ FALSE;

    info ¬ ok;

    IF fromHost = 0 THEN BEGIN fromNet ¬ myName.net; fromHost ¬ myName.host; END;

    -- postmark --
    BEGIN
    stamp: BodyDefs.Timestamp;
    header.type ¬ PostMark;
    header.length ¬ 2 * SIZE[BodyDefs.Timestamp];
    WriteHeader[];
    stamp.net ¬ fromNet;
    stamp.host ¬ fromHost;
    stamp.time ¬ Time.Current[];
    handle.stamp ¬ stamp;
    HeapDefs.HeapWriteData[handle.body, [@stamp, SIZE[BodyDefs.Timestamp]]];
    END;

    -- sender --
    BEGIN
    header.type ¬ Sender;
    IF NOT RNameFromString[sender]
      OR (validateSender AND NOT SiteCacheDefs.ValidateRName[sender]) THEN
      BEGIN header.length ¬ 0; WriteHeader[]; info ¬ badSender; END
    ELSE
      BEGIN
      header.length ¬ BodyDefs.RNameSize[sender] * 2;
      WriteHeader[];
      HeapDefs.HeapWriteRName[handle.body, sender];
      IF handle.sender.length <= handle.sender.maxlength THEN
        String.AppendString[handle.sender, sender];
      END;
    END;

    -- return-to --
    BEGIN
    header.type ¬ ReturnTo;
    IF NOT RNameFromString[returnTo]
      OR (validateSender AND NOT SiteCacheDefs.ValidateRName[returnTo]) THEN
      BEGIN
      header.length ¬ 0;
      WriteHeader[];
      IF info = ok THEN info ¬ badReturnTo;
      END
    ELSE
      BEGIN
      header.length ¬ BodyDefs.RNameSize[returnTo] * 2;
      WriteHeader[];
      HeapDefs.HeapWriteRName[handle.body, returnTo];
      END;
    END;


    -- recipients --
    BEGIN
    handle.recipientCount ¬ handle.validRecipients ¬ 0;
    handle.header.type ¬ Recipients;
    handle.header.length ¬ 0;
    handle.itemStart ¬ HeapDefs.GetWriterOffset[handle.body];
    header.type ¬ Recipients;
    header.length ¬ 0;  -- fix up later --
    WriteHeader[];
    END;

    -- Write SL header --
    BEGIN
    -- SL header --
    slHeader: SLDefs.SLHeader;
    slHeader.server ¬ NIL;
    slHeader.created ¬ handle.stamp;
    slHeader.received.host ¬ 0;
    slHeader.received.net ¬ 0;
    slHeader.received.time ¬ handle.stamp.time;
    HeapDefs.HeapWriteData[handle.SL, [@slHeader, SIZE[SLDefs.SLHeader]]];
    END;

    LogStart[handle, sender];

    IF info # ok THEN InnerAbort[handle];

    END --StartSend-- ;


  expressRecipients: CARDINAL ¬ 50;

  AddRecipient: PUBLIC ENTRY PROCEDURE [
    handle: Handle, recipient: BodyDefs.RName] =
    BEGIN
    IF handle.state # starting THEN ERROR WrongCallSequence[];
    handle.recipientCount ¬ handle.recipientCount + 1;
    SELECT TRUE FROM
      handle.validate AND validationOn
      AND
        (NOT RNameFromString[recipient]
          OR NOT SiteCacheDefs.ValidateRName[recipient]) =>
      BEGIN
      genuine: CARDINAL = recipient.length;
      recipient.length ¬ MIN[recipient.length, BodyDefs.maxRNameLength];
      IF handle.bad = NIL THEN handle.bad ¬ HeapDefs.HeapStartWrite[temp];
      HeapDefs.HeapWriteData[
        handle.bad, [@(handle.recipientCount), SIZE[CARDINAL]]];
      HeapDefs.HeapWriteRName[handle.bad, recipient];
      recipient.length ¬ genuine;
      END;
    NeedsModerating[handle, recipient] =>
      BEGIN
      moderator: BodyDefs.RName = [20 + BodyDefs.maxRNameLength];
      String.AppendString[moderator, "Owner-"];
      String.AppendString[moderator, recipient];
      moderator.length ¬ MIN[moderator.length, BodyDefs.maxRNameLength];
      handle.validRecipients ¬ handle.validRecipients + 1;
      HeapDefs.HeapWriteRName[handle.SL, moderator];
      END;
    ENDCASE =>
      BEGIN
      genuine: CARDINAL = recipient.length;
      recipient.length ¬ MIN[recipient.length, BodyDefs.maxRNameLength];
      handle.validRecipients ¬ handle.validRecipients + 1;
      IF handle.validRecipients > expressRecipients THEN handle.express ¬ TRUE;
      -- Writing recipient names into message body disabled until Laurel 6.
      --        handle.header.length ¬
      --           handle.header.length + 2*BodyDefs.RNameSize[recipient];
      --        HeapDefs.HeapWriteRName[handle.body, recipient];
      HeapDefs.HeapWriteRName[handle.SL, recipient];
      recipient.length ¬ genuine;
      CheckExpressMail[handle, recipient];
      END;
    END --AddRecipient-- ;

  NeedsModerating: INTERNAL PROC [handle: Handle, recipient: BodyDefs.RName] RETURNS [BOOL] =
    BEGIN
    FOR i: CARDINAL DECREASING IN [0..recipient.length) DO
      IF recipient[i] = '. THEN
        BEGIN
        IF i = 0 OR recipient[i - 1] # '^ THEN RETURN[FALSE];
        IF NameInfoDefs.IsMemberDirect["Moderated^.ms"L, recipient] # yes THEN RETURN[FALSE];
        IF NameInfoDefs.IsOwnerDirect[recipient, handle.sender] = yes THEN RETURN[FALSE];
        handle.moderated ¬ TRUE;
        RETURN[TRUE];
        END;
      ENDLOOP;
    RETURN[FALSE];  -- Humm. No dot??
    END;

  CheckExpressMail: INTERNAL PROC [handle: Handle, recipient: BodyDefs.RName] =
    BEGIN
    IF NOT handle.express THEN
      FOR i: CARDINAL DECREASING IN [0..recipient.length) DO
        IF recipient[i] = '. THEN
          BEGIN
          IF i > 0 AND recipient[i - 1] = '^ THEN
            IF NameInfoDefs.IsMemberDirect["ExpressMail^.ms"L, recipient] = yes
              THEN handle.express ¬ TRUE;
          EXIT
          END;
        ENDLOOP;
    END;

  BadBadList: ERROR = CODE;

  CheckValidity: PUBLIC ENTRY PROC [
    handle: Handle, notify: PROCEDURE [CARDINAL, BodyDefs.RName]]
    RETURNS [ok: CARDINAL] =
    BEGIN
    rName: BodyDefs.RName = [BodyDefs.maxRNameLength];
    number: CARDINAL;
    reader: HeapDefs.ReaderHandle;
    ended: BOOLEAN;
    used: CARDINAL;
    GetReader: PROCEDURE [obj: HeapDefs.ObjectNumber] =
      BEGIN reader ¬ HeapDefs.HeapStartRead[obj] END;
    IF handle.state # starting THEN ERROR WrongCallSequence[];
    handle.state ¬ inItem;
    IF handle.bad # NIL THEN
      BEGIN
      HeapDefs.HeapEndWrite[handle.bad, GetReader];
      handle.bad ¬ NIL;
      [ended, ] ¬ HeapDefs.HeapReadData[reader, [@number, 0]];
      UNTIL ended DO
        BEGIN
        ENABLE UNWIND => HeapDefs.HeapEndRead[reader];
        [ended, used] ¬ HeapDefs.HeapReadData[reader, [@number, SIZE[CARDINAL]]];
        IF ended OR used # SIZE[CARDINAL] THEN ERROR BadBadList[];
        ended ¬ HeapDefs.HeapReadRName[reader, rName];
        IF notify # NIL THEN notify[number, rName];
        END;
        ENDLOOP;
      HeapDefs.HeapEndRead[reader];
      END;
    RETURN[handle.validRecipients]
    END;

  EndItem: INTERNAL PROCEDURE [handle: Handle] =
    BEGIN
    IF handle.state = starting THEN
      BEGIN
      IF handle.bad # NIL THEN HeapDefs.HeapAbandonWrite[handle.bad];
      handle.bad ¬ NIL;
      handle.state ¬ inItem;
      END;
    IF handle.state # inItem THEN ERROR WrongCallSequence[];
    BEGIN
    save: HeapDefs.ObjectOffset = HeapDefs.GetWriterOffset[handle.body];
    HeapDefs.SetWriterOffset[handle.body, handle.itemStart];
    HeapDefs.HeapWriteData[
      handle.body, [@(handle.header), SIZE[BodyDefs.ItemHeader]]];
    HeapDefs.SetWriterOffset[handle.body, save];
    handle.itemStart ¬ save;
    END;
    END;

  StartItem: PUBLIC ENTRY PROC [handle: Handle, type: BodyDefs.ItemType] =
    BEGIN
    header: BodyDefs.ItemHeader;
    EndItem[handle];
    handle.state ¬ inItem;
    handle.header.type ¬ type;
    handle.header.length ¬ 0;
    header.type ¬ type;
    header.length ¬ 0;  --fixed up later--
    HeapDefs.HeapWriteData[handle.body, [@header, SIZE[BodyDefs.ItemHeader]]];
    END --StartItem-- ;

  AddToItem: PUBLIC ENTRY PROC [
    handle: Handle, buffer: LONG DESCRIPTOR FOR PACKED ARRAY OF CHARACTER] =
    BEGIN
    IF handle.state # inItem THEN ERROR WrongCallSequence[];
    IF handle.header.length MOD 2 # 0 THEN ERROR WrongCallSequence[];
    HeapDefs.HeapWriteData[handle.body, [BASE[buffer], (1 + LENGTH[buffer]) / 2]];
    handle.header.length ¬ handle.header.length + LENGTH[buffer];
    END --AddToItem-- ;

  GetStamp: PUBLIC ENTRY PROC [handle: Handle] RETURNS [BodyDefs.Timestamp] = {
    IF handle.state # inItem THEN ERROR WrongCallSequence[];
    RETURN[handle.stamp];
    };
    
  Send: PUBLIC ENTRY PROCEDURE [handle: Handle] =
    BEGIN
    EndItem[handle];
    handle.state ¬ idle;

    -- End --
    BEGIN
    header: BodyDefs.ItemHeader;
    header.type ¬ LastItem;
    header.length ¬ 0;
    HeapDefs.HeapWriteData[handle.body, [@header, SIZE[BodyDefs.ItemHeader]]];
    END;

    LogCommit[handle];

    -- commit --
    BEGIN
    Action: PROCEDURE [obj: HeapDefs.ObjectNumber] =
      BEGIN
      SLDefs.SLWrite[
        body: obj, SL: handle.SL,
        queue: IF handle.express THEN express ELSE input];
      END;
    HeapDefs.HeapEndWrite[handle.body, Action];
    END;

    END;

  InnerAbort: INTERNAL PROCEDURE [handle: Handle] =
    BEGIN
    IF handle.state IN [starting..inItem] THEN
      BEGIN
      IF handle.bad # NIL THEN HeapDefs.HeapAbandonWrite[handle.bad];
      HeapDefs.HeapAbandonWrite[handle.body];
      HeapDefs.HeapAbandonWrite[handle.SL];
      LogAbort[handle];
      END;
    handle.state ¬ idle;
    END;

  Abort: PUBLIC ENTRY PROCEDURE [handle: Handle] = BEGIN InnerAbort[handle]; END;


  ExpandFailed: PUBLIC ERROR = CODE;  -- not raised --

  Expand: PUBLIC PROC [name: BodyDefs.RName, work: PROC [BodyDefs.RName]]
    RETURNS [info: SendDefs.ExpandInfo] =
    BEGIN
    nameInfo: SiteCacheDefs.RecipientInfo = SiteCacheDefs.FindMBXSite[name];
    MyWork: PROC [n: BodyDefs.RName] RETURNS [done: BOOLEAN] = {
      work[n]; RETURN[FALSE]};
    WITH i: nameInfo SELECT FROM
      allDown => info ¬ allDown;
      notFound => info ¬ notFound;
      local, found => info ¬ individual;
      dl =>
        BEGIN
        ENABLE UNWIND => NameInfoDefs.Close[i.members];
        NameInfoDefs.Enumerate[i.members, MyWork];
        NameInfoDefs.Close[i.members];
        info ¬ ok;
        END;
      foreign =>
        BEGIN
        ENABLE UNWIND => HeapDefs.HeapEndRead[i.members];
        HeapDefs.ReadRList[i.members, MyWork];
        HeapDefs.HeapEndRead[i.members];
        info ¬ ok;
        END;
      ENDCASE => ERROR;
    END;

  myName: PupDefs.PupAddress;

  [] ¬ PupDefs.PupPackageMake[];
  PupDefs.PupNameLookup[@myName, "ME"L];


  END.