-- file: STPsF.mesa - Simple/Stream Transfer Protocol
-- Server stuff in here
-- Edited by:
-- Smokey on: 11-Mar-81 17:07:41
-- Schmidt on: 4-Apr-82 15:04:49
-- (remove Put, Tool, Window dependencies)
DIRECTORY
Directory: TYPE USING [DeleteFile, Error, GetProps, Rename],
Format: TYPE USING [DecimalFormat, LongNumber],
HeapString: TYPE USING [Replace],
PupStream: TYPE USING [
CreatePupByteStreamListener, DestroyPupListener, PupAddress, PupPackageDestroy,
PupPackageMake, PupListener, RejectThisRequest, StreamClosing, veryLongWait],
Segments: TYPE USING [EnumerateDirectory, FileNameProblem, FPHandle, InsertFile, ModifyFile],
Storage: TYPE USING [CopyString, EmptyString, FreeString, FreeStringNil],
STP: TYPE USING [Create, Destroy, Error, GetFileTimes],
STPOps: TYPE USING [
CollectCode, CollectString, GetCommand, GetFile, GetPList, Handle, MakePList,
MakeRemoteName, markDelete, markDirectory, markEOC, markHereIsPList, markIAmVersion,
markNo, markRename, markRetrieve, markNewStore, markYes, MyGetMark, NameToPList, Object,
PList, PutCommand, PutFile, PutPList, ResetPList, SetFileDates],
STPReplyCode: TYPE USING[badCommand, fileBusy, fileNotFound, illegalCommand, illegalNameBody, notCompleted, null],
Stream: TYPE USING [Handle, SetSST, SubSequenceType, TimeOut],
Streams: TYPE USING [CreateStream, Destroy, GetLength, NewStream, Read, SetIndex, Write],
Time: TYPE USING [Append, Packed, Unpack],
TTY: TYPE USING [Create, Handle, PutChar, PutLine, PutOctal, PutString];
STPsF: PROGRAM
IMPORTS Directory, Format, HeapString, PupStream, Segments, Storage, STP,
STPOps, Stream, Streams, Time, TTY
EXPORTS STP =
BEGIN OPEN PupStream, STPOps;
-- Global Data
Object: PUBLIC TYPE = STPOps.Object;
OneListenerPerCustomer: ERROR = CODE;
pupListener: PupListener ← NIL;
PutChar: PROCEDURE [w: TTY.Handle, c: CHARACTER] = INLINE {
IF LOOPHOLE[w, POINTER] # NIL THEN TTY.PutChar[w, c]};
PutLine: PROCEDURE [w: TTY.Handle, s: STRING] = INLINE {
IF LOOPHOLE[w, POINTER] # NIL THEN TTY.PutLine[w, s]};
PutOctal: PROCEDURE [w: TTY.Handle, n: UNSPECIFIED] = INLINE {
IF LOOPHOLE[w, POINTER] # NIL THEN TTY.PutOctal[w, n]};
PutText: PROCEDURE [w: TTY.Handle, s: STRING] = INLINE {
IF LOOPHOLE[w, POINTER] # NIL THEN TTY.PutString[w, s]};
-- Public Interface Routines
CreateListener: PUBLIC PROCEDURE [
server: PROCEDURE[Stream.Handle, PupAddress] ← DefaultServer,
checker: PROCEDURE[PupAddress] ← DefaultChecker,
connections: CARDINAL ← 1] =
BEGIN
IF pupListener = NIL THEN
BEGIN
PupStream.PupPackageMake[];
pupListener ← CreatePupByteStreamListener[
local: [0,3],
proc: server,
ticks: veryLongWait,
filter: checker];
maxConnections ← connections;
END
ELSE ERROR OneListenerPerCustomer;
END;
DestroyListener: PUBLIC PROCEDURE =
BEGIN
IF pupListener # NIL THEN
BEGIN
PupStream.DestroyPupListener[pupListener];
PupStream.PupPackageDestroy[];
END;
END;
-- Server stuff
DefaultChecker: PUBLIC PROCEDURE [address: PupAddress] =
BEGIN END;
DefaultServer: PUBLIC PROCEDURE [byteStream: Stream.Handle, address: PupAddress] =
BEGIN STPServer[LOOPHOLE[NIL], byteStream, address]; END;
STPServer: PUBLIC PROCEDURE [w: TTY.Handle, byteStream: Stream.Handle, address: PupAddress] =
BEGIN -- this guy gets FORKed for every accepted RFC
file: STRING ← NIL;
stream: Stream.Handle ← NIL;
mark: Stream.SubSequenceType;
stp: STPOps.Handle ← STP.Create[];
stp.byteStream ← byteStream;
stp.plist ← STPOps.MakePList[];
stp.gotMark ← FALSE;
PutText[w, "Connection opened to ["L];
PutOctal[w, address.net];
PutText[w, "#, "L];
PutOctal[w, address.host];
PutText[w, "# ["L];
PutOctal[w, address.socket.a];
PutText[w, "#, "L];
PutOctal[w, address.socket.b];
PutLine[w, "#]]"L];
DO ENABLE PupStream.StreamClosing, Stream.TimeOut =>
{stp.byteStream ← NIL; PutLine[w, " ...Connection Closed"L]; EXIT};
SELECT mark ← STPOps.MyGetMark[stp] FROM
markDelete => DoFiles[w, stp, delete];
markDirectory => DoFiles[w, stp, directory];
markIAmVersion =>
BEGIN
[] ← STPOps.CollectCode[stp];
STPOps.CollectString[stp, @stp.remoteString];
IF ~NextEOC[stp] THEN EXIT;
STPOps.PutCommand[stp, markIAmVersion, 1C, "Cedar STP: You called?"L];
END;
markNewStore =>
BEGIN
STPOps.ResetPList[stp.plist];
STPOps.GetPList[stp, TRUE];
file ← STPOps.MakeRemoteName[stp.plist, alto];
IF ~Segments.ModifyFile[file] THEN
STPOps.PutCommand[stp, markNo, STPReplyCode.fileBusy, "can't be modified"L]
ELSE
BEGIN
IF ~Storage.EmptyString[file] THEN stream ← Streams.NewStream[file, Streams.Write !
Segments.FileNameProblem[] => CONTINUE];
IF stream # NIL THEN
BEGIN
STPOps.PutPList[stp, markHereIsPList];
IF STPOps.GetFile[stp, stream, file ! STP.Error => EXIT] AND NextEOC[stp] THEN
BEGIN
PutCommand[stp, markYes, STPReplyCode.null, "Transfer completed"L];
PutText[w, " Stored: "L];
PutProperties[w, stp.plist];
END
ELSE
PutCommand[stp, markNo, STPReplyCode.notCompleted, "Store not completed"L];
STPOps.SetFileDates[stp, stream];
Streams.Destroy[stream];
stream ← NIL;
END
ELSE PutCommand[stp, markNo, STPReplyCode.illegalNameBody, "Illegal Filename"L];
END;
file ← Storage.FreeStringNil[file];
END;
markRename =>
BEGIN
newName: STRING ← NIL;
failed: BOOLEAN ← FALSE;
STPOps.ResetPList[stp.plist];
STPOps.GetPList[stp, FALSE];
file ← STPOps.MakeRemoteName[stp.plist, alto];
STPOps.ResetPList[stp.plist];
STPOps.GetPList[stp, TRUE];
newName ← STPOps.MakeRemoteName[stp.plist, alto];
IF Segments.ModifyFile[file] THEN
Directory.Rename[file, newName ! Directory.Error => {failed ← TRUE; CONTINUE}]
ELSE failed ← TRUE;
IF failed THEN PutCommand[stp, markNo, STPReplyCode.null, "Rename failed"L]
ELSE
BEGIN
PutCommand[stp, markYes, STPReplyCode.null, "... renamed"L];
PutText[w, " Renamed: "L];
PutText[w, file];
PutText[w, " to be "L];
PutLine[w, newName];
END;
file ← Storage.FreeStringNil[file];
newName ← Storage.FreeStringNil[file];
END;
markRetrieve => DoFiles[w, stp, retrieve];
ENDCASE =>
BEGIN
STPOps.PutCommand[stp, markNo, STPReplyCode.badCommand, "Bad or Unimplemented Command"L];
EXIT;
END;
ENDLOOP;
Storage.FreeString[file];
IF stream # NIL THEN Streams.Destroy[stream];
stp ← STP.Destroy[stp];
currentConnections ← currentConnections - 1;
END;
DoFiles: PROCEDURE [w: TTY.Handle, stp: STPOps.Handle, type : {delete, directory, retrieve}] =
BEGIN
file: STRING ← NIL;
stream: Stream.Handle ← NIL;
mark: Stream.SubSequenceType;
code: CHARACTER;
foundAtLeastOne: BOOLEAN ← FALSE;
pendingName: STRING ← NIL;
DoPendingDelete: PROCEDURE =
BEGIN
IF pendingName = NIL THEN RETURN;
Directory.DeleteFile[pendingName];
pendingName ← Storage.FreeStringNil[pendingName];
END;
PerFile: PROCEDURE [cap: Segments.FPHandle, name: STRING] RETURNS[BOOLEAN] =
BEGIN ENABLE UNWIND =>
BEGIN
Storage.FreeString[file];
IF stream # NIL THEN Streams.Destroy[stream];
END;
foundAtLeastOne ← TRUE;
STPOps.ResetPList[stp.plist];
SELECT type FROM
delete =>
BEGIN
DoPendingDelete[];
SetPropertiesFromFP[stp, name, cap];
STPOps.PutPList[stp, markHereIsPList, TRUE];
[mark, code] ← STPOps.GetCommand[stp, @stp.remoteString];
IF ~NextEOC[stp] THEN
BEGIN
STPOps.PutCommand[stp, markNo, STPReplyCode.illegalCommand, "Protocol Error"L];
RETURN[TRUE];
END;
IF mark = markYes THEN
BEGIN
IF ~Segments.ModifyFile[name] THEN
STPOps.PutCommand[stp, markNo, STPReplyCode.fileBusy, "can't be modified"L, FALSE]
ELSE
BEGIN
PutText[w, " Deleted: "L];
PutProperties[w, stp.plist];
pendingName ← Storage.CopyString[name];
STPOps.PutCommand[stp, markYes, STPReplyCode.null, "file deleted"L, FALSE]
END;
END;
END;
directory =>
BEGIN
SetPropertiesFromFP[stp, name, cap];
STPOps.PutPList[stp, markHereIsPList, FALSE];
END;
retrieve =>
BEGIN
stream ← Streams.CreateStream[Segments.InsertFile[cap, Streams.Read], Streams.Read];
IF stream # NIL THEN
BEGIN
STPOps.ResetPList[stp.plist];
SetPropertiesFromStream[stp, name, stream];
STPOps.PutPList[stp, markHereIsPList];
[mark, code] ← STPOps.GetCommand[stp, @stp.remoteString];
IF ~NextEOC[stp] THEN
BEGIN
STPOps.PutCommand[stp, markNo, STPReplyCode.illegalCommand, "Protocol Error"L];
RETURN[TRUE];
END;
IF mark = markYes THEN STPOps.PutFile[stp, stream, name, FALSE];
Streams.Destroy[stream];
stream ← NIL;
PutText[w, " Retrieved: "L];
PutProperties[w, stp.plist];
END
ELSE PutCommand[stp, markNo, STPReplyCode.fileNotFound, "File not found"L];
END;
ENDCASE => ERROR;
RETURN[FALSE];
END;
STPOps.GetPList[stp, TRUE];
file ← STPOps.MakeRemoteName[stp.plist, alto];
Segments.EnumerateDirectory[PerFile, file];
IF type = delete THEN DoPendingDelete[];
file ← Storage.FreeStringNil[file];
IF foundAtLeastOne THEN Stream.SetSST[stp.byteStream, markEOC]
ELSE STPOps.PutCommand[stp, markNo, STPReplyCode.fileNotFound, "File not found"L];
END;
NextEOC: PROCEDURE [stp: STPOps.Handle] RETURNS [BOOLEAN] =
BEGIN
IF MyGetMark[stp] = markEOC THEN RETURN[TRUE]
ELSE
BEGIN
STPOps.PutCommand[stp, markNo, STPReplyCode.illegalCommand, "Protocol Error"L];
RETURN[FALSE];
END;
END;
PutProperties: PROCEDURE [w: TTY.Handle, plist: STPOps.PList] =
BEGIN OPEN Storage;
IF ~EmptyString[plist[nameBody]] THEN PutText[w, plist[nameBody]]
ELSE IF ~EmptyString[plist[serverName]] THEN PutText[w, plist[serverName]];
IF ~EmptyString[plist[version]] THEN {PutChar[w, '!]; PutText[w, plist[version]]};
PutText[w, " Type "L];
PutText[w, IF ~EmptyString[plist[type]] THEN plist[type] ELSE "unknown"L];
IF ~EmptyString[plist[byteSize]] THEN
{PutText[w, ", ByteSize "L]; PutText[w, plist[byteSize]]};
PutText[w, "..."L];
IF ~EmptyString[plist[size]] THEN {PutText[w, plist[size]]; PutText[w, " bytes"L]};
PutChar[w, '\n];
END;
SetPropertiesFromStream: PROCEDURE [stp: STPOps.Handle, file: STRING, stream: Stream.Handle] =
BEGIN
length: LONG CARDINAL ← Streams.GetLength[stream];
create, read, write: Time.Packed;
Streams.SetIndex[stream, 0]; -- undo GetLength
[create: create, read: read, write: write] ← STP.GetFileTimes[stream];
SetTimesPlus[stp, file, length, create, read, write];
END;
SetPropertiesFromFP: PROCEDURE [stp: STPOps.Handle, file: STRING, fp: Segments.FPHandle] =
BEGIN
length: LONG CARDINAL;
create, read, write: Time.Packed;
[createDate: create,
readDate: read,
writeDate: write,
byteLength: length,
parent: ] ← Directory.GetProps[fp↑, file];
SetTimesPlus[stp, file, length, create, read, write];
END;
SetTimesPlus: PROCEDURE [
stp: STPOps.Handle, file:STRING, length: LONG CARDINAL, create, read, write: Time.Packed] =
BEGIN
proc: PROCEDURE [s: STRING] = {HeapString.Replace[@stp.plist[size], s]};
temp: STRING ← [24];
Time.Append[temp,Time.Unpack[create]];
HeapString.Replace[@stp.plist[createDate], temp];
temp.length ← 0;
Time.Append[temp,Time.Unpack[write]];
HeapString.Replace[@stp.plist[writeDate], temp];
temp.length ← 0;
Time.Append[temp,Time.Unpack[read]];
HeapString.Replace[@stp.plist[readDate], temp];
NameToPList[stp.plist, file, alto];
HeapString.Replace[@stp.plist[byteSize], "8"L];
Format.LongNumber[length, Format.DecimalFormat, proc];
END;
-- Testing code
currentConnections: CARDINAL ← 0;
maxConnections: CARDINAL ← 0;
logSW: TTY.Handle ← TTY.Create["STPServer.Log"L];
CheckConnectionRequest: PUBLIC PROCEDURE [address: PupAddress] =
BEGIN
IF currentConnections < maxConnections THEN currentConnections ← currentConnections + 1
ELSE ERROR RejectThisRequest["Connection rejected - Too many connections"];
END;
CreateSTPServer: PUBLIC PROCEDURE [byteStream: Stream.Handle, address: PupAddress] =
BEGIN -- this guy gets FORKed for every accepted RFC
STPServer[logSW, byteStream, address];
END;
CreateListener[CreateSTPServer, CheckConnectionRequest, 1];
END. -- of STPsF