STPServerImpl.mesa
Copyright (C) 1984, 1985 Xerox Corporation. All rights reserved.
Michael Plass, August 22, 1985 3:50:50 pm PDT
Jim Gasbarro, March 8, 1985 11:39:14 am PST
Russ Atkinson (RRA) June 21, 1985 1:05:20 pm PDT
*** Remember to update the date in heraldMessage when you make changes.
DIRECTORY
Ascii USING [Digit, Letter],
Atom USING [GetPropFromList, PutPropOnList],
Basics USING [bytesPerWord, LongNumber, SwapHalves],
BasicTime USING [GMT, MonthOfYear, Now, nullGMT, Period, ToPupTime, Unpack, Unpacked],
CedarProcess USING [Abort, CheckAbort, Fork, ForkableProc, Process],
Commander USING [CommandProc, Register],
CommandTool USING [ArgumentVector, Failed, Parse],
Convert USING [Error, IntFromRope, RopeFromInt],
File USING [GetVolumeName, SystemVolume],
FS USING [Close, ComponentPositions, Delete, EnumerateForInfo, EnumerateForNames, Error, ErrorGroup, ExpandName, FileInfo, GetInfo, GetName, OpenFile, OpenFileFromStream, Rename, SetByteCountAndCreatedTime, StreamOpen],
FSRemoteFile USING [FTPTimeToGMT],
GVBasics USING [MakeKey, Password],
GVNames USING [AuthenticateKey, IsMemberClosure],
Icons USING [DrawIcon, IconFileFormat, IconFlavor, iconH, IconRef, IconRep, iconW, NewIcon],
Imager USING [Context, MaskBox, SetColor],
ImagerBackdoor USING [invert],
IO USING [Backup, Close, EndOf, EndOfStream, Error, GetBlock, GetChar, GetLength, PutBlock, PutChar, PutF, PutF1, PutRope, RIS, RopeFromROS, ROS, SetIndex, STREAM, UnsafeGetBlock],
List USING [LORA, Reverse],
Process USING [MsecToTicks, Pause],
PupDefs USING [GetHopsToNetwork, GetHostName, GetPupContentsBytes, PupBuffer, PupSocket, PupSocketDestroy, PupSocketMake, ReturnPup, veryLongWait],
PupStream USING [CloseReason, ConsumeMark, CreatePupByteStreamListener, DestroyPupListener, PupListener, SecondsToTocks, SendMark, StreamClosing, TimeOut],
PupTypes USING [fillInPupAddress, ftpSoc, Pair, PupAddress, PupSocketID, PupType],
Real USING [RoundLI],
RefText USING [AppendChar, ObtainScratch, ReleaseScratch, TrustTextAsRope],
Rope USING [Cat, Concat, Equal, Fetch, Find, Flatten, FromRefText, Length, Replace, ROPE, SkipTo, Substr],
RopeFile USING [Create],
RuntimeError USING [UNCAUGHT],
STP USING [ValidProperties],
STPOps USING [markComment, markDelete, markDirectory, markEOC, markHereIsFile, markHereIsPList, markIAmVersion, markNewDirectory, markNewStore, markNo, markRetrieve, markStore, markYes],
STPReplyCode USING [ReplyCode],
SymTab USING [Create, Delete, Fetch, Ref, Store],
TiogaOps USING [GetSelection],
TypeScript USING [Create],
UserCredentials USING [Get],
ViewerClasses USING [PaintProc, Viewer, ViewerClass, ViewerClassRec],
ViewerIO USING [CreateViewerStreams, GetViewerFromStream],
ViewerOps USING [AddProp, DestroyViewer, FetchProp, FetchViewerClass, PaintViewer];
STPServerImpl: CEDAR MONITOR
IMPORTS Ascii, Atom, Basics, BasicTime, Commander, CommandTool, Convert, CedarProcess, File, FS, FSRemoteFile, Imager, ImagerBackdoor, GVBasics, GVNames, Icons, IO, List, Process, PupDefs, PupStream, Real, RefText, Rope, RopeFile, RuntimeError, SymTab, TiogaOps, TypeScript, UserCredentials, ViewerIO, ViewerOps
~ BEGIN
heraldMessage: ROPE ← "Cedar STP Server of August 22, 1985 3:31:09 pm PDT";
GMT: TYPE ~ BasicTime.GMT;
LongNumber: TYPE ~ Basics.LongNumber;
LORA: TYPE = LIST OF REF ANY;
ROPE: TYPE ~ Rope.ROPE;
STREAM: TYPE ~ IO.STREAM;
debugging: BOOLFALSE;
promiscuous: BOOLFALSE;
useSingle: BOOLTRUE;
mute: BOOLFALSE;
UserNameAndPassword: TYPE ~ RECORD [
userName: ROPE,
userPassword: GVBasics.Password
];
ValidUser: PROC [userName, password: ROPE, mark: NAT] RETURNS [valid: BOOLTRUE] ~ {
ENABLE UNWIND => NULL;
codedPassword: GVBasics.Password ← GVBasics.MakeKey[password];
authenticated: BOOLFALSE;
myName, myPassword: ROPE;
myLengthToDot, lengthToDot: INT;
[myName, myPassword] ← UserCredentials.Get[];
lengthToDot ← userName.Find["."];
myLengthToDot ← myName.Find["."];
IF lengthToDot < 0 AND myLengthToDot > 0 THEN {
userName ← userName.Concat[myName.Substr[myLengthToDot]];
supply default registry from the logged-in user.
};
IF userName.Equal[myName, FALSE] AND password.Equal[myPassword, FALSE] THEN
The currently logged-in user is welcome to do anything.
RETURN [TRUE];
SELECT mark FROM
STPOps.markRetrieve =>
RETURN [CanAccess[userName, codedPassword, $read]];
STPOps.markStore, STPOps.markNewStore =>
RETURN [CanAccess[userName, codedPassword, $create]];
STPOps.markNewDirectory, STPOps.markDirectory =>
RETURN [CanAccess[userName, codedPassword, NIL]];
ENDCASE =>
RETURN [CanAccess[userName, codedPassword, $any]];
};
accessCache: SymTab.Ref ← SymTab.Create[127, FALSE];
cacheEntryLife: INT ← 12*LONG[3600];
Seconds for a cache entry to remain vaild
AccessEntry: TYPE = REF AccessEntryRep;
AccessEntryRep: TYPE = RECORD [
codedPassword: GVBasics.Password,
lastChecked: BasicTime.GMT ← BasicTime.nullGMT,
readFriend: AccessValue ← unknown,
createFriend: AccessValue ← unknown,
anyFriend: AccessValue ← unknown
];
AccessValue: TYPE = {unknown, yes, no};
CanAccess: PROC [name: ROPE, codedPassword: GVBasics.Password, class: ATOM] RETURNS [BOOL] = {
masterName: ROPESELECT class FROM
$read => "[]<>STPServer.readAccess",
$create => "[]<>STPServer.createAccess",
$any => "[]<>STPServer.anyAccess",
ENDCASE => NIL;
accessEntry: AccessEntry ← NIL;
now: BasicTime.GMT ← BasicTime.Now[];
WITH SymTab.Fetch[accessCache, name].val SELECT FROM
access: AccessEntry =>
IF codedPassword = access.codedPassword
AND BasicTime.Period[from: access.lastChecked, to: now] < cacheEntryLife
THEN accessEntry ← access
The user is OK, and the last check is recent
ELSE [] ← SymTab.Delete[accessCache, name];
The user needs verification or something, so kill the cache
ENDCASE;
IF accessEntry = NIL THEN {
We need a new access entry, and the user needs verification
accessEntry ← NEW[AccessEntryRep ← [
codedPassword: codedPassword,
lastChecked: now
]];
IF GVNames.AuthenticateKey[name, codedPassword] # individual THEN
RETURN [FALSE];
[] ← SymTab.Store[accessCache, name, accessEntry];
};
IF promiscuous THEN RETURN [TRUE];
The server can be started up to be easy.
SELECT class FROM
$read, $create, $any => {
value: AccessValue ← yes;
SELECT class FROM
$read => value ← accessEntry.readFriend;
$create => value ← accessEntry.createFriend;
$any => value ← accessEntry.anyFriend;
ENDCASE;
SELECT value FROM
yes => RETURN [TRUE];
no => RETURN [FALSE];
ENDCASE;
};
ENDCASE => RETURN [TRUE];
IF masterName # NIL THEN {
friends: ROPE ← RopeFile.Create[masterName ! FS.Error => GO TO bad];
offset: INT ← 0;
before, after: CHAR ← ' ;
offset ← Rope.Find[friends, name, 0, FALSE];
WHILE offset >= 0 DO
IF offset > 0 THEN before ← friends.Fetch[offset-1];
IF offset+name.Length < friends.Length THEN
after ← friends.Fetch[offset+name.Length];
IF Ascii.Letter[before] OR Ascii.Digit[before] OR Ascii.Letter[after] OR Ascii.Digit[after]
THEN offset ← Rope.Find[friends, name, offset+1, FALSE]
ELSE GO TO good;
ENDLOOP;
offset ← Rope.Find[friends, "^"];
WHILE offset >= 0 DO
ropeSize: INT ~ Rope.Length[friends];
size: INT ← 0;
UNTIL offset = 0 OR IsDelimiter[Rope.Fetch[friends, offset-1]] DO
offset ← offset-1;
ENDLOOP;
UNTIL offset+size = ropeSize OR IsDelimiter[Rope.Fetch[friends, offset+size]] DO
size ← size + 1;
ENDLOOP;
IF GVNames.IsMemberClosure[Rope.Substr[friends, offset, size], name] = yes THEN
GO TO good;
offset ← Rope.Find[friends, "^", offset+size];
ENDLOOP;
GO TO bad;
EXITS
bad => SELECT class FROM
$read => accessEntry.readFriend ← no;
$create => accessEntry.createFriend ← no;
$any => accessEntry.anyFriend ← no;
ENDCASE;
good => SELECT class FROM
$read =>
accessEntry.readFriend ← yes;
$create =>
accessEntry.createFriend ← accessEntry.readFriend ← yes;
$any =>
accessEntry.anyFriend ← accessEntry.createFriend ← accessEntry.readFriend ← yes;
ENDCASE;
};
RETURN [FALSE];
};
IsDelimiter: PROC [c: CHAR] RETURNS [BOOL] ~ {
RETURN [SELECT c FROM ' , '\t, ',, '; , '\n => TRUE, ENDCASE => FALSE]
};
HidePassword: PROC [rope: ROPE] RETURNS [ROPE] ~ {
i: INT ← rope.Find["Password ", 0, FALSE];
e: INT ← 0;
IF i >= 0 THEN i ← i + 9;
IF i >= 0 THEN e ← rope.Find[")", i];
IF e > 0 THEN rope ← rope.Replace[i, e-i, Rope.Substr["****************", 0, e-i]];
RETURN [rope]
};
monthName: ARRAY BasicTime.MonthOfYear OF ROPE ~ ["Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec", "???"];
PutFileDate: PROC [stream: STREAM, date: BasicTime.GMT] ~ {
unpacked: BasicTime.Unpacked ← BasicTime.Unpack[date];
zone: CHAR ← ' ;
IO.PutF[stream, "%02g-%g-%02g ", [integer[unpacked.day]], [rope[monthName[unpacked.month]]], [integer[unpacked.year MOD 100]]];
IO.PutF[stream, "%02g:%02g:%02g", [integer[unpacked.hour]], [integer[unpacked.minute]], [integer[unpacked.second]]];
zone ← SELECT unpacked.zone/60 FROM
0 => 'G,
5 => 'E,
6 => 'C,
7 => 'M,
8 => 'P,
ENDCASE => ' ;
IF zone # ' THEN {
IO.PutChar[stream, ' ];
IO.PutChar[stream, zone];
IO.PutChar[stream, IF unpacked.dst = yes THEN 'D ELSE 'S];
IO.PutChar[stream, 'T];
};
};
SendPropList: PROC [stream: STREAM, userProps: UserProperties, fullFName: ROPE, created: BasicTime.GMT, bytes: INT] RETURNS [refused: BOOLFALSE] ~ {
cp: FS.ComponentPositions;
desiredProperty: ARRAY STP.ValidProperties OF BOOL ← userProps.desiredProperty;
desiredProperty[serverName] ← desiredProperty[directory] ← desiredProperty[nameBody] ← desiredProperty[version] ← desiredProperty[byteSize] ← TRUE;
[fullFName, cp] ← FS.ExpandName[fullFName];
IO.PutChar[stream, '(];
IF desiredProperty[serverName] THEN {
IO.PutRope[stream, "(Server-Filename <"];
IF cp.dir.length = 0
THEN IO.PutRope[stream, File.GetVolumeName[File.SystemVolume[]]]
ELSE IO.PutRope[stream, fullFName.Substr[cp.dir.start, cp.dir.length]];
IO.PutChar[stream, '>];
IO.PutRope[stream, fullFName.Substr[cp.subDirs.start]];
IO.PutChar[stream, ')];
};
IF desiredProperty[directory] THEN {
IO.PutRope[stream, "(Directory "];
IF cp.dir.length = 0
THEN IO.PutRope[stream, File.GetVolumeName[File.SystemVolume[]]]
ELSE IO.PutRope[stream, fullFName.Substr[cp.dir.start, cp.dir.length]];
IF cp.subDirs.length > 0 THEN IO.PutChar[stream, '>];
IO.PutRope[stream, fullFName.Substr[cp.subDirs.start, cp.subDirs.length]];
IO.PutChar[stream, ')];
};
IF desiredProperty[nameBody] THEN {
IO.PutRope[stream, "(Name-Body "];
IO.PutRope[stream, fullFName.Substr[cp.base.start, cp.ext.start+cp.ext.length-cp.base.start]];
IO.PutChar[stream, ')];
};
IF desiredProperty[version] THEN {
IO.PutRope[stream, "(Version "];
IO.PutRope[stream, fullFName.Substr[cp.ver.start, cp.ver.length]];
IO.PutChar[stream, ')];
};
IF desiredProperty[createDate] THEN {
IO.PutRope[stream, "(Creation-Date "];
PutFileDate[stream, created];
IO.PutChar[stream, ')];
};
IF desiredProperty[byteSize] THEN {
IO.PutRope[stream, "(Byte-Size 8)"];
};
IF desiredProperty[type] THEN {
IO.PutRope[stream, "(Type Binary)"];
};
IF desiredProperty[size] THEN {
IO.PutF1[stream, "(Size %g)", [integer[bytes]]];
};
IO.PutChar[stream, ')];
};
RetrieveFile: PROC [stream: STREAM, userProps: UserProperties, fullFName: ROPE, created: BasicTime.GMT, bytes: INT] RETURNS [refused: BOOLFALSE] ~ {
expl: ROPENIL;
group: FS.ErrorGroup ← environment;
cs: CommandString;
HereIsPList[stream, userProps, fullFName, created, bytes];
cs ← GetCommandString[stream];
SELECT cs.mark FROM
STPOps.markYes => {
ENABLE {
FS.Error => {group ← error.group; expl ← error.explanation; GO TO bogus};
IO.Error => {expl ← "Error while reading file"; GO TO bogus};
};
local: STREAM;
local ← FS.StreamOpen[fullFName, $read, [tiogaRead: FALSE, commitAndReopenTransOnFlush: TRUE, truncatePagesOnClose: TRUE, finishTransOnClose: TRUE, closeFSOpenFileOnClose: TRUE]
];
PupStream.SendMark[stream, STPOps.markHereIsFile];
CopyStream[from: local, to: stream, fileByteSize: local.GetLength];
IO.Close[local];
Yes[stream, "Transfer complete"];
EXITS bogus => GenerateFileError[stream, group, expl]
};
STPOps.markNo => refused ← TRUE;
ENDCASE;
};
DeleteFile: PROC [stream: STREAM, userProps: UserProperties, fullFName: ROPE, created: BasicTime.GMT, bytes: INT] RETURNS [refused: BOOLFALSE] ~ {
expl: ROPENIL;
group: FS.ErrorGroup ← ok;
cs: CommandString;
HereIsPList[stream, userProps, fullFName, created, bytes];
cs ← GetCommandString[stream];
SELECT cs.mark FROM
STPOps.markYes => {
FS.Delete[fullFName, created
! FS.Error => {group ← error.group; expl ← error.explanation; GO TO bogus}
];
Yes[stream, "Deleted"];
EXITS bogus => GenerateFileError[stream, group, expl];
};
STPOps.markNo => refused ← TRUE;
ENDCASE;
};
FullFNameFromUserProperties: PROC [userProps: UserProperties] RETURNS [fullFName: ROPE] ~ {
IF userProps.serverName # NIL
THEN {
sName: ROPE ← userProps.serverName;
IF sName.Length > 0 AND sName.Fetch[0] = '< THEN sName ← Rope.Concat["[]", sName];
fullFName ← FS.ExpandName[sName, Rope.Cat["[]<", userProps.directory, ">"]].fullFName
}
ELSE {
s: STREAMIO.ROS[];
dlen: INT ← userProps.directory.Length;
s.PutRope["[]"];
IF dlen = 0 OR userProps.directory.Fetch[0] # '< THEN s.PutChar['<];
s.PutRope[userProps.directory];
IF dlen = 0 OR userProps.directory.Fetch[dlen-1] # '> THEN s.PutChar['>];
s.PutRope[userProps.nameBody];
fullFName ← s.RopeFromROS;
};
};
StoreFile: PROC [stream: STREAM, userProps: UserProperties, cs: CommandString, newStore: BOOLTRUE] ~ {
local: STREAMNIL;
expl: ROPENIL;
group: FS.ErrorGroup ← environment;
createByteCount: INT ← 2560;
fullFName: ROPENIL;
desiredVersion: INT ← 0;
desiredCreate: GMT ← BasicTime.nullGMT;
GetUserProperties[cs, userProps];
IF NOT ValidUser[userProps.userName, userProps.userPassword, cs.mark] THEN {
No[stream, accessDenied, "Access denied"];
RETURN;
};
{
fullFName ← FullFNameFromUserProperties[userProps
! FS.Error => {group ← error.group; expl ← error.explanation; GO TO bogus}];
createByteCount ← Convert.IntFromRope[userProps.size ! Convert.Error => CONTINUE];
desiredVersion ← ParseInteger[userProps.version, 0];
IF userProps.createdTime # NIL THEN
desiredCreate ← FSRemoteFile.FTPTimeToGMT[userProps.createdTime
! RuntimeError.UNCAUGHT => CONTINUE];
IF fullFName # NIL THEN {
local ← FS.StreamOpen[
fileName: fullFName,
accessOptions: $create,
streamOptions: [tiogaRead: FALSE, commitAndReopenTransOnFlush: TRUE, truncatePagesOnClose: TRUE, finishTransOnClose: TRUE, closeFSOpenFileOnClose: FALSE],
keep: 2,
createByteCount: createByteCount
! FS.Error => {group ← error.group; expl ← error.explanation; GO TO bogus}
];
};
IF newStore
THEN {
realName: ROPENIL;
sendCreated: GMT;
openFile: FS.OpenFile ← FS.OpenFileFromStream[local];
realName ← FS.GetName[openFile].fullFName;
sendCreated ← FS.GetInfo[openFile].created;
IF desiredVersion = 0 THEN fullFName ← realName;
IF desiredCreate # BasicTime.nullGMT THEN sendCreated ← desiredCreate;
HereIsPList[stream, userProps, fullFName, sendCreated, createByteCount];
}
ELSE Yes[stream, "Isn't it time you implemented the new store protocol?"];
SELECT cs.mark ← PupStream.ConsumeMark[stream] FROM
STPOps.markNo => {
cs ← GetCommandString[stream: stream, markConsumed: TRUE, mark: cs.mark];
};
STPOps.markHereIsFile => {
CopyStream[from: stream, to: local, fileByteSize: createByteCount
! IO.Error => {expl ← "Error while reading file"; GO TO bogus};
];
cs ← GetCommandString[stream];
SELECT cs.mark FROM
STPOps.markYes => {
openFile: FS.OpenFile ← FS.OpenFileFromStream[local];
name: ROPEFS.GetName[openFile].fullFName;
local.Close[
! IO.Error => {
expl ← "Error while reading file"; GO TO bogus}
];
IF desiredCreate # BasicTime.nullGMT AND expl = NIL THEN {
FS.SetByteCountAndCreatedTime[file: openFile, created: desiredCreate
! FS.Error => {group ← error.group; expl ← error.explanation; GO TO bogus}
];
};
IF expl = NIL THEN openFile.Close[
! FS.Error => {group ← error.group; expl ← error.explanation; GO TO bogus}
];
IF expl # NIL THEN {GenerateFileError[stream, group, expl]; RETURN};
Yes[stream, "Transfer Completed"];
IF desiredVersion > 0 THEN
IF SetVersion[name, desiredVersion]
THEN IO.PutF1[stream, "\000Version set for %g.", [rope[name]]]
ELSE IO.PutF[stream, "\000Version not set for %g, %g desired.", [rope[name]], [integer[desiredVersion]]];
};
STPOps.markNo => {
openFile: FS.OpenFile ← FS.OpenFileFromStream[local];
name: ROPEFS.GetName[openFile].fullFName;
created: BasicTime.GMTFS.GetInfo[openFile].created;
local.Close[abort: TRUE
! IO.Error => {expl ← "Error while reading file"; GO TO bogus}];
FS.Delete[name ! FS.Error => CONTINUE];
No[stream, notCompleted, "Store not completed"];
IF expl # NIL THEN GO TO bogus;
};
ENDCASE => SIGNAL ProtocolError;
};
ENDCASE => SIGNAL ProtocolError;
EXITS bogus => {GenerateFileError[stream, group, expl]; RETURN};
};
};
SetVersion: PROC [name: ROPE, version: INT] RETURNS [ok: BOOLFALSE] = {
Sets the given file name to the desired version (provided that it is not there already)
IF CurrentVersion[name] IN [1..version) THEN {
sansVersion: ROPE ← Rope.Flatten[name, 0, Rope.SkipTo[name, 0, "!"]];
curName: ROPE ← name;
DO
FS.Rename[from: curName, to: sansVersion
! FS.Error => EXIT;
];
curName ← FS.FileInfo[name: sansVersion, remoteCheck: FALSE
! FS.Error => EXIT;
].fullFName;
IF CurrentVersion[curName] >= version THEN RETURN [TRUE];
ENDLOOP;
};
};
CurrentVersion: PROC [name: ROPE] RETURNS [version: INT ← 0] = {
len: INT ← Rope.Length[name];
pos: INT ← Rope.SkipTo[name, 0, "!"];
IF pos # len THEN version ← ParseInteger[name, pos+1];
};
ParseInteger: PROC [name: ROPE, pos: INT] RETURNS [n: INT ← 0] = {
len: INT ← Rope.Length[name];
FOR i: INT IN [pos..len) DO
c: CHAR ← Rope.Fetch[name, i];
IF c IN ['0..'9] THEN n ← n * 10 + (c-'0) ELSE EXIT;
IF n > LAST[INTEGER] THEN RETURN [-1];
ENDLOOP;
};
GenerateFileError: PROC [stream: STREAM, group: FS.ErrorGroup, expl: ROPE] ~ {
No[stream, IF group = lock THEN fileBusy ELSE permanentError, expl];
};
No: PROC [stream: STREAM, replyCode: STPReplyCode.ReplyCode, expl: ROPE] ~ {
WITH Atom.GetPropFromList[stream.propList, $STPServerViewerStream] SELECT FROM
viewerOut: STREAM =>
viewerOut.PutF["No (%g), %g\n", [integer[ORD[replyCode]]], [rope[expl]]
! IO.Error => CONTINUE;
];
ENDCASE;
PupStream.SendMark[stream, STPOps.markNo];
IO.PutChar[stream, LOOPHOLE[replyCode]];
Finish[stream, expl];
};
Yes: PROC [stream: STREAM, expl: ROPE] ~ {
PupStream.SendMark[stream, STPOps.markYes];
IO.PutChar[stream, 0C];
Finish[stream, expl];
};
Finish: PROC [stream: STREAM, expl: ROPENIL] ~ {
IF expl # NIL THEN IO.PutRope[stream, expl];
PupStream.SendMark[stream, STPOps.markEOC];
};
HereIsPList: PROC [stream: STREAM, userProps: UserProperties, fullFName: ROPE, created: BasicTime.GMT, bytes: INT] ~ {
PupStream.SendMark[stream, STPOps.markHereIsPList];
[] ← SendPropList[stream, userProps, fullFName, created, bytes];
Finish[stream];
};
DoFiles: PROC [stream: STREAM, userProps: UserProperties, cs: CommandString, action: PROC [stream: STREAM, userProps: UserProperties, fullFName: ROPE, created: BasicTime.GMT, bytes: INT] RETURNS [refused: BOOLFALSE]] ~ {
matches: BOOLFALSE;
first: BOOLTRUE;
Info: PROC [fullFName, attachedTo: ROPE, created: BasicTime.GMT, bytes: INT, keep: CARDINAL] RETURNS [continue: BOOLTRUE] ~ {
refused: BOOL;
IF (first AND cs.mark = STPOps.markNewDirectory) OR cs.mark = STPOps.markDirectory
THEN PupStream.SendMark[stream, STPOps.markHereIsPList];
refused ← action[stream: stream, userProps: userProps, fullFName: fullFName, created: created, bytes: bytes];
IF NOT refused THEN matches ← TRUE;
first ← FALSE;
};
Name: PROC [fullFName: ROPE] RETURNS [continue: BOOLTRUE] ~ {
refused: BOOL;
IF (first AND cs.mark = STPOps.markNewDirectory) OR cs.mark = STPOps.markDirectory
THEN PupStream.SendMark[stream, STPOps.markHereIsPList];
refused ← action[stream: stream, userProps: userProps, fullFName: fullFName, created: BasicTime.nullGMT, bytes: 0];
IF NOT refused THEN matches ← TRUE;
first ← FALSE;
};
expl: ROPENIL;
group: FS.ErrorGroup;
pattern: ROPENIL;
GetUserProperties[cs, userProps];
IF NOT ValidUser[userProps.userName, userProps.userPassword, cs.mark] THEN {
No[stream, accessDenied, "Access denied"];
RETURN;
};
IF userProps.version = NIL AND cs.mark = STPOps.markRetrieve THEN {
userProps.version ← "H";
};
pattern ← Rope.Cat[
FullFNameFromUserProperties[userProps !
FS.Error => {expl ← error.explanation; group ← error.group; CONTINUE}
],
IF userProps.version.Length > 0 THEN "!" ELSE NIL,
userProps.version
];
IF expl # NIL THEN {GenerateFileError[stream, group, expl]; RETURN};
IF userProps.desiredProperty[createDate] OR userProps.desiredProperty[size]
THEN {
FS.EnumerateForInfo[pattern: pattern, proc: Info
! FS.Error => {expl ← error.explanation; group ← error.group; CONTINUE}
];
}
ELSE {
FS.EnumerateForNames[pattern: pattern, proc: Name
! FS.Error => {expl ← error.explanation; group ← error.group; CONTINUE}
];
};
IF expl # NIL THEN {GenerateFileError[stream, group, expl]; RETURN};
IF matches AND (cs.mark = STPOps.markNewDirectory OR cs.mark = STPOps.markDirectory)
THEN Finish[stream, ""];
IF NOT matches THEN No[stream, fileNotFound, "File not found"];
};
RopeFromMark: PROC [mark: NAT] RETURNS [ROPE] ~ {
RETURN [SELECT mark FROM
STPOps.markRetrieve => "Retrieve",
STPOps.markNewStore => "New-Store",
STPOps.markComment => "Comment",
STPOps.markIAmVersion => "Version",
STPOps.markDirectory => "Enumerate",
STPOps.markNewDirectory => "New-Enumerate",
STPOps.markDelete => "Delete",
STPOps.markYes => "Yes",
STPOps.markNo => "No",
ENDCASE => Convert.RopeFromInt[mark, 8]
]
};
MakeNewServerViewer: PROC [stream: STREAM, pupAddress: PupTypes.PupAddress] ~ {
otherGuy: ROPE ← PupDefs.GetHostName[pupAddress];
userProps: UserProperties ← NEW[UserPropertiesRep];
cs: CommandString;
closing: BOOLFALSE;
closeReason: PupStream.CloseReason ← localAbort;
viewer: ViewerClasses.Viewer ← MakeMyKindOfTypescript[Rope.Concat["STPServer ", otherGuy]];
viewerOut: STREAMIF viewer = NIL THEN NIL ELSE ViewerIO.CreateViewerStreams[name: viewer.name, viewer: viewer, editedStream: FALSE].out;
stream.propList ← Atom.PutPropOnList[stream.propList, $STPServerViewerStream, viewerOut];
{
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 => {closeReason ← localAbort; GOTO Exit};
};
AwaitCallingMessage[stream];
IF NOT closing THEN SendHerald[stream];
UNTIL closing OR
(viewerOut # NIL AND ViewerIO.GetViewerFromStream[viewerOut].destroyed) DO
ok: BOOLTRUE;
cs ← GetCommandString[stream];
SELECT cs.mark FROM
STPOps.markDirectory => DoFiles[stream, userProps, cs, SendPropList];
STPOps.markNewDirectory => DoFiles[stream, userProps, cs, SendPropList];
STPOps.markRetrieve => DoFiles[stream, userProps, cs, RetrieveFile];
STPOps.markStore => StoreFile[stream, userProps, cs, FALSE];
STPOps.markNewStore => StoreFile[stream, userProps, cs];
STPOps.markDelete => DoFiles[stream, userProps, cs, DeleteFile];
STPOps.markComment => NULL;
ENDCASE => No[stream, STPReplyCode.ReplyCode.badCommand, "Command undefined or unimplemented"];
ENDLOOP;
EXITS Exit => NULL;
};
IO.Close[stream ! IO.Error => CONTINUE];
IF viewerOut # NIL THEN {
IO.PutF1[viewerOut, "\nClosing %g\n",
[refAny[NEW[PupStream.CloseReason ← closeReason]]]
! IO.Error => CONTINUE];
Process.Pause[Process.MsecToTicks[1500]];
IF viewer.iconic AND NOT debugging THEN ViewerOps.DestroyViewer[viewer];
};
};
CommandString: TYPE ~ RECORD [
mark: NAT ← 0,
string: ROPENIL
];
UserProperties: TYPE ~ REF UserPropertiesRep;
UserPropertiesRep: TYPE ~ RECORD [
userName: ROPENIL,
userPassword: ROPENIL,
directory: ROPENIL,
nameBody: ROPENIL,
serverName: ROPENIL,
version: ROPENIL,
createdTime: ROPENIL,
size: ROPENIL,
desiredProperty: ARRAY STP.ValidProperties OF BOOLALL[FALSE]
];
GetCommandString: PROC [stream: STREAM, markConsumed: BOOLFALSE, mark: NAT ← 0] RETURNS [cs: CommandString] ~ {
may raise PupStream.StreamClosing, PupStream.TimeOut
isMark: BOOLFALSE;
char: CHAR ← '?;
closed: BOOLFALSE;
text: REF TEXT ← RefText.ObtainScratch[100];
GetChar: PROC ~ {
ok: BOOLTRUE;
char ← '?;
isMark ← FALSE;
char ← stream.GetChar[ !
IO.Error => {closed ← TRUE; CONTINUE};
IO.EndOfStream => {isMark ← TRUE; CONTINUE};
];
};
GetTextToMark: PROC ~ {
text.length ← 0;
GetChar[];
UNTIL isMark OR closed DO
text ← RefText.AppendChar[text, char];
GetChar[];
ENDLOOP;
};
cs.string ← NIL;
cs.mark ← mark;
IF NOT markConsumed THEN {
cs.mark ← 0;
GetTextToMark[];
IF text.length # 0 THEN SIGNAL ProtocolError;
IF closed THEN RETURN;
cs.mark ← PupStream.ConsumeMark[stream];
};
GetTextToMark[];
cs.string ← Rope.FromRefText[text];
RefText.ReleaseScratch[text];
{
t: NAT ← PupStream.ConsumeMark[stream];
IF t#STPOps.markEOC THEN SIGNAL ProtocolError
};
WITH Atom.GetPropFromList[stream.propList, $STPServerViewerStream] SELECT FROM
viewerOut: STREAM => {
IO.PutF[viewerOut, "\n%g %g\n", [rope[RopeFromMark[cs.mark]]], [rope[HidePassword[cs.string]]]
! IO.Error => CONTINUE];
};
ENDCASE;
};
ProtocolError: SIGNAL ~ CODE;
AwaitCallingMessage: PROC [stream: STREAM] ~ {
cs: CommandString ← GetCommandString[stream];
WHILE cs.mark # STPOps.markIAmVersion DO
SIGNAL ProtocolError;
cs ← GetCommandString[stream];
ENDLOOP;
};
SendHerald: PROC [stream: STREAM] ~ {
PupStream.SendMark[stream, STPOps.markIAmVersion];
IO.PutChar[stream, VAL[1]];
Finish[stream, heraldMessage];
};
NarrowToList: PROC [lisp: REF] RETURNS [LORANIL] ~ {
WITH lisp SELECT FROM
list: LORA => RETURN [list];
ENDCASE;
};
NarrowToRope: PROC [lisp: REF] RETURNS [ROPENIL] ~ {
WITH lisp SELECT FROM
rope: ROPE => RETURN [rope];
ENDCASE;
};
propertyNames: ARRAY STP.ValidProperties OF ROPE ~ [
userName: "User-Name",
userPassword: "User-Password",
connectName: "Connect-Name",
connectPassword: "Connect-Password",
byteSize: "Byte-Size",
type: "Type",
size: "Size",
directory: "Directory",
nameBody: "Name-Body",
version: "Version",
createDate: "Creation-Date",
readDate: "Read-Date",
writeDate: "Write-Date",
author: "Author",
eolConversion: "End-of-Line-Convention",
account: "Account",
userAccount: "User-Account",
device: "Device",
serverName: "Server-Filename"
];
ValidPropertyFromRope: PROC [propName: ROPE] RETURNS [prop: STP.ValidProperties] ~ {
FOR p: STP.ValidProperties IN STP.ValidProperties DO
IF Rope.Equal[propName, propertyNames[p], FALSE] THEN RETURN [p];
ENDLOOP;
SIGNAL ProtocolError;
};
GetUserProperties: PROC [cs: CommandString, userProperties: UserProperties] ~ {
stream: STREAMIO.RIS[cs.string];
lisp: REF;
userProperties.directory ← NIL;
userProperties.nameBody ← NIL;
userProperties.serverName ← NIL;
userProperties.version ← NIL;
userProperties.size ← NIL;
userProperties.createdTime ← NIL;
lisp ← ParseLisp[stream ! IO.Error, IO.EndOfStream => {SIGNAL ProtocolError; CONTINUE}];
IF NOT stream.EndOf THEN SIGNAL ProtocolError;
FOR p: LORA ← NarrowToList[lisp], p.rest UNTIL p = NIL DO
q: LORA ← NarrowToList[p.first];
IF q = NIL OR q.rest = NIL THEN SIGNAL ProtocolError;
WITH q.first SELECT FROM
key: ROPE => {
arg: ROPE ← NarrowToRope[q.rest.first];
IF key.Equal["Desired-property", FALSE]
THEN {
prop: STP.ValidProperties ← ValidPropertyFromRope[arg];
userProperties.desiredProperty[prop] ← TRUE;
}
ELSE {
prop: STP.ValidProperties ← ValidPropertyFromRope[key];
SELECT prop FROM
userName => userProperties.userName ← arg;
userPassword => userProperties.userPassword ← arg;
connectName => NULL;
connectPassword => NULL;
byteSize => NULL;
type => NULL;
size => userProperties.size ← arg;
directory => userProperties.directory ← arg;
nameBody => userProperties.nameBody ← arg;
version => userProperties.version ← arg;
createDate => {
userProperties.createdTime ← arg;
This hack required because the time may contain embedded spaces
FOR t: LORA ← q.rest.rest, t.rest UNTIL t = NIL DO
r: ROPE ← NarrowToRope[t.first];
userProperties.createdTime ← userProperties.createdTime.Cat[" ", r];
ENDLOOP;
};
readDate => NULL;
writeDate => NULL;
author => NULL;
eolConversion => NULL;
account => NULL;
userAccount => NULL;
device => NULL;
serverName => userProperties.serverName ← arg;
ENDCASE => NULL;
};
};
ENDCASE => SIGNAL ProtocolError;
ENDLOOP;
};
ParseLisp: PROC [stream: STREAM] RETURNS [ref: REF ANYNIL] ~ {
char: CHARIO.GetChar[stream];
WHILE char = ' DO char ← IO.GetChar[stream] ENDLOOP;
IF char # '(
THEN {
text: REF TEXT ← RefText.ObtainScratch[100];
nextUpper: BOOLTRUE;
text.length ← 0;
WHILE char # ' AND char # '( AND char # ') DO
IF char = '\' -- single quote -- THEN {
char ← IO.GetChar[stream];
};
text ← RefText.AppendChar[text, char];
char ← IO.GetChar[stream];
ENDLOOP;
ref ← Rope.FromRefText[text];
RefText.ReleaseScratch[text];
stream.Backup[char];
}
ELSE {
list: LORANIL;
char ← IO.GetChar[stream];
WHILE char = ' DO char ← IO.GetChar[stream] ENDLOOP;
WHILE char # ') DO
stream.Backup[char];
list ← CONS[ParseLisp[stream], list];
char ← IO.GetChar[stream];
ENDLOOP;
ref ← List.Reverse[list];
};
};
CopyStream: PROC [from, to: STREAM, fileByteSize: INT] ~ {
text: REF TEXT ← RefText.ObtainScratch[512];
viewer: ViewerClasses.Viewer ← FindMyViewer[from, to];
toGo: INT ← fileByteSize;
WHILE IO.GetBlock[from, text, 0] > 0 DO
IF viewer # NIL THEN SetPieFraction[viewer, REAL[toGo]/MAX[fileByteSize, 1]];
IO.PutBlock[to, text];
toGo ← toGo - text.length;
ENDLOOP;
IF viewer # NIL THEN SetPieFraction[viewer, REAL[toGo]/MAX[fileByteSize, 1]];
RefText.ReleaseScratch[text];
};
ftpListener: PupStream.PupListener ← NIL;
STPServerCommand: Commander.CommandProc = {
[cmd: Commander.Handle] RETURNS [result: REF ANY ← NIL, msg: ROPE ← NIL]
argv: CommandTool.ArgumentVector ← CommandTool.Parse[cmd: cmd, starExpand: FALSE
! CommandTool.Failed => {msg ← errorMsg; GO TO failed}];
out: STREAM = cmd.out;
ShowOption: PROC [option: ROPE] = {
out.PutF1[" STP Server %g.\n", [rope[option]]];
};
FOR i: NAT IN [1..argv.argc) DO
Each argument can either be a switch specification or a genuine argument to be processed. The first argument (argv[0]) is not examined, because by convention it is the name of the command as given by the user.
arg: ROPE = argv[i];
SELECT TRUE FROM
Rope.Equal[arg, "stop", FALSE] => {
IF ftpListener # NIL THEN {
PupStream.DestroyPupListener[ftpListener];
ftpListener ← NIL;
};
StopSingle[];
ShowOption["stopped"];
};
Rope.Equal[arg, "start", FALSE], ftpListener = NIL => {
ftpListener ← PupStream.CreatePupByteStreamListener[
local: PupTypes.ftpSoc,
proc: MakeNewServerViewer,
ticks: PupStream.SecondsToTocks[60]
];
IF useSingle THEN StartSingle[];
ShowOption["started"];
};
Rope.Equal[arg, "loose", FALSE] => {
promiscuous ← TRUE;
ShowOption["promiscuous"];
};
Rope.Equal[arg, "tight", FALSE] => {
promiscuous ← FALSE;
ShowOption["hard to get"];
};
Rope.Equal[arg, "mute", FALSE] => {
mute ← TRUE;
ShowOption["mute"];
};
Rope.Equal[arg, "noisy", FALSE] => {
mute ← FALSE;
ShowOption["noisy"];
};
Rope.Equal[arg, "single", FALSE] => {
useSingle ← TRUE;
ShowOption["single"];
};
Rope.Equal[arg, "noSingle", FALSE] => {
useSingle ← FALSE;
ShowOption["noSingle"];
};
ENDCASE => {
ShowOption["running"];
};
ENDLOOP;
EXITS failed => result ← $Failed;
};
MakeMyKindOfTypescript: PROC [name: ROPE] RETURNS [viewer: ViewerClasses.Viewer ← NIL] ~ {
IF NOT mute THEN {
viewer ← TypeScript.Create[info: [name: name, iconic: TRUE], paint: FALSE];
ViewerOps.AddProp[viewer, $PieData, NEW[PieDataRep ← [iconNumber: maxIcon]]];
viewer.icon ← private;
viewer.class ← fakeTypescriptClass;
ViewerOps.PaintViewer[viewer, all, TRUE];
};
};
FindMyViewer: PROCEDURE [from, to: IO.STREAM] RETURNS [viewer: ViewerClasses.Viewer ← NIL] ~ {
viewerStream: IO.STREAMNARROW[Atom.GetPropFromList[from.propList, $STPServerViewerStream]];
IF viewerStream = NIL THEN viewerStream ← NARROW[Atom.GetPropFromList[to.propList, $STPServerViewerStream]];
IF viewerStream # NIL THEN viewer ← ViewerIO.GetViewerFromStream[viewerStream];
};
PieData: TYPE ~ REF PieDataRep;
PieDataRep: TYPE ~ RECORD [
iconNumber: INT
];
maxIcon: NAT ← 19;
SetPieFraction: PROC [self: ViewerClasses.Viewer, fraction: REAL] ~ {
iconNumber: INT ← Real.RoundLI[MAX[MIN[fraction, 1.0], 0.0]*maxIcon];
old: INT ← -1;
IF iconNumber = 0 AND fraction>0 THEN iconNumber ← 1;
WITH ViewerOps.FetchProp[self, $PieData] SELECT FROM
pieData: PieData => {
old ← pieData.iconNumber;
pieData.iconNumber ← iconNumber;
};
ENDCASE => NULL;
IF iconNumber # old AND self.iconic THEN {
ViewerOps.PaintViewer[self, all, FALSE];
};
};
MyPaint: ViewerClasses.PaintProc ~ {
IF self.iconic THEN {
iconNumber: INT ← maxIcon;
WITH ViewerOps.FetchProp[self, $PieData] SELECT FROM
pieData: PieData => {
iconNumber ← pieData.iconNumber;
};
ENDCASE => NULL;
MyPaintIcon[context, iconNumber, self.name];
IF self = TiogaOps.GetSelection[primary].viewer THEN {
When an icon is selected it is inverted
[] ← Imager.SetColor[context, ImagerBackdoor.invert];
Imager.MaskBox[context, [0, 0, Icons.iconW, Icons.iconH]];
};
}
ELSE [] ← typescriptPaint[self, context, whatChanged, clear];
};
iconStream: STREAMNIL;
myIconRef: Icons.IconRef ← NEW[Icons.IconRep];
myIconFlavor: Icons.IconFlavor ← Icons.NewIcon[myIconRef];
MyPaintIcon: ENTRY PROC [context: Imager.Context, iconNumber: INT, name: ROPE] ~ TRUSTED {
ENABLE {UNWIND => NULL; RuntimeError.UNCAUGHT => CONTINUE};
bytes: INTSIZE[Icons.IconFileFormat]*Basics.bytesPerWord;
block: Icons.IconFileFormat;
base: LONG POINTER ← @block;
iconStream.SetIndex[iconNumber*bytes];
[] ← iconStream.UnsafeGetBlock[[base: base, startIndex: 0, count: bytes]];
myIconRef.bits ← block.bits;
myIconRef.label ← block.label;
myIconRef.invertLabel ← block.invertLabel;
myIconRef.lx ← block.lx;
myIconRef.ly ← block.ly;
myIconRef.lw ← block.lw;
myIconRef.lh ← block.lh;
Icons.DrawIcon[myIconFlavor, context, 0, 0, name];
};
fakeTypescriptClass: ViewerClasses.ViewerClass ← NIL;
This bletch is because ViewerIO insists that viewer.class.flavor = $Typescript
typescriptPaint: ViewerClasses.PaintProc ← NIL;
iconFileName: ROPE ← "STPServer.icons";
Single Packet Protocol
LookupFileType: PupTypes.PupType = LOOPHOLE[200B];
LookupFileReplyType: PupTypes.PupType = LOOPHOLE[201B];
LookupFileErrorType: PupTypes.PupType = LOOPHOLE[202B];
LookupFileSocket: PupTypes.PupSocketID = [0, 61B];
singleSocket: PupDefs.PupSocket ← NIL;
singleProcess: CedarProcess.Process ← NIL;
StartSingle: ENTRY PROC = {
ENABLE UNWIND => NULL;
IF singleProcess = NIL THEN {
singleSocket ← PupDefs.PupSocketMake [local: LookupFileSocket, remote: PupTypes.fillInPupAddress, ticks: PupDefs.veryLongWait ];
singleProcess ← CedarProcess.Fork[
SinglePacketListener, NIL, [priority: foreground, usePriority: TRUE]];
};
};
StopSingle: ENTRY PROC = {
ENABLE UNWIND => NULL;
IF singleProcess # NIL THEN {
CedarProcess.Abort[singleProcess];
PupDefs.PupSocketDestroy[singleSocket
! RuntimeError.UNCAUGHT => CONTINUE];
singleSocket ← NIL;
};
};
ReplyRecord: TYPE = MACHINE DEPENDENT RECORD[v: CARDINAL, c, l: LongNumber];
ReplyRecordBytes: CARDINAL = SIZE[ReplyRecord]*Basics.bytesPerWord;
SinglePacketListener: CedarProcess.ForkableProc = TRUSTED {
ENABLE UNWIND => singleProcess ← NIL;
text: REF TEXTNEW[TEXT[256]];
DO
receiver: PupDefs.PupBuffer = singleSocket.get[];
replyType: PupTypes.PupType ← error;
replyBytes: CARDINAL ← 0;
IF receiver # NIL THEN {
addr: PupTypes.PupAddress ← receiver.source;
msWait: CARDINAL = 2000+500*MIN[8, PupDefs.GetHopsToNetwork[addr.net]];
IF receiver.pupType = LookupFileType THEN {
id: PupTypes.Pair ← receiver.pupID;
len: INT ← PupDefs.GetPupContentsBytes[receiver];
IF len IN [1..256] THEN {
ENABLE RuntimeError.UNCAUGHT => GO TO dropIt;
sLen: NAT ← len;
name: ROPENIL;
fileLen: INT ← 0;
fileDate: GMT ← BasicTime.nullGMT;
rPtr: LONG POINTER TO ReplyRecord = LOOPHOLE[@receiver.pupBody];
FOR i: NAT IN [0 .. sLen) DO
text[i] ← receiver.pupChars[i];
ENDLOOP;
text.length ← sLen;
name ← Rope.Flatten[Rope.Concat["[]", RefText.TrustTextAsRope[text]]];
[fullFName: name, created: fileDate, bytes: fileLen] ← FS.FileInfo[name: name
! FS.Error => {
IF error.code = $unknownFile THEN {
replyType ← LookupFileErrorType;
};
CONTINUE
};
];
IF fileDate # BasicTime.nullGMT AND fileLen >= 0 THEN {
rPtr.v ← CurrentVersion[name];
rPtr.c ← Basics.SwapHalves[[lc[BasicTime.ToPupTime[fileDate]]]];
rPtr.l ← Basics.SwapHalves[[li[fileLen]]];
replyType ← LookupFileReplyType;
replyBytes ← ReplyRecordBytes;
};
};
EXITS dropIt => {};
};
receiver.pupType ← replyType;
IF replyType = error THEN
receiver.errorCode ← noProcessPupErrorCode;
RRA: There must be some better way to do this
PupDefs.ReturnPup[receiver, replyType, replyBytes];
};
CedarProcess.CheckAbort[singleProcess];
ENDLOOP;
};
Initialization
Init: PROC ~ {
fakeTypescriptClass ← NEW[ViewerClasses.ViewerClassRec ← ViewerOps.FetchViewerClass[$Typescript]^];
typescriptPaint ← fakeTypescriptClass.paint;
fakeTypescriptClass.paint ← MyPaint;
iconStream ← FS.StreamOpen[
fileName: iconFileName,
accessOptions: $read,
streamOptions: [
tiogaRead: FALSE,
commitAndReopenTransOnFlush: TRUE,
truncatePagesOnClose: FALSE,
finishTransOnClose: TRUE,
closeFSOpenFileOnClose: TRUE
],
streamBufferParms: [vmPagesPerBuffer: 2, nBuffers: 1]
];
Commander.Register["STPServer", STPServerCommand, "STPServer [ start | stop ]\n[]<>STPServer.readAccess should have list of permissible readers"];
};
Init[];
END.