-- 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],
  MDSStorage USING [Node, Free, FreeString];

FTPServerMail: PROGRAM
  IMPORTS String, Storage: MDSStorage, FTPDefs, FTPPrivateDefs
  EXPORTS FTPPrivateDefs
  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