-- 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