
<<FTPServer.mesa>>
<<Last edited by:>>
    <<Bob Hagmann April 7, 1986 9:55:37 am PST>>
    <<Carl Hauser, October 10, 1985 3:03:51 pm PDT>>
DIRECTORY
    BasicTime,
    Convert,
    FTP,
    FTPInternal,
    IO,
    PrincOps,
    Process,
    PupDefs,
    PupRouterDefs,
    PupStream,
    PupTypes,
    RefText,
    Rope,
    RuntimeError;

FTPServer: CEDAR MONITOR
    IMPORTS BasicTime, Convert, FTP, FTPInternal, IO, Process, PupDefs, PupRouterDefs, PupStream, RefText, Rope, RuntimeError
    EXPORTS FTP =
    BEGIN 
    ROPE: TYPE = Rope.ROPE; 
    CARD: TYPE = LONG CARDINAL;

    ReverseCardinal: TYPE = MACHINE DEPENDENT RECORD [high, low: CARDINAL];

    LookupFileType: PupTypes.PupType = LOOPHOLE[200B];
    LookupFileReplyType: PupTypes.PupType = LOOPHOLE[201B];
    LookupFileErrorType: PupTypes.PupType = LOOPHOLE[202B];


    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 = "March 24, 1985 12:32:02 pm PST";

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

    MyName: ROPE _ NIL;


<<FTP.>>
ProcessSocketPair: TYPE = RECORD[
process: PROCESS,
fileInfoPupSocket: PupDefs.PupSocket
];
Listener: TYPE = REF ListenerObject;
ListenerObject: PUBLIC TYPE = RECORD [
socket: PupDefs.PupSocket,
timeout: PupDefs.Tocks,
stop: BOOL,
check: FTP.AcceptProc,
defalut: BOOL,
proc: PROCESS,
    serverProcs: FTP.ServerProcs,
    acceptProc: FTP.AcceptProc,
    processSocketPairs: LIST OF REF ProcessSocketPair _ NIL,
    fileInfo: FTP.FileInfoProc _ NIL
    ];
CreateListener: PUBLIC PROC [socket: PupStream.PupSocketID _ PupTypes.ftpSoc, procs: FTP.ServerProcs, accept: FTP.AcceptProc _ NIL, 
timeoutSeconds: INT _ 30, fileInfo: FTP.FileInfoProc,  fileInfoSocket: PupStream.PupSocketID, fileInfoProcesses: CARDINAL [1..10]] 
RETURNS [l: Listener] = {
    him: Listener = NEW[ListenerObject];
    him.fileInfo _ fileInfo;
    him.socket _ PupDefs.PupSocketMake[socket, PupTypes.fillInPupAddress, PupDefs.veryLongWait];
    him.timeout _ PupDefs.SecondsToTocks[timeoutSeconds];
    him.stop _ FALSE;
    him.check _ accept;
    him.serverProcs _ procs;
    him.defalut _ TRUE;
    him.proc _ FORK Listen[him, socket];
    IF fileInfo # NIL THEN {
        FOR processes: CARDINAL IN [0..fileInfoProcesses) DO
            p: PROCESS;
            lookupSocket: PupDefs.PupSocket;
            pair: REF ProcessSocketPair;
            lookupSocket _ PupDefs.PupSocketMake[fileInfoSocket, PupTypes.fillInPupAddress, PupDefs.MsToTocks[200]];
            p _ FORK FileInfoServer[him, lookupSocket];
            pair _ NEW [ProcessSocketPair _ [p, lookupSocket]];
            him.processSocketPairs _ CONS[pair, him.processSocketPairs];
            ENDLOOP;
        };
    RETURN[him];
    };

DestroyListener: PUBLIC PROC [l: Listener] = TRUSTED {
    l.stop _ TRUE;
    PupDefs.PupSocketKick[l.socket];
    JOIN l.proc;
    PupDefs.PupSocketDestroy[l.socket];
    IF l.fileInfo # NIL AND l.processSocketPairs # NIL THEN {
        FOR pairs: LIST OF REF ProcessSocketPair _ l.processSocketPairs, pairs.rest UNTIL pairs = NIL  DO
            PupDefs.PupSocketKick[pairs.first.fileInfoPupSocket];
            JOIN pairs.first.process;
            PupDefs.PupSocketDestroy[pairs.first.fileInfoPupSocket];
            ENDLOOP;
    };
};

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

<<Internal Procedures>>

    Listen: PROC [listener: Listener, local: PupDefs.PupSocketID] = TRUSTED {
        soc: PupRouterDefs.PupRouterSocket;
        arg: IO.STREAM;
        b: PupDefs.PupBuffer;
        UNTIL listener.stop DO
            b _ listener.socket.get[];
            IF b # NIL THEN {
                SELECT b.pupType FROM
                    rfc => {
                        OPEN PupStream;
                        FOR soc _ PupRouterDefs.GetFirstPupSocket[], soc.next UNTIL soc = NIL DO
                            <<check for duplicate>>
                            IF soc.remote # b.source THEN LOOP;
                            IF soc.id # b.pupID THEN LOOP;
                            b.address _ soc.local;
                            PupDefs.SwapPupSourceAndDest[b];
                            PupDefs.PupRouterSendThis[b];
                            EXIT;
                            ENDLOOP;
                        IF soc = NIL THEN {
                            <<not a duplicate, make a new connection>>
                            him: PupDefs.PupAddress _ b.address;
                            accept: BOOL _ TRUE;
                            reason: ROPE _ NIL;
                            IF listener.check # NIL THEN [accept: accept, reason: reason] _ listener.check[him, Connections];
                            IF ~accept THEN {
                                b.pupType _ abort;
                                PupDefs.SwapPupSourceAndDest[b];
                                PupDefs.SetPupContentsBytes[b, 2];
                                PupDefs.AppendRopeToPupBuffer[b, reason];
                                PupDefs.PupRouterSendThis[b];
                                GOTO Reject;
                                };
                            PupDefs.ReturnFreePupBuffer[b];
                            arg _ PupByteStreamMake[ local, him, listener.timeout, alreadyOpened, b.pupID];
                            Process.Detach[FORK defaultServerRoot[arg, him, listener,  PupDefs.AnyLocalPupAddress[local]]];
                            };
                        EXITS Reject => NULL;
                        };
                    echoMe => {
                        b.pupType _ iAmEcho;
                        PupDefs.SwapPupSourceAndDest[b];
                        PupDefs.PupRouterSendThis[b];
                        };
                    ENDCASE => PupDefs.SendErrorPup[b, LOOPHOLE[100B], "RFC expected"];
                };
            ENDLOOP;
        };

    defaultServerRoot: PROC [stream: IO.STREAM, pupAddress: PupStream.PupAddress, listener: Listener, listenerPupAddress: 
    PupDefs.PupAddress] = {
        <<For every stream accepted by filterProc and created in CreatePupByteStreamListener via CreateListener, this procedure is forked.>>
        bumpConnections[];
        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;
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[];
SELECT mark FROM
retrieve => {
Retrieve[ftpHandle, listener];
};
store  => {
[] _ ftpHandle.GetText[gobbleEOC: TRUE];
ftpHandle.GenerateNo[badCommand, "Command superceded 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, socket: PupDefs.PupSocket] = TRUSTED {
    <<Perform the "Single Packet Protocol for File Info".  Forked as many times as needed.>>
    b: PupDefs.PupBuffer;
    UNTIL him.stop DO
        b _ socket.get[];
        IF b # NIL THEN {
            SELECT b.pupType FROM
                LookupFileType => {
                    fileNameChars: CARDINAL = PupDefs.GetPupContentsBytes[b];
                    file: REF TEXT _ RefText.New[fileNameChars];
                    create: BasicTime.GMT;
                    ok, return: BOOL;
                    bytes: CARD;
                    version: CARDINAL;
                    FOR index: CARDINAL IN [0..fileNameChars) DO
                        file _ RefText.InlineAppendChar[file, b.pupChars[index]];
                        ENDLOOP;
                    [ok, return, version, create, bytes] _ him.fileInfo[Rope.FromRefText[file], b.source];
                    IF ok THEN {
                        ResultRec: TYPE = MACHINE DEPENDENT RECORD[v: CARDINAL, c, l: ReverseCardinal];
                        rPtr: LONG POINTER TO ResultRec = LOOPHOLE[@b.pupBody];
                        altoTime: LONG CARDINAL = BasicTime.ToPupTime[create];
                        b.pupType _ LookupFileReplyType;
                        rPtr.v _ version;
                        rPtr.c _ ReverseCardinalFromLongCard[altoTime];
                        rPtr.l _ ReverseCardinalFromLongCard[bytes];
                        PupDefs.SetPupContentsWords[b, SIZE[ResultRec]];
                        }
                     ELSE {
                        b.pupType _ LookupFileErrorType;
                        PupDefs.SetPupContentsBytes[b, 0];
                        };
                    PupDefs.SwapPupSourceAndDest[b];
                    IF return THEN PupDefs.PupRouterSendThis[b]
                    ELSE PupDefs.ReturnFreePupBuffer[b];
                    };
                ENDCASE => PupDefs.SendErrorPup[b, LOOPHOLE[100B], "File Lookup expected"];
            };
        ENDLOOP;
    };

ReverseCardinalFromLongCard: PROC [r: CARD] RETURNS [ReverseCardinal] = TRUSTED
MACHINE CODE {PrincOps.zEXCH};

<<Init>>
MyName _ PupDefs.GetMyName[];
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>>
    <<>>