-- Copyright (C) 1979, 1980, 1984  by Xerox Corporation. All rights reserved. 
-- file: FTPServerCommon.mesa, HGM, 16-Nov-84  4:01:13
-- edit: HGM January 28, 1981  1:03 AM  


DIRECTORY
  FTPDefs,
  FTPPrivateDefs,
  String USING [AppendChar, AppendDecimal, AppendString],
  MDSStorage USING [Node, Free];

FTPServerCommon: PROGRAM
  IMPORTS String, Storage: MDSStorage, FTPDefs, FTPPrivateDefs
  EXPORTS FTPDefs
  SHARES FTPDefs, FTPPrivateDefs =
  BEGIN OPEN FTPDefs, FTPPrivateDefs;

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

  ftpsystem: POINTER TO FTPSystem = LocateFtpSystemObject[];

  -- **********************!  Program Primitives  !***********************

  FTPCreateListener: PUBLIC PROCEDURE [
    purpose: Purpose, filePrimitives: FilePrimitives,
    mailPrimitives: MailPrimitives,
    communicationPrimitives: CommunicationPrimitives,
    backstopServer: POINTER TO BackstopServer, backstopServerData: UNSPECIFIED,
    filter: PROCEDURE [STRING, Purpose]] RETURNS [ftplistener: FTPListener] =
    BEGIN
    -- verify presence of required modules and primitives
    IF purpose # mail THEN
      BEGIN
      IF ~ftpsystem.serverFilesLoaded THEN Abort[filesModuleNotLoaded];
      IF filePrimitives = NIL THEN Abort[filePrimitivesNotSpecified];
      END;
    IF purpose # files THEN
      BEGIN
      IF ~ftpsystem.serverMailLoaded THEN Abort[mailModuleNotLoaded];
      IF mailPrimitives = NIL THEN Abort[mailPrimitivesNotSpecified];
      END;
    IF communicationPrimitives = NIL THEN
      Abort[communicationPrimitivesNotSpecified];
    -- allocate and initialize listener object
    ftplistener ← Storage.Node[SIZE[FTPListenerObject]];
    ftplistener.filePrimitives ← filePrimitives;
    ftplistener.mailPrimitives ← mailPrimitives;
    ftplistener.communicationPrimitives ← communicationPrimitives;
    ftplistener.communicationSystem ← NIL;
    ftplistener.backstopServer ←
      IF backstopServer # NIL THEN backstopServer↑ ELSE DefaultBackstopServer;
    ftplistener.backstopServerData ← backstopServerData;
    ftplistener.ftpCharterObject ← [ftplistener: ftplistener, purpose: files];
    ftplistener.mtpCharterObject ← [ftplistener: ftplistener, purpose: mail];
    ftplistener.ftpPort ← NIL;
    ftplistener.mtpPort ← NIL;
    -- initialize server queue
    InitializeQueue[@ftplistener.serverQueueObject, ServersCoincide];
    -- create communication system
    BEGIN
    ENABLE UNWIND => FTPDestroyListener[ftplistener, FALSE];
    ftplistener.communicationSystem ←
      communicationPrimitives.CreateCommunicationSystem[];
    -- activate ftp well known socket if requested
    IF purpose # mail THEN
      ftplistener.ftpPort ← communicationPrimitives.ActivatePort[
        ftplistener.communicationSystem, ftpSocket, OuterServerProcess,
        @ftplistener.ftpCharterObject, responseFromUserSeconds, filter, files];
    -- activate mtp well known socket if requested
    IF purpose # files THEN
      ftplistener.mtpPort ← communicationPrimitives.ActivatePort[
        ftplistener.communicationSystem, mtpSocket, OuterServerProcess,
        @ftplistener.mtpCharterObject, responseFromUserSeconds, filter, mail];
    END;  -- enable

    END;

  ServersCoincide: PROCEDURE [ftpserver1, ftpserver2: FTPServer]
    RETURNS [coincide: BOOLEAN] =
    BEGIN
    -- compare server handles
    coincide ← ftpserver1 = ftpserver2;
    END;

  FTPDestroyListener: PUBLIC PROCEDURE [
    ftplistener: FTPListener, abortServers: BOOLEAN] =
    BEGIN OPEN ftplistener;
    -- EnumerateQueue appendage
    AbortServer: PROCEDURE [element: Element] RETURNS [halt: BOOLEAN] =
      BEGIN
      -- local constants
      ftpserver: FTPServer = LOOPHOLE[element.identifier];
      -- close connection
      communicationPrimitives.CloseConnection[
        communicationSystem, ftpserver.ftper.connection];
      -- proceed to next server
      halt ← FALSE;
      END;
    -- deactivate well known sockets if active
    IF ftpPort # NIL THEN
      communicationPrimitives.DeactivatePort[communicationSystem, ftpPort];
    IF mtpPort # NIL THEN
      communicationPrimitives.DeactivatePort[communicationSystem, mtpPort];
    -- abort existing servers if so instructed
    IF abortServers THEN [] ← EnumerateQueue[@serverQueueObject, AbortServer];
    -- wait for existing servers to terminate
    FinalizeQueue[@serverQueueObject];
    -- destroy communication system
    IF communicationSystem # NIL THEN
      communicationPrimitives.DestroyCommunicationSystem[communicationSystem];
    -- release ftplistener object
    Storage.Free[ftplistener];
    END;

  RejectNothing: PUBLIC PROCEDURE [STRING, Purpose] = BEGIN END;

  -- **********************!  Server Process  !***********************

  OuterServerProcess: PROCEDURE [
    charter: Charter, connection: Connection, originOfRequest: STRING] =
    BEGIN OPEN charter;
    -- InnerServerProcess procedure
    InnerServerProcess: PROCEDURE =
      BEGIN
      -- local variables
      executing: BOOLEAN ← FALSE;
      ftpserver: FTPServer ← NIL;
      -- intercept errors
      BEGIN
      ENABLE
        BEGIN
        FTPError =>
          BEGIN
          SIGNAL FTPError[ftpError, message];
          IF executing THEN RETRY ELSE CONTINUE;
          END;
        UNWIND =>
          IF ftpserver # NIL THEN
            BEGIN
            ftpserver.ftper.connection ← NIL;
            DestroyServer[ftpserver ! FTPError => CONTINUE];
            END;
        ANY =>
          IF ftpsystem.catchUnidentifiedErrors THEN
            BEGIN
            IF ftpsystem.accessoriesLoaded THEN
              VerbalizeFtpError[unidentifiedError, errorMessage];
            SIGNAL FTPError[unidentifiedError, errorMessage];
            IF executing THEN RETRY ELSE CONTINUE;
            END
        END;
      -- create server and install connection
      IF ~executing THEN
        ftpserver ← CreateServer[ftplistener, purpose, connection];
      -- execute server
      executing ← TRUE;
      ExecuteServer[ftpserver, localInsignia];
      executing ← FALSE;
      -- destroy server and uninstall connection
      DestroyServer[ftpserver];
      END;  -- enable

      END;
    -- local constants
    localInsignia: STRING = [maxStringLength];
    errorMessage: STRING = [maxStringLength];
    -- construct insignia
    String.AppendString[localInsignia, "Mesa/Pilot FTP "L];
    String.AppendDecimal[localInsignia, ftpMajorVersion];
    String.AppendChar[localInsignia, majorMinorSeparator];
    String.AppendDecimal[localInsignia, ftpMinorVersion];
    String.AppendString[
      localInsignia, IF purpose = files THEN " File"L ELSE " Mail"L];
    String.AppendString[localInsignia, " Server"L];
    -- dispatch inner server process via backstop
    ftplistener.backstopServer[
      ftplistener.backstopServerData, purpose, originOfRequest, localInsignia,
      InnerServerProcess];
    END;

  -- **********************!  Server Primitives  !***********************

  CreateServer: PROCEDURE [
    ftplistener: FTPListener, purpose: Purpose, connection: Connection]
    RETURNS [ftpserver: FTPServer] =
    BEGIN
    -- allocate and initialize ftpserver object
    ftpserver ← Storage.Node[SIZE[FTPServerObject]];
    ftpserver↑ ← FTPServerObject[
      ftplistener: ftplistener, serverQueueElementObject:, purpose: purpose,
      fileSystem: NIL, mailSystem: NIL, forwardingProvided:, enqueued: FALSE,
      ftper: NIL, propertyList: DESCRIPTOR[NIL, 0]];
    -- create file system
    BEGIN
    ENABLE UNWIND => DestroyServer[ftpserver];
    IF purpose # mail THEN
      ftpserver.fileSystem ← ftplistener.filePrimitives.CreateFileSystem[
        ftpsystem.bufferSize];
    -- create mail system
    IF purpose # files THEN
      [ftpserver.mailSystem, ftpserver.forwardingProvided] ←
        ftplistener.mailPrimitives.CreateMailSystem[
        ftplistener.filePrimitives, ftpsystem.bufferSize];
    -- allocate and initialize ftper object
    ftpserver.ftper ← CreateFTPer[
      ftplistener.communicationPrimitives, ftplistener.communicationSystem];
    ftpserver.ftper.connection ← connection;
    -- allocate and initialize property list object
    ftpserver.propertyList ← CreatePropertyList[];
    -- enqueue server
    [] ← EnQueue[
      @ftplistener.serverQueueObject, @ftpserver.serverQueueElementObject,
      ftpserver];
    ftpserver.enqueued ← TRUE;
    END;  -- enable

    END;

  DestroyServer: PROCEDURE [ftpserver: FTPServer] =
    BEGIN OPEN ftpserver, ftpserver.ftplistener;
    -- dequeue server
    IF enqueued THEN DeQueue[@serverQueueObject, @serverQueueElementObject];
    -- release property list object if any
    IF BASE[propertyList] # NIL THEN DestroyPropertyList[propertyList];
    -- release ftper object if any
    IF ftper # NIL THEN BEGIN ftper.connection ← NIL; DestroyFTPer[ftper]; END;
    -- destroy mail system
    IF mailSystem # NIL THEN mailPrimitives.DestroyMailSystem[mailSystem];
    -- destroy file system
    IF fileSystem # NIL THEN filePrimitives.DestroyFileSystem[fileSystem];
    -- release ftpserver object
    Storage.Free[ftpserver];
    END;

  ExecuteServer: PROCEDURE [ftpserver: FTPServer, localInsignia: STRING] =
    BEGIN OPEN ftpserver;
    -- Note:  Returns only in response to a YouAreUser or Abort mark,
    --   or to a connectionClosed signal.
    -- local constants
    lastMessage: STRING = [maxStringLength];
    -- local variables
    mark, code: Byte;
    lastFtpError: FtpError;
    -- process incoming commands
    DO
      ENABLE
        BEGIN
        FTPError =>
          IF ftpError = connectionClosed THEN EXIT
          ELSE
            BEGIN
            lastFtpError ← ftpError;
            IF message # NIL THEN String.AppendString[lastMessage, message];
            END;
        UNWIND =>
          IF lastFtpError ~IN CommunicationError THEN
            BEGIN
            ftper.outputString.length ← 0;
            String.AppendString[ftper.outputString, lastMessage];
            PutCommandAndEOC[ftper, markNo, SignalToCode[lastFtpError]];
            END;
        ANY =>
          IF ftpsystem.catchUnidentifiedErrors THEN
            BEGIN
            lastFtpError ← unidentifiedError;
            IF ftpsystem.accessoriesLoaded THEN
              VerbalizeFtpError[unidentifiedError, lastMessage];
            END
        END;
      [mark, code] ← GetCommand[ftper];
      SELECT mark FROM
        markIAmVersion =>
          BEGIN
          GetEOC[ftper];
          ftper.outputString.length ← 0;
          String.AppendString[ftper.outputString, localInsignia];
          PutCommandAndEOC[
            ftper, markIAmVersion,
            IF purpose = files THEN ftpVersion ELSE mtpVersion];
          END;
        markComment => NULL;
        markAbort => EXIT;
        ENDCASE =>
          IF purpose = files THEN
            SELECT mark FROM  -- files

              markDirectory => PTFDirectory[ftpserver];
              markStore, markNewStore => PTFStore[ftpserver, mark];
              markRetrieve => PTFRetrieve[ftpserver];
              markDelete => PTFDelete[ftpserver];
              markRename => PTFRename[ftpserver];
              ENDCASE => {
	        GetEOC[ftper];
	        ftper.outputString.length ← 0;
	        String.AppendString[ftper.outputString, "Bad or Unimplemented Command"L];
                PutCommandAndEOC[
                  ftper, markNo, SignalToCode[functionNotImplemented]]; }
          ELSE
            SELECT mark FROM  -- mail

              markStoreMail => PTFStoreMail[ftpserver];
              markRetrieveMail => PTFRetrieveMail[ftpserver];
              ENDCASE => Abort[functionNotImplemented];
      ENDLOOP;
    END;

  -- **********************!  Default Server Backstop  !***********************

  DefaultBackstopServer: BackstopServer =
    BEGIN
    -- dispatch server
    server[
      !
      FTPError =>
        SELECT ftpError FROM
          IN CommunicationError, IN ProtocolError => CONTINUE;
          IN UnidentifiedError =>
            IF ftpsystem.catchUnidentifiedErrors THEN CONTINUE;
          ENDCASE => RESUME ];
    END;

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

  -- no operation    

  END. -- of FTPServerCommon