-- file: FTPServerCommon.mesa, edit: HGM November 12, 1979 5:31 PM
-- Edited for Grapevine DL expansion kludge
-- Randy Gobbel 20-May-81 15:05:31
-- Andrew Birrell September 10, 1982 11:27 am
-- Mark Johnson 19-May-81 13:19:51
-- Mike Schroeder June 29, 1982 7:44 AM

-- Copyright Xerox Corporation 1979, 1980

DIRECTORY
FTPDefs:FROM "FTPDefs",
FTPPrivateDefs:FROM "FTPPrivateDefs",
String:FROM "String"USING [AppendChar, AppendDecimal, AppendString],
Storage:FROM "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 (can’t use constructor because of CONDITION in queue)
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, "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 NOT 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;
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 => FunctionNotImplemented[ftpserver]
ELSE SELECT mark FROM -- mail
markStoreMail => PTFStoreMail[ftpserver];
markRetrieveMail => PTFRetrieveMail[ftpserver];
--GV-- markRetrieve => PTFRetrieve[ftpserver];
ENDCASE => FunctionNotImplemented[ftpserver];
ENDLOOP;
END;

FunctionNotImplemented: PROCEDURE [ftpserver: FTPServer] =
BEGIN
GetEOC[ftpserver.ftper];
PutCommandAndEOC[ftpserver.ftper, markNo, codeCommandUndefined];
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