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
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: BOOL ← FALSE;
promiscuous: BOOL ← FALSE;
useSingle: BOOL ← TRUE;
UserNameAndPassword:
TYPE ~
RECORD [
userName: ROPE,
userPassword: GVBasics.Password
];
ValidUser:
PROC [userName, password:
ROPE, mark:
NAT]
RETURNS [valid:
BOOL ←
TRUE] ~ {
ENABLE UNWIND => NULL;
codedPassword: GVBasics.Password ← GVBasics.MakeKey[password];
authenticated: BOOL ← FALSE;
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:
ROPE ←
SELECT 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:
BOOL ←
FALSE] ~ {
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:
BOOL ←
FALSE] ~ {
expl: ROPE ← NIL;
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:
BOOL ←
FALSE] ~ {
expl: ROPE ← NIL;
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: STREAM ← IO.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:
BOOL ←
TRUE] ~ {
local: STREAM ← NIL;
expl: ROPE ← NIL;
group: FS.ErrorGroup ← environment;
createByteCount: INT ← 2560;
fullFName: ROPE ← NIL;
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: ROPE ← NIL;
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: ROPE ← FS.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: ROPE ← FS.GetName[openFile].fullFName;
created: BasicTime.GMT ← FS.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:
BOOL ←
FALSE] = {
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:
ROPE ←
NIL] ~ {
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:
BOOL ←
FALSE]] ~ {
matches: BOOL ← FALSE;
first: BOOL ← TRUE;
Info:
PROC [fullFName, attachedTo:
ROPE, created: BasicTime.
GMT, bytes:
INT, keep:
CARDINAL]
RETURNS [continue:
BOOL ←
TRUE] ~ {
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:
BOOL ←
TRUE] ~ {
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: ROPE ← NIL;
group: FS.ErrorGroup;
pattern: ROPE ← NIL;
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: BOOL ← FALSE;
closeReason: PupStream.CloseReason ← localAbort;
viewer: ViewerClasses.Viewer ← MakeMyKindOfTypescript[Rope.Concat["STPServer ", otherGuy]];
viewerOut: STREAM ← IF 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: BOOL ← TRUE;
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: ROPE ← NIL
];
UserProperties: TYPE ~ REF UserPropertiesRep;
UserPropertiesRep:
TYPE ~
RECORD [
userName: ROPE ← NIL,
userPassword: ROPE ← NIL,
directory: ROPE ← NIL,
nameBody: ROPE ← NIL,
serverName: ROPE ← NIL,
version: ROPE ← NIL,
createdTime: ROPE ← NIL,
size: ROPE ← NIL,
desiredProperty: ARRAY STP.ValidProperties OF BOOL ← ALL[FALSE]
];
GetCommandString:
PROC [stream:
STREAM, markConsumed:
BOOL ←
FALSE, mark:
NAT ← 0]
RETURNS [cs: CommandString] ~ {
may raise PupStream.StreamClosing, PupStream.TimeOut
isMark: BOOL ← FALSE;
char: CHAR ← '?;
closed: BOOL ← FALSE;
text: REF TEXT ← RefText.ObtainScratch[100];
GetChar:
PROC ~ {
ok: BOOL ← TRUE;
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 [
LORA ←
NIL] ~ {
WITH lisp
SELECT
FROM
list: LORA => RETURN [list];
ENDCASE;
};
NarrowToRope:
PROC [lisp:
REF]
RETURNS [
ROPE ←
NIL] ~ {
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: STREAM ← IO.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
ANY ←
NIL] ~ {
char: CHAR ← IO.GetChar[stream];
WHILE char = ' DO char ← IO.GetChar[stream] ENDLOOP;
IF char # '(
THEN {
text: REF TEXT ← RefText.ObtainScratch[100];
nextUpper: BOOL ← TRUE;
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: LORA ← NIL;
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.STREAM ← NARROW[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:
STREAM ←
NIL;
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: INT ← SIZE[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";