-- Transport Mechanism Mail Server - Return Undeliverable Mail --

-- [Indigo]<Grapevine>MS>ReturnMail.mesa

-- Randy Gobbel		19-May-81 23:38:50 --
-- Andrew Birrell	 4-Mar-82 14:42:33 --
-- Michael Schroeder  August 18, 1982  9:15 PM --

DIRECTORY
Ascii		USING[ CR ],
BodyDefs	USING[ ItemHeader, ItemLength, maxRNameLength,
                       RName, Timestamp ],
HeapDefs	USING[ GetReaderOffset, HeapAbandonWrite, HeapEndRead,
                       HeapEndWrite, HeapReadData, HeapReadRName,
                       HeapStartRead, ObjectNumber, ObjectOffset,
                       objectStart, ReaderHandle, SetReaderOffset,
		       WriterHandle ],
Inline		USING[ LowHalf ],
LocalNameDefs	USING[ ReadMSName ],
LogDefs		USING[ WriteLogEntry ],
ProtocolDefs	USING[ AppendTimestamp ],
ReturnDefs	USING[] --EXPORT only--,
SendDefs	USING[ Abort, AddRecipient, AddToItem, Create, Destroy,
                       CheckValidity, Handle, StartSend, StartText, Send ],
String		USING[ AppendDecimal, AppendString ],
Time		USING[ Append, Current, Packed, Unpack ],
VMDefs		USING[ AllocatePage, Page, pageSize, Release ];

ReturnMail: PROGRAM
   IMPORTS HeapDefs, Inline, LocalNameDefs, LogDefs,
           ProtocolDefs, SendDefs, String, Time, VMDefs
   EXPORTS ReturnDefs =

BEGIN

ParseBody: PUBLIC PROCEDURE[ reader: HeapDefs.ReaderHandle,
                             stamp: POINTER TO BodyDefs.Timestamp _ NIL,
                             sender: BodyDefs.RName _ NIL,
                             returnTo: BodyDefs.RName _ NIL ]
                    RETURNS[ BodyDefs.ItemLength ] =
   BEGIN
   textStart: HeapDefs.ObjectOffset;
   textFound: BOOLEAN _ FALSE;
   textLength: BodyDefs.ItemLength;
   header: BodyDefs.ItemHeader;
   found: CARDINAL _ 0;
   UNTIL found = 4 -- postmark, sender, returnto, text/end --
   DO [] _ HeapDefs.HeapReadData[reader, [@header,SIZE[BodyDefs.ItemHeader]] ];
      BEGIN
      itemStart: HeapDefs.ObjectOffset = HeapDefs.GetReaderOffset[reader];
      found _ found + 1;
      SELECT header.type FROM
        PostMark =>
           IF stamp # NIL
           THEN [] _ HeapDefs.HeapReadData[reader,
                                       [stamp,SIZE[BodyDefs.Timestamp]] ];
        Sender =>
           IF sender # NIL
           THEN [] _ HeapDefs.HeapReadRName[reader, sender];
        ReturnTo =>
           IF returnTo # NIL
           THEN [] _ HeapDefs.HeapReadRName[reader, returnTo];
        Text =>
           BEGIN
           textStart _ itemStart;
           textLength _ header.length;
           textFound _ TRUE; EXIT
           END;
        LastItem =>
           NULL;
      ENDCASE => found _ found - 1;
      --skip past item--
      HeapDefs.SetReaderOffset[reader, itemStart + (1+header.length)/2 ];
      END
   ENDLOOP--each item of a message--;
   IF textFound
   THEN BEGIN
        HeapDefs.SetReaderOffset[reader, textStart];
        RETURN[textLength]
        END
   ELSE RETURN[0]
   END;

CopyItem: PUBLIC PROCEDURE[reader: HeapDefs.ReaderHandle,
             length: BodyDefs.ItemLength,
             sendBlock: PROCEDURE[UNSPECIFIED, POINTER, CARDINAL],
             sendBlockData: UNSPECIFIED ] =
   BEGIN
   data: VMDefs.Page = VMDefs.AllocatePage[];
   WHILE length > 0
   DO BEGIN
      ENABLE UNWIND => VMDefs.Release[data];
      --messy because we're reading words and sending bytes--
      wanted: CARDINAL;
      given: CARDINAL;
      used: CARDINAL;
      wanted _ IF VMDefs.pageSize*2 < length
               THEN VMDefs.pageSize*2
               ELSE Inline.LowHalf[length];
      [,used] _ HeapDefs.HeapReadData[reader, [data,(1+wanted)/2] ];
      given _ MIN[used*2, wanted];
      sendBlock[sendBlockData, data, given];
      length _ length - given;
      END;
   ENDLOOP;
   VMDefs.Release[data];
   END;

AppendOwner: PROC[s: STRING, group: STRING] =
   BEGIN
   String.AppendString[s, "Owners-"L];
   FOR i: CARDINAL IN [0..MIN[s.maxlength-s.length,group.length] )
   DO s[s.length] _ group[i]; s.length _ s.length+1; ENDLOOP;
   END;



BadRecipients: PUBLIC PROC[list: HeapDefs.WriterHandle,
                           body: HeapDefs.ObjectNumber] =
   { Return[list, body, user, NIL, NIL, NIL] };

BadGroup: PUBLIC PROC[list: HeapDefs.WriterHandle,
                      body: HeapDefs.ObjectNumber,
                      group: BodyDefs.RName] =
   { Return[list, body, owner, group, NIL, NIL] };

RejectedByMTP: PUBLIC PROC[list: HeapDefs.WriterHandle,
                           body: HeapDefs.ObjectNumber,
                           server: STRING,
                           text: STRING] =
   { Return[list, body, mtp, NIL, server, text] };

LongTerm: PUBLIC PROC[list: HeapDefs.WriterHandle,
                      body: HeapDefs.ObjectNumber] =
   { Return[list, body, longTerm, NIL, NIL, NIL] };


NoDeadLetterRName: SIGNAL = CODE;
LooksLikeImDown: ERROR = CODE;
MyNameIsWrong: ERROR = CODE;
maxReturnDays: CARDINAL = 7; -- discard messages older than this --

Return: PROCEDURE[ list: HeapDefs.WriterHandle,
                   body: HeapDefs.ObjectNumber,
                   case: { user, owner, mtp, longTerm },
                   group: BodyDefs.RName,
                   server, text: STRING ] =
   BEGIN OPEN SendDefs;
   bodyReader: HeapDefs.ReaderHandle = HeapDefs.HeapStartRead[body];
   sendHandle: Handle = Create[];
   wsBuffer: STRING = [64];
   ws: PROCEDURE[s: STRING] =
      BEGIN
      OPEN Ascii;
      FOR index: CARDINAL IN [0..s.length)
      DO IF wsBuffer.length = wsBuffer.maxlength --must be even--
         THEN BEGIN
              AddToItem[sendHandle,
                        DESCRIPTOR[@(wsBuffer.text), wsBuffer.length] ];
              wsBuffer.length _ 0;
              END;
         wsBuffer[wsBuffer.length] _ IF s[index] = '~ THEN CR ELSE s[index];
         wsBuffer.length _ wsBuffer.length + 1;
      ENDLOOP;
      END;
   FlushWS: PROC =
      BEGIN
      IF wsBuffer.length MOD 2 # 0 THEN ws[" "L];
      AddToItem[sendHandle,
                DESCRIPTOR[@(wsBuffer.text), wsBuffer.length] ];
      wsBuffer.length _ 0;
      END;
   wt: PROCEDURE[t: Time.Packed] =
      BEGIN
      s: STRING = [30];
      Time.Append[s, Time.Unpack[t], TRUE];
      ws[s];
      END;
   textLength:  BodyDefs.ItemLength;
   badCount:    CARDINAL _ 0;
   stamp:       BodyDefs.Timestamp;
   returnTo:    BodyDefs.RName = [BodyDefs.maxRNameLength];
   sender:      BodyDefs.RName = [BodyDefs.maxRNameLength];
   textLength _ ParseBody[bodyReader, @stamp, sender,
                          IF case = owner THEN NIL ELSE returnTo];
   IF stamp.time + maxReturnDays * 24 * LONG[60*60] < Time.Current[]
   THEN BEGIN
        HeapDefs.HeapAbandonWrite[list];
        LogDiscard[stamp, sender];
        END
   ELSE BEGIN
        textStart: HeapDefs.ObjectOffset =
                      HeapDefs.GetReaderOffset[bodyReader];
        myName:   BodyDefs.RName;
        password: STRING;
        dead:     BodyDefs.RName = "DeadLetter.MS"L;
        badReader: HeapDefs.ReaderHandle;
        Start: PROC[validate: BOOLEAN] =
           BEGIN
           SELECT StartSend[handle: sendHandle, sender:myName,
                            senderPwd: password,
                            returnTo: dead, validate:validate] FROM
             ok => NULL;
             badReturnTo => ERROR NoDeadLetterRName[];
             badSender, badPwd => ERROR MyNameIsWrong[];
             allDown => ERROR LooksLikeImDown[] --silly: I'm not down!--;
           ENDCASE => ERROR;
           END;
        [myName,password,] _ LocalNameDefs.ReadMSName[];
        IF case = owner THEN AppendOwner[returnTo, group];
        Start[TRUE];
        AddRecipient[sendHandle,returnTo];
        BEGIN
           bad: BOOLEAN _ FALSE;
           Notify: PROCEDURE[number:CARDINAL, who:STRING] =
              BEGIN bad _ TRUE; END;
           [] _ CheckValidity[sendHandle, Notify];
           IF bad
           THEN BEGIN
                Abort[sendHandle];
                returnTo.length _ 0;
                String.AppendString[returnTo, dead];
                Start[TRUE];
                AddRecipient[sendHandle,returnTo];
                bad _ FALSE;
                [] _ CheckValidity[sendHandle, Notify];
                IF bad THEN ERROR NoDeadLetterRName[];
                END;
        END;
        StartText[sendHandle];
        ws["Subject: Undelivered mail~From: "L];
        ws[myName];
        ws[" (a Grapevine mail server)~To: "L];
        ws[returnTo];
        ws["~Date: "L];
        wt[Time.Current[]];
        ws["~~The message sent by "L];
        ws[sender];
        ws[" at "L];
        wt[LOOPHOLE[stamp.time]];
        ws[" could not be delivered to the following recipients "L];
        SELECT case FROM
          user =>
            ws["because their names are invalid."L];
          owner =>
            BEGIN
            ws["because they are invalid names in the distribution list """L];
            ws[group];
            ws[""".  Please remove them from that list."L];
            END;
          mtp =>
            BEGIN
            ws["because they were rejected by the MTP server """L];
            ws[server]; ws[""".  "L];
            IF text = NIL
            THEN ws["No reason was given."L]
            ELSE { ws["The reason given was: "L]; ws[text] };
            END;
          longTerm =>
            ws["within a reasonable time, because of network failures or the unavailability of other servers."L];
        ENDCASE => ERROR;
        ws["~~"L];
        BEGIN
           name: BodyDefs.RName = [BodyDefs.maxRNameLength];
           ended: BOOLEAN;
           GetReader: PROCEDURE[ obj: HeapDefs.ObjectNumber ] =
              BEGIN badReader _ HeapDefs.HeapStartRead[obj]; END;
           HeapDefs.HeapEndWrite[list, GetReader];
           [ended] _ HeapDefs.HeapReadData[badReader,[name,0]];
           UNTIL ended
           DO ended _ HeapDefs.HeapReadRName[badReader,name];
              badCount _ badCount + 1;
              ws[name]; IF NOT ended THEN ws[", "L];
           ENDLOOP;
        END;
        ws["~~"L];
        IF case = owner
        THEN FlushWS[] 
        ELSE BEGIN
             IF textLength > 0
             THEN BEGIN
                  SillySend: PROCEDURE[u:UNSPECIFIED, p:POINTER, c:CARDINAL] =
                     { AddToItem[u,DESCRIPTOR[p,c]] };
                  ws["----------------~~"L];
                  IF wsBuffer.length MOD 2 # 0 THEN ws["~"L];
                  FlushWS[]; 
                  CopyItem[bodyReader, textLength, SillySend, sendHandle];
                  END
             ELSE { ws["There was no message text."L]; FlushWS[] };
             END;
        LogReturn[stamp, returnTo, badCount];
        Send[sendHandle];
        BEGIN
           -- Send summary to DeadLetter.ms --
           Start[FALSE];
           AddRecipient[sendHandle,dead];
           StartText[sendHandle];
           ws["Subject: Undelivered mail notification~From: "L];
           ws[myName];
           ws["~To: "L];
           ws[dead];
           ws["~Date: "L];
           wt[Time.Current[]];
           ws["~~Reason: "L];
           ws[SELECT case FROM
                user => "Invalid recipients(s)"L,
                owner => "Invalid recipients(s) in DL"L,
                mtp => "Name(s) rejected by MTP server"L,
                longTerm => "Message time-out"L,
              ENDCASE => ERROR];
           ws["~Notification sent to: "L];
           ws[returnTo];
           ws["~Original postmark: "L];
           wt[LOOPHOLE[stamp.time]];
           ws[" = "L];
           {s:STRING = [18]; ProtocolDefs.AppendTimestamp[s,stamp]; ws[s]};
           ws["~Sender: "L]; ws[sender];
           SELECT case FROM
             user => NULL;
             owner => { ws["~Group: "L]; ws[group] }; 
             mtp => { ws["~MTP host: "L]; ws[server];
                      ws["~MTP complaint: "L];
                      ws[IF text = NIL THEN "none"L ELSE text] };
             longTerm => NULL;
           ENDCASE => ERROR;
           ws["~Undeliverable recipient(s): "L];
           HeapDefs.SetReaderOffset[badReader, HeapDefs.objectStart];
           FOR i: CARDINAL IN [1..badCount]
           DO name: BodyDefs.RName = [BodyDefs.maxRNameLength];
              IF i # 1 THEN ws[", "L];
              [] _ HeapDefs.HeapReadRName[badReader,name]; ws[name];
           ENDLOOP;
           IF textLength > 0
           THEN BEGIN
                length: BodyDefs.ItemLength _ textLength;
                crSeen: BOOLEAN _ FALSE; -- end on double CR --
                ws["~Text header:~~"L];
                HeapDefs.SetReaderOffset[bodyReader, textStart];
                WHILE length > 0
                DO buff: STRING = [64];
                   wanted: CARDINAL = IF buff.maxlength < length
                                      THEN buff.maxlength
                                      ELSE Inline.LowHalf[length];
                   [] _ HeapDefs.HeapReadData[bodyReader,
                                              [@buff.text,(wanted+1)/2]];
                   length _ length - wanted;
                   buff.length _ wanted;
                   FOR i: CARDINAL IN [0..buff.length)
                   DO IF buff[i] = Ascii.CR
                      THEN{ IF crSeen
                            THEN{ buff.length _ i; ws[buff]; GOTO ended }
                            ELSE crSeen _ TRUE }
                      ELSE crSeen _ FALSE;
                   ENDLOOP;
                   ws[buff];
                REPEAT ended => NULL;
                ENDLOOP;
                END
           ELSE ws["~No text~"L];
           FlushWS[];
           Send[sendHandle];
        END;
        HeapDefs.HeapEndRead[badReader];
        END;
   HeapDefs.HeapEndRead[bodyReader];
   Destroy[sendHandle];
   END;

LogDiscard: PROC[stamp: BodyDefs.Timestamp, sender: BodyDefs.RName] =
   BEGIN
   len: CARDINAL = sender.length;
   log: STRING = [128];
   String.AppendString[log, "Discarded undeliverable msg "L];
   ProtocolDefs.AppendTimestamp[log, stamp ];
   String.AppendString[log, " because of extreme age.  Sender="L];
   sender.length _ MIN[len, log.maxlength - log.length];
   String.AppendString[log, sender];
   sender.length _ len;
   LogDefs.WriteLogEntry[log];
   END;

LogReturn: PROC[stamp: BodyDefs.Timestamp, returnTo: BodyDefs.RName,
                badCount: CARDINAL] =
   BEGIN
   len: CARDINAL = returnTo.length;
   log: STRING = [128];
   String.AppendString[log, "Returned  "L];
   ProtocolDefs.AppendTimestamp[log, stamp ];
   String.AppendString[log, " to "L];
   returnTo.length _ MIN[len, log.maxlength - log.length - 10];
   String.AppendString[log, returnTo];
   returnTo.length _ len;
   String.AppendString[log, ": "L];
   String.AppendDecimal[log, badCount];
   String.AppendString[log, " bad"L];
   LogDefs.WriteLogEntry[log];
   END;

END.
(635)\f1