-- file: FTPServerCommon.mesa, edit: HGM July 28, 1980  9:09 PM  

-- Copyright  Xerox Corporation 1979, 1980

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

FTPServerCommon: PROGRAM
  -- import list
    IMPORTS String, Storage, FTPDefs, FTPPrivateDefs
  -- export list
    EXPORTS FTPDefs
  -- share list
    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^ _ FTPListenerObject[
      filePrimitives: filePrimitives,
      mailPrimitives: mailPrimitives,
      communicationPrimitives: communicationPrimitives,
      communicationSystem: NIL,
      backstopServer: IF backstopServer # NIL THEN backstopServer^ ELSE DefaultBackstopServer,
      backstopServerData: backstopServerData,
      ftpCharterObject: [ftplistener: ftplistener, purpose: files],
      mtpCharterObject: [ftplistener: ftplistener, purpose: mail],
      ftpPort: NIL, mtpPort: NIL,
      serverQueueObject: ];
  -- 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, "FTP "L];
    String.AppendDecimal[localInsignia, ftpMajorVersion];
    String.AppendChar [localInsignia, majorMinorSeparator];
    String.AppendDecimal[localInsignia, ftpMinorVersion];
    String.AppendString[localInsignia, " Alto/Mesa "L];
    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;
        markYouAreUser, 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       => Abort[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