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

-- [Juniper]<DMS>MS>CreateMail.mesa

-- Randy Gobbel		19-May-81 21:21:39 --
-- Andrew Birrell	 1-Apr-81 14:54:01 --

DIRECTORY
BodyDefs	USING[ ItemHeader, ItemLength, ItemType, maxRNameLength,
		       Password, RName, RNameSize, Timestamp ],
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 ],
Process		USING[ InitializeMonitor ],
ProtocolDefs	USING[ AppendTimestamp, MakeKey ],
PupDefs		USING[ PupAddress, PupNameLookup, PupPackageMake ],
SendDefs	USING[ ExpandInfo, StartSendInfo ],
SiteCacheDefs	USING[ FindMBXSite, RecipientInfo, ValidateRName ],
SLDefs		USING[ SLHeader, SLWrite ],
Storage		USING[ Free, Node ],
String      	USING[ AppendDecimal, AppendLongDecimal, AppendString ],
Time		USING[ Current ];

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

BEGIN

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

LogStart: PROCEDURE[handle: Handle, sender: STRING] =
   BEGIN
   log: STRING = [128];
   String.AppendString[log, "Created   "L];
   ProtocolDefs.AppendTimestamp[log, handle.stamp];
   String.AppendString[log, ": sender "L];
   String.AppendString[log, sender];
   LogDefs.WriteLogEntry[log];
   END;

LogCommit: PROCEDURE[handle: Handle] =
   BEGIN
   log: STRING = [96];
   String.AppendString[log, "Received  "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];
   LogDefs.WriteLogEntry[log];
   LogDefs.WriteChar[IF handle.express THEN 'E ELSE 'C];
   END;

LogAbort: PROCEDURE[handle: Handle] =
   BEGIN
   log: STRING = [128];
   String.AppendString[log, "Abandoned "L];
   ProtocolDefs.AppendTimestamp[log, handle.stamp];
   LogDefs.WriteLogEntry[log];
   END;


Handle: PUBLIC TYPE = 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,
      express: 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 _ Storage.Node[SIZE[HandleObject]];
   handle.state _ idle;
   Process.InitializeMonitor[@(handle.LOCK)];
   END;

Destroy: PUBLIC PROCEDURE[ handle: Handle ] =
   BEGIN
   Abort[handle];
   handle.state _ dead;
   Storage.Free[handle];
   END;

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

StartSend: PUBLIC PROCEDURE[ handle: Handle,
                           senderPwd: 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.express _ 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];
           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;
   IF handle.validate AND validationOn
   AND( NOT RNameFromString[recipient]
        OR NOT SiteCacheDefs.ValidateRName[recipient] )
   THEN 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
   ELSE 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--;

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: 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--;

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.