Last edited by:
Bob Hagmann April 7, 1986 9:55:37 am PST
Carl Hauser, October 10, 1985 3:03:51 pm PDT
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;
};
};
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];
}
};
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[];
};
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[];
};
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[];
};
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[];
};
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];
};
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};
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