-- file: FTPServerMail.mesa 
-- Edited by: HGM July 28, 1980  9:13 PM  

-- Copyright  Xerox Corporation 1979, 1980

DIRECTORY
  FTPDefs,
  FTPPrivateDefs,
  String USING [AppendChar, AppendDecimal, AppendLongNumber],
  Storage USING [Node, Free, FreeString];

FTPServerMail: PROGRAM
  -- import list
    IMPORTS String, Storage, FTPDefs, FTPPrivateDefs
  -- export list
    EXPORTS FTPPrivateDefs
  -- share list
    SHARES FTPDefs, FTPPrivateDefs
  = BEGIN OPEN FTPDefs, FTPPrivateDefs;

-- **********************!  Constants  !***********************

ftpsystem: POINTER TO FTPSystem = LocateFtpSystemObject[];
 
-- **********************!  Module Presence Test Procedure  !***********************

ServerMailLoaded: PUBLIC PROCEDURE =
  BEGIN
  -- report in
    ftpsystem.serverMailLoaded ← TRUE;
  END;
 
-- **********************!  Mail Commands  !***********************

PTFStoreMail: PUBLIC PROCEDURE [ftpserver: FTPServer] =
  BEGIN OPEN ftpserver, ftpserver.ftplistener;
  -- PutMailboxException procedure
    PutMailboxException: PROCEDURE [number: CARDINAL, recipientError: RecipientError] =
      BEGIN
      -- local constants
        message: STRING = [maxStringLength];
      -- construct error message
        String.AppendDecimal[message, number];
        String.AppendChar[message, mailboxExceptionIndexTerminator];
        IF ftpsystem.accessoriesLoaded THEN VerbalizeRecipientError[recipientError, message];
      -- send mailbox exception command
        PutCommand[ftper, markMailboxException,
          RecipientErrorToExceptionCode[recipientError]];
      -- send error message
        PutString[ftper, message];
      END;
  -- local variables
    headLocalMailbox, headRemoteMailbox: Mailbox ← NIL;
    mailbox: Mailbox;
    number: CARDINAL ← 0;
    atLeastOneValidRecipient: BOOLEAN ← FALSE;
  -- intercept errors
    BEGIN ENABLE UNWIND =>
      BEGIN
      DequeueMailboxes[@headLocalMailbox];
      DequeueMailboxes[@headRemoteMailbox];
      END;
  -- receive distribution list and EOC
    DO
      -- receive property list
        GetPropertyList[ftper, propertyList ! FTPError =>
          IF ftpError = protocolParameterListMissing THEN EXIT];
      -- enqueue local/remote mailbox
        EnqueueMailbox[@headLocalMailbox, propertyList, number ← number+1];
      ENDLOOP;
    GetEOC[ftper];
  -- reject unsupported forwarding requests
    IF headRemoteMailbox # NIL THEN
      IF forwardingProvided THEN atLeastOneValidRecipient ← TRUE
      ELSE
        FOR mailbox ← headRemoteMailbox, mailbox.nextMailbox UNTIL mailbox = NIL DO
          PutMailboxException[mailbox.number, noForwardingProvided];
          ENDLOOP;
  -- reject undefined local mailboxes
    IF headLocalMailbox # NIL THEN
      BEGIN
      -- locate mailboxes
        mailPrimitives.LocateMailboxes[mailSystem, headLocalMailbox];
      -- issue necessary mailbox exceptions
        FOR mailbox ← headLocalMailbox, mailbox.nextMailbox UNTIL mailbox = NIL DO
          IF mailbox.located THEN atLeastOneValidRecipient ← TRUE
          ELSE PutMailboxException[mailbox.number, noSuchMailbox];
          ENDLOOP;
      END;
  -- send preliminary approval of distribution list
    IF atLeastOneValidRecipient THEN PutCommandAndEOC[ftper, markYes, 0]
    ELSE Abort[noValidRecipients];
  -- stage message text
    GetSpecificCommand[ftper, markHereIsFile];
    mailPrimitives.StageMessage[mailSystem, ReceiveBlock, ftper];
    GetYesAndEOC[ftper];
  -- deliver message to local mailboxes
    IF headLocalMailbox # NIL THEN
      BEGIN
      -- deliver message
        mailPrimitives.DeliverMessage[mailSystem, headLocalMailbox];
      -- issue necessary mailbox exceptions
        FOR mailbox ← headLocalMailbox, mailbox.nextMailbox UNTIL mailbox = NIL DO
          IF mailbox.located AND ~mailbox.delivered THEN
            PutMailboxException[mailbox.number, unspecifiedError];
          ENDLOOP;
      END;
  -- forward message to remote mailboxes
    IF headRemoteMailbox # NIL THEN
      BEGIN
      -- forward message
        mailPrimitives.ForwardMessage[mailSystem, headRemoteMailbox];
      -- issue necessary mailbox exceptions
        FOR mailbox ← headRemoteMailbox, mailbox.nextMailbox UNTIL mailbox = NIL DO
          IF ~mailbox.delivered THEN PutMailboxException[mailbox.number, unspecifiedError];
          ENDLOOP;
      END;
  -- send Yes and EOC
    PutCommandAndEOC[ftper, markYes, 0];
  -- dequeue distribution list
    DequeueMailboxes[@headLocalMailbox];
    DequeueMailboxes[@headRemoteMailbox];
    END; -- enable
  END;

PTFRetrieveMail: PUBLIC PROCEDURE [ftpserver: FTPServer] =
  BEGIN OPEN ftpserver, ftpserver.ftplistener;
  -- NextMessage procedure
    NextMessage: PROCEDURE [messageInfo: MessageInfo] =
      BEGIN OPEN messageInfo;
      -- next message
        IF byteCount # 0 THEN
          BEGIN
          -- send message information
            PutCommand[ftper, markHereIsPropertyList, 0];
            PutMessageInfo[messageInfo];
          -- signal transmission of text
            PutCommand[ftper, markHereIsFile, 0];
          END
      -- no more messages
        ELSE
          BEGIN
          -- send Yes and EOC
            PutCommandAndEOC[ftper, markYes, 0];
          -- receive OK to flush mailbox
            GetSpecificCommand[ftper, markFlushMailbox];
            GetEOC[ftper];
          END;
      END;
  -- PutMessageInfo procedure
    PutMessageInfo: PROCEDURE [messageInfo: MessageInfo] =
      BEGIN OPEN messageInfo;
      -- local constants
        messageLength: STRING = [maxStringLength];
        boolean: STRING = [maxStringLength];
      -- reset property list
        ResetPropertyList[propertyList];
      -- encode byte count
        String.AppendLongNumber[messageLength, byteCount, 10];
        WriteProperty[propertyList, length, messageLength];
      -- encode delivery date
        WriteProperty[propertyList, dateReceived, deliveryDate];
      -- encode opened and deleted
        EncodeBooleanProperty[opened, boolean];
        WriteProperty[propertyList, opened, boolean];
        EncodeBooleanProperty[deleted, boolean];
        WriteProperty[propertyList, deleted, boolean];
      -- send property list
        PutPropertyList[ftper, propertyList];
      END;
  -- local variables
    mailbox: Mailbox ← NIL;
  -- receive property list and EOC
    GetPropertyList[ftper, propertyList];  GetEOC[ftper];
  -- inspect credentials
    IF propertyList[userName] # NIL THEN
      mailPrimitives.InspectCredentials[mailSystem, primary,
        propertyList[userName], propertyList[userPassword]];
    IF propertyList[connectName] # NIL THEN
      mailPrimitives.InspectCredentials[mailSystem, secondary,
        propertyList[connectName], propertyList[connectPassword]];
  -- enqueue mailbox
    EnqueueMailbox[@mailbox, propertyList, 1];
    BEGIN ENABLE UNWIND => DequeueMailboxes[@mailbox];
  -- locate local mailbox
    mailPrimitives.LocateMailboxes[mailSystem, mailbox];
    IF ~mailbox.located THEN Abort[noSuchMailbox];
  -- retrieve messages
    mailPrimitives.RetrieveMessages[mailSystem, mailbox, NextMessage, SendBlock, ftper];
    PutCommandAndEOC[ftper, markYes, 0];
  -- dequeue mailbox
    END; -- enable
    DequeueMailboxes[@mailbox];
  END;

-- **********************!  Mailbox Primitives  !***********************

EnqueueMailbox: PROCEDURE [headMailbox: POINTER TO Mailbox, propertyList: PropertyList, number: CARDINAL] =
  BEGIN
  -- Note:  Assumes nextMailbox=NIL; updates headMailbox↑ if NIL.
  -- local variables
    mailbox, tailMailbox: Mailbox;
  -- create mailbox
    mailbox ← CreateMailbox[propertyList, number];
  -- queue is empty:  make mailbox the head
    IF headMailbox↑ = NIL THEN headMailbox↑ ← mailbox
  -- queue is not empty:  append mailbox to it
    ELSE
      BEGIN
      FOR tailMailbox ← headMailbox↑, tailMailbox.nextMailbox
          UNTIL tailMailbox.nextMailbox = NIL DO 
        ENDLOOP;
      tailMailbox.nextMailbox ← mailbox;
      END;
  END;

DequeueMailboxes: PROCEDURE [headMailbox: POINTER TO Mailbox] =
  BEGIN
  -- Note:  Resets headMailbox↑ to NIL.
  -- local variables
    mailbox, nextMailbox: Mailbox;
  -- destroy each mailbox
    FOR mailbox ← headMailbox↑, nextMailbox UNTIL mailbox = NIL DO
      nextMailbox ← mailbox.nextMailbox;
      DestroyMailbox[mailbox];
      ENDLOOP;
  -- reset queue
    headMailbox↑ ← NIL;
  END;

CreateMailbox: PROCEDURE [propertyList: PropertyList, number: CARDINAL] RETURNS [mailbox: Mailbox] =
  BEGIN
  -- Note:  Initializes nextMailbox to NIL;
  --   removes mailbox property from property list.
  -- allocate and initialize mailbox object
    mailbox ← Storage.Node[SIZE[MailboxObject]];
    mailbox↑ ← MailboxObject[
      number: number,
      mailbox: propertyList[mailbox], location: NIL,
      located: FALSE, delivered: FALSE,
      nextMailbox: NIL];
  -- remove mailbox, host, and dms name from property list
  -- Note: WriteProperty was circumvented above.
    propertyList[mailbox] ← NIL;
  END;

DestroyMailbox: PROCEDURE [mailbox: Mailbox] =
  BEGIN
  -- release mailbox if any
    IF mailbox.mailbox # NIL THEN Storage.FreeString[mailbox.mailbox];
  -- release location if any
    IF mailbox.location # NIL THEN Storage.FreeString[mailbox.location];
  -- release mailbox object
    Storage.Free[mailbox];
  END;

-- **********************!  Main Program  !***********************

-- no operation

END. -- of FTPServerMail