
<<FTPServer.mesa>>
<<Last edited by:>>
    <<Bob Hagmann April 7, 1986 9:55:37 am PST>>
    <<Carl Hauser, May 6, 1986 4:45:33 pm PDT>>
    <<Hal Murray, June 4, 1986 0:48:55 am PDT>>
DIRECTORY
    BasicTime,
    Convert,
    Endian USING [FFromCard],
    FTP,
    FTPInternal,
    IO,
    Pup USING [Address, nullSocket, Socket],
    PupBuffer USING [Buffer, FileLookupReply],
    PupName USING [MyName],
    PupSocket USING [CreateServer, Destroy, FreeBuffer, Get, ExtractRope, Kick, ReturnError, ReturnToSender, SetUserBytes, SetUserSize, 
    Socket, waitForever],
    PupStream USING [CloseReason, CreateListener, DestroyListener, Listener, StreamClosing, Timeout],
    PupWKS USING [fileLookup, ftp],
    PupType USING [fileLookup, fileLookupError, fileLookupReply],
    Rope,
    RuntimeError USING [UNCAUGHT];

FTPServer: CEDAR MONITOR
    IMPORTS BasicTime, Convert, Endian, FTP, FTPInternal, IO, PupName, PupSocket, PupStream, Rope, RuntimeError
    EXPORTS FTP =
    BEGIN 
    ROPE: TYPE = Rope.ROPE; 
    CARD: TYPE = LONG CARDINAL;

    Connections: INT _ 0;  -- number of existing connections that have not yet been destroyed
    debugging: BOOL _ TRUE;
    versionRope: ROPE = Convert.RopeFromCard[from: FTPInternal.ftpVersion, showRadix: FALSE] ;
    versionDate: ROPE = "April 11, 1986 8:01:52 am PST";

    Object: PUBLIC TYPE = FTPInternal.Object;
    Handle: TYPE = FTPInternal.Handle;

    myName: ROPE _ PupName.MyName[];


<<FTP.>>
Listener: TYPE = REF ListenerObject;
ListenerObject: PUBLIC TYPE = RECORD [
listener: PupStream.Listener,
filter: FTP.AcceptProc,
    serverProcs: FTP.ServerProcs,
    fileInfo: FTP.FileInfoProc _ NIL,
    fileInfoSocket: PupSocket.Socket _ NIL,
    fileInfoWorkers: LIST OF PROCESS _ NIL
    ];
CreateListener: PUBLIC PROC [socket: Pup.Socket _ Pup.nullSocket, procs: FTP.ServerProcs, accept: FTP.AcceptProc _ NIL, 
timeoutSeconds: INT _ 30, fileInfo: FTP.FileInfoProc,  fileInfoSocket: Pup.Socket _ Pup.nullSocket, fileInfoProcesses: CARDINAL 
[1..10]] RETURNS [l: Listener] = {
    him: Listener = NEW[ListenerObject];
    IF socket = Pup.nullSocket THEN socket _ PupWKS.ftp;
    IF fileInfoSocket = Pup.nullSocket THEN fileInfoSocket _ PupWKS.fileLookup;
    him.fileInfo _ fileInfo;
    him.listener _ PupStream.CreateListener[
        local: socket,
        worker: Worker,
        getTimeout: timeoutSeconds*1000,
        putTimeout: timeoutSeconds*1000,
        clientData: him,
        filter: Filter, -- NIL => Accept all requests
        echoFilter: NIL]; -- NIL => Answer all echos
    him.filter _ accept;
    him.serverProcs _ procs;
    IF fileInfo # NIL THEN {
        him.fileInfoSocket _ PupSocket.CreateServer[
            recvBuffers: fileInfoProcesses * 2,
            local: fileInfoSocket,
            getTimeout: PupSocket.waitForever ];
        FOR processes: CARDINAL IN [0..fileInfoProcesses) DO
            him.fileInfoWorkers _ CONS[FORK FileInfoServer[him], him.fileInfoWorkers];
            ENDLOOP;
        };
    RETURN[him];
    };

DestroyListener: PUBLIC PROC [l: Listener] = {
    PupStream.DestroyListener[l.listener];
    FOR p: LIST OF PROCESS _ l.fileInfoWorkers, p.rest UNTIL p = NIL DO
        PupSocket.Kick[l.fileInfoSocket];
        ENDLOOP;
    FOR p: LIST OF PROCESS _ l.fileInfoWorkers, p.rest UNTIL p = NIL DO
        TRUSTED { JOIN p.first; };
        ENDLOOP;
    IF l.fileInfoSocket # NIL THEN PupSocket.Destroy[l.fileInfoSocket];
};

Server: PUBLIC PROC [stream: IO.STREAM, procs: FTP.ServerProcs] = {
him: Listener = NEW[ListenerObject];
him.serverProcs _ procs;
innerServer[stream, him];
}; 

<<Internal Procedures>>

Filter: PROC [clientData: REF ANY, remote: Pup.Address] RETURNS [reject: ROPE] = {
listener: Listener = NARROW[clientData];
    accept: BOOL _ TRUE;
    IF listener.filter # NIL THEN [accept: accept, reason: reject] _ listener.filter[remote, Connections];
IF accept THEN { bumpConnections[]; RETURN[NIL]; };
IF reject = NIL THEN reject _ "Rejected";
}; 

Worker: PROC [stream: IO.STREAM, clientData: REF ANY, remote: Pup.Address] = {
listener: Listener = NARROW[clientData];
    innerServer[stream, listener];
    debumpConnections[];
    stream.Close[ ];
}; 

innerServer: PROC [stream: IO.STREAM, listener: Listener] = {
closing: BOOLEAN _ FALSE;
closeReason: PupStream.CloseReason _ localAbort;
{
ENABLE {
PupStream.StreamClosing => {closeReason _ why; closing _ TRUE; GOTO Exit};
PupStream.Timeout => {closeReason _ transmissionTimeout; closing _ TRUE; GOTO Exit};
RuntimeError.UNCAUGHT => IF NOT debugging THEN {closeReason _ localAbort; GOTO Exit};
ABORTED, UNWIND => {closeReason _ localAbort; GOTO Exit};
};
ftpHandle: Handle;
remoteHerald: ROPE;
AFew: CARDINAL = 6;
Index: TYPE = [0..AFew);
lastFewMarks: RECORD[
index: Index _ 0,
buffer: ARRAY Index OF FTPInternal.Mark _ ALL[comment]
];
ftpHandle _ NEW[Object _ []];
ftpHandle.pList[local] _ NEW[FTPInternal.PListObject];
ftpHandle.byteStream _ stream;
remoteHerald _ AwaitCallingMessage[ftpHandle];
IF NOT closing THEN SendHerald[ftpHandle, listener, remoteHerald];
UNTIL closing DO
mark: FTPInternal.Mark;
    code: FTP.FailureCode;
[mark, code] _ ftpHandle.GetCommand[];
lastFewMarks.buffer[lastFewMarks.index] _ mark;
lastFewMarks.index _ (lastFewMarks.index + 1) MOD AFew;
SELECT mark FROM
retrieve => {
Retrieve[ftpHandle, listener];
};
store  => {
[] _ ftpHandle.GetText[gobbleEOC: TRUE];
ftpHandle.GenerateNo[badCommand, "Command superseded by NewStore"];
};
comment => {
<<    ignore comments>>
[] _ ftpHandle.GetText[gobbleEOC: FALSE];
};
newStore => {
Store[ftpHandle, listener];
};
enumerate  => {
Enumeration[ftpHandle, listener, enumerate];
};
newEnumerate => {
Enumeration[ftpHandle, listener, newEnumerate];
};
delete  => {
Delete[ftpHandle, listener];
};
rename => {
Rename[ftpHandle, listener]
};
ENDCASE => {
[] _ ftpHandle.GetText[gobbleEOC: TRUE];
ftpHandle.GenerateNo[badCommand, "Command undefined or unimplemented"];
};
ENDLOOP;
EXITS
Exit => NULL;
};
};
AwaitCallingMessage: PROC [h: Handle] RETURNS [msg: ROPE] = {
mark: FTPInternal.Mark;
    code: FTP.FailureCode;
[mark, code] _ h.GetCommand[];
WHILE mark # version OR code # LOOPHOLE[FTPInternal.ftpVersion]  DO
IF mark # version THEN {
h.GenerateFailed[protocolError, "First command must be version"];
[mark, code] _ h.GetCommand[];
LOOP;
};
h.GenerateFailed[protocolError, "Incompatible protocol version"];
ENDLOOP;
msg _ h.GetText[gobbleEOC: TRUE];
};
SendHerald: PROC [h: Handle, l: Listener, remoteHerald: ROPE] = {
localHerald: ROPE  _ Rope.Cat[myName, " Cedar FTP Version ", versionRope, "File server of ", versionDate];
IF l.serverProcs.version # NIL THEN localHerald _ l.serverProcs.version[h, remoteHerald];
h.PutCommand[mark: version, code: LOOPHOLE[FTPInternal.ftpVersion], text: localHerald, sendEOC: TRUE];
};

Retrieve: PROC [ftpHandle: Handle, listener: Listener] = {
xferOK: BOOL;
comp: FTP.ServerCompleteProc = {
IF xferOK THEN ftpHandle.PutCommand[mark: yes, text: "Transfer complete", sendEOC: FALSE];
RETURN[xferOK];
};
confirm: FTP.ConfirmTransferProc = {
mark: FTPInternal.Mark;
    code: FTP.FailureCode;
ftpHandle.PutCommandAndPList[mark: hereIsPList, pList: ftpHandle.pList[local], sendEOC: TRUE];
[mark, code] _ ftpHandle.GetCommand[];
SELECT mark FROM
yes => {
xferOK _ TRUE;
[] _ ftpHandle.GetText[gobbleEOC: TRUE];
};
    no => {
        [] _ ftpHandle.GetText[gobbleEOC: TRUE];
        xferOK _ FALSE;
        };
ENDCASE => ftpHandle.GenerateFailed[protocolError];
IF xferOK THEN {
ftpHandle.PutCommand[mark: hereIsFile];
RETURN [ftpHandle.byteStream];
}
 ELSE {
RETURN [NIL];
};
};
ftpHandle.pList[remote] _ ftpHandle.GetPList[gobbleEOC: TRUE];
IF listener.serverProcs.checkCredentials # NIL THEN {
listener.serverProcs.checkCredentials[ftpHandle ! FTP.Failed =>  {
ftpHandle.GenerateNo[code: IF code = protocolError THEN transientError ELSE code, text: text, sendEOC: TRUE];
GOTO return;
};
 ];
};
listener.serverProcs.retrieve[h: ftpHandle, confirm: confirm, complete: comp ! FTP.Failed => {
ftpHandle.PutCommand[mark: no, code: IF code = protocolError THEN transientError ELSE code, text: text, sendEOC: ~resumable];
IF resumable THEN RESUME ELSE GOTO return;
};
 ];
ftpHandle.PutEOC[];
EXITS
return => RETURN;
};

Store: PROC [ftpHandle: Handle, listener: Listener] = {
xferOK: BOOL;
comp: FTP.ServerCompleteProc = {
xferOK _ ftpHandle.GetYesNo[gobbleEOC: TRUE];
IF xferOK THEN ftpHandle.PutCommand[mark: yes, text: "Transfer Completed", sendEOC: FALSE];
RETURN[xferOK];
};
confirm: FTP.ConfirmTransferProc = {
mark: FTPInternal.Mark;
    code: FTP.FailureCode;
ftpHandle.PutCommandAndPList[mark: hereIsPList, pList: ftpHandle.pList[local], sendEOC: TRUE];
[mark, code] _ ftpHandle.GetCommand[];
SELECT mark FROM
hereIsFile => {
RETURN [ftpHandle.byteStream];
};
    no => {
        [] _ ftpHandle.GetText[gobbleEOC: TRUE];
    RETURN [NIL];
        };
ENDCASE => ftpHandle.GenerateFailed[protocolError];
};
ftpHandle.pList[remote] _ ftpHandle.GetPList[gobbleEOC: TRUE];
IF listener.serverProcs.checkCredentials # NIL THEN {
listener.serverProcs.checkCredentials[ftpHandle ! FTP.Failed =>  {
ftpHandle.GenerateNo[code: IF code = protocolError THEN transientError ELSE code, text: text, sendEOC: TRUE];
GOTO return;
};
 ];
};
listener.serverProcs.store[h: ftpHandle, confirm: confirm, complete: comp ! FTP.Failed => {
ftpHandle.PutCommand[mark: no, code: IF code = protocolError THEN transientError ELSE code, text: text, sendEOC: ~resumable];
IF resumable THEN RESUME ELSE GOTO return;
};
 ];
ftpHandle.PutEOC[];
EXITS
return => RETURN;
};

Enumeration: PROC [ftpHandle: Handle, listener: Listener, protocol: {enumerate, newEnumerate}] = {
firstTime: BOOL _ TRUE;
noteFileProc: PROC[h: Handle] = {
IF firstTime OR protocol= enumerate THEN h.PutCommand[mark: hereIsPList];
firstTime _ FALSE;
h.PutPList[pList: h.pList[local]];
};
ftpHandle.pList[remote] _ ftpHandle.GetPList[gobbleEOC: TRUE];
IF listener.serverProcs.checkCredentials # NIL THEN {
listener.serverProcs.checkCredentials[ftpHandle ! FTP.Failed =>  {
ftpHandle.GenerateNo[code: IF code = protocolError THEN transientError ELSE code, text: text, sendEOC: TRUE];
GOTO return;
};
 ];
};
listener.serverProcs.enumerate[h: ftpHandle, noteFile: noteFileProc ! FTP.Failed => {
ftpHandle.PutCommand[mark: no, code: IF code = protocolError THEN transientError ELSE code, text: text, sendEOC: ~resumable];
IF resumable THEN RESUME ELSE GOTO return;
};
 ];
IF firstTime THEN {
ftpHandle.GenerateNo[code: fileNotFound, text: "File not found.", sendEOC: TRUE];
}
 ELSE ftpHandle.PutEOC[];
EXITS
return => RETURN;
};

Delete: PROC [ftpHandle: Handle, listener: Listener] = {
deleteOK: BOOL;
comp: FTP.ServerCompleteProc = {
IF deleteOK THEN ftpHandle.PutCommand[mark: yes, text: "Delete OK", sendEOC: FALSE];
RETURN[deleteOK];
};
confirm: FTP.ConfirmProc = {
mark: FTPInternal.Mark;
    code: FTP.FailureCode;
ftpHandle.PutCommandAndPList[mark: hereIsPList, pList: ftpHandle.pList[local], sendEOC: TRUE];
[mark, code] _ ftpHandle.GetCommand[];
deleteOK _ TRUE;
SELECT mark FROM
yes => {
[] _ ftpHandle.GetText[gobbleEOC: TRUE];
RETURN [TRUE];
};
    no => {
        [] _ ftpHandle.GetText[gobbleEOC: TRUE];
        RETURN [FALSE];
        };
ENDCASE => ftpHandle.GenerateFailed[protocolError];
};
ftpHandle.pList[remote] _ ftpHandle.GetPList[gobbleEOC: TRUE];
IF listener.serverProcs.checkCredentials # NIL THEN {
listener.serverProcs.checkCredentials[ftpHandle ! FTP.Failed =>  {
deleteOK _ FALSE;
ftpHandle.GenerateNo[code: IF code = protocolError THEN transientError ELSE code, text: text, sendEOC: TRUE];
GOTO return;
};
 ];
};
listener.serverProcs.delete[h: ftpHandle, confirm: confirm, complete: comp ! FTP.Failed => {
ftpHandle.PutCommand[mark: no, code: IF code = protocolError THEN transientError ELSE code, text: text, sendEOC: ~resumable];
IF resumable THEN RESUME ELSE GOTO return;
};
 ];
ftpHandle.PutEOC[];
EXITS
return => RETURN;
};
Rename: PROC [ftpHandle: Handle, listener: Listener] = {
ftpHandle.pList[remote] _ ftpHandle.GetPList[gobbleEOC: FALSE];
ftpHandle.pList[local] _ ftpHandle.GetPList[gobbleEOC: TRUE];
IF listener.serverProcs.checkCredentials # NIL THEN {
listener.serverProcs.checkCredentials[ftpHandle ! FTP.Failed =>  {
ftpHandle.GenerateNo[code: IF code = protocolError THEN transientError ELSE code, text: text, sendEOC: TRUE];
GOTO return;
};
 ];
};
listener.serverProcs.rename[h: ftpHandle ! FTP.Failed => {
ftpHandle.PutCommand[mark: no, code: IF code = protocolError THEN transientError ELSE code, text: text, sendEOC: ~resumable];
IF resumable THEN RESUME ELSE GOTO return;
};
 ];
ftpHandle.PutCommand[mark: yes, text: "Rename OK", sendEOC: TRUE];
EXITS
return => RETURN;
};

bumpConnections: ENTRY PROC = {
Connections _ Connections + 1;
};
debumpConnections: ENTRY PROC = {
Connections _ Connections - 1;
};

<<Single Packet Protocol for File Info>>
FileInfoServer: PROC [him: Listener] = TRUSTED {
    <<Perform the "Single Packet Protocol for File Info".  Forked as many times as needed.>>
    socket: PupSocket.Socket _ him.fileInfoSocket;
    DO
        b: PupBuffer.Buffer _ PupSocket.Get[socket];
        IF b = NIL THEN EXIT;
        SELECT b.type FROM
            PupType.fileLookup => {
                fileName: ROPE _ PupSocket.ExtractRope[b];
                create: BasicTime.GMT;
                ok, return: BOOL;
                bytes: CARD;
                version: CARDINAL;
                [ok, return, version, create, bytes] _ him.fileInfo[fileName, b.source];
                IF ok THEN {
                    altoTime: LONG CARDINAL = BasicTime.ToPupTime[create];
                    b.type _ PupType.fileLookupReply;
                    b.fileLookupReply _ [
                        version: version,
                        createTime: Endian.FFromCard[altoTime],
                        length: Endian.FFromCard[bytes] ];
                    PupSocket.SetUserSize[b, SIZE[PupBuffer.FileLookupReply]];
                    }
                 ELSE {
                    b.type _ PupType.fileLookupError;
                    PupSocket.SetUserBytes[b, 0];
                    };
                IF return THEN PupSocket.ReturnToSender[b]
                ELSE PupSocket.FreeBuffer[b];
                };
            ENDCASE => PupSocket.ReturnError[b, LOOPHOLE[100B], "File Lookup expected"];
        ENDLOOP;
    };

<<Init>>
END.


    <<Bob Hagmann April 7, 1986 9:54:30 am PST>>
        <<mapped protocolError to transientError while catching FTP.Failed.  protocolError is local and cannot be sent via the protocol.>>
        <<changes to: Retrieve, Store, Enumeration, Delete, Rename>>
    <<>>