DIRECTORY
Ascii USING [Digit, Letter],
Atom USING [GetPropFromList, PutPropOnList],
Basics USING [bytesPerWord],
BasicTime USING [GMT, MonthOfYear, Now, nullGMT, Unpack, Unpacked, Update],
Booting USING [RegisterProcs],
Commander USING [CommandProc, Handle, Register],
CommandTool USING [ArgumentVector, Failed, Parse],
Convert USING [Error, IntFromRope, RopeFromInt],
File USING [GetVolumeName, SystemVolume],
FS USING [Close, ComponentPositions, Create, Delete, EnumerateForInfo, EnumerateForNames, Error, ErrorDesc, ErrorFromStream, ErrorGroup, ExpandName, FileInfo, GetInfo, GetName, Open, OpenFile, OpenFileFromStream, Rename, SetByteCountAndCreatedTime, SetKeep, StreamBufferParms, StreamFromOpenFile, StreamOpen, StreamOptions],
FSBackdoor USING [CreateEvent, ErrorCode, NextCreateEvent, ProduceError],
FSRemoteFile USING [FTPTimeToGMT, GetServerPupName],
FSReport USING [UnknownFile],
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, SetIndex, STREAM, UnsafeGetBlock],
List USING [LORA, Reverse],
Process USING [Detach, MsecToTicks, Pause, priorityBackground, SetPriority, Ticks],
Pup USING [Address],
PupName USING [HisName],
PupStream USING [CloseReason, ConsumeMark, CreateListener, DestroyListener, Listener, SendMark, StreamClosing, Timeout],
PupWKS USING [ftp],
PutGet USING [FromFileC, WritePlain],
Real USING [RoundLI],
RefText USING [AppendChar, AppendRope, ObtainScratch, ReleaseScratch],
Rope USING [Cat, Concat, Equal, Fetch, Find, Flatten, FromRefText, Index, IsEmpty, Match, Replace, ROPE, Run, Size, SkipTo, Substr],
RopeFile USING [Create],
RuntimeError USING [UNCAUGHT],
STP USING [Close, ConfirmProcType, Create, Error, ErrorCode, Handle, Login, Open, Retrieve, ValidProperties],
STPCode USING [Mark, Reply],
STPServerFileTranslation USING [NamedTranslator, NamedTranslatorRep, Translator],
STPServerPrivate,
SymTab USING [Create, Delete, Fetch, Ref, Store],
TEditInput USING [FreeTree],
TextNode USING [Ref],
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];
STPServerMainImpl:
CEDAR
MONITOR
IMPORTS Ascii, Atom, BasicTime, Booting, Commander, CommandTool, Convert, File, FS, FSBackdoor, FSRemoteFile, FSReport, Imager, ImagerBackdoor, GVBasics, GVNames, Icons, IO, List, Process, PupName, PupStream, Real, RefText, Rope, RopeFile, RuntimeError, STP, STPServerPrivate, SymTab, TiogaOps, TypeScript, UserCredentials, ViewerIO, ViewerOps, TEditInput, PutGet
EXPORTS STPServerPrivate, STPServerFileTranslation
~ BEGIN OPEN STPServerPrivate;
heraldMessage:
ROPE ← "Cedar STP Server of February 23, 1986 4:08:39 am PST";
debugging: BOOL ← FALSE;
promiscuous: BOOL ← FALSE;
useSingle: BOOL ← TRUE;
doTranslating: BOOL ← TRUE;
mute: BOOL ← FALSE;
ValidUser:
PROC [userName, password:
ROPE, mark: STPCode.Mark]
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
retrieve => RETURN [CanAccess[userName, codedPassword, $read]];
store, newStore => RETURN [CanAccess[userName, codedPassword, $create]];
newDirectory, directory => RETURN [CanAccess[userName, codedPassword, nil]];
ENDCASE => RETURN [CanAccess[userName, codedPassword, $any]];
};
accessCache: SymTab.Ref ← SymTab.Create[127, FALSE];
AccessClass: TYPE = {nil, read, create, any};
LimitedAccessClass: TYPE = AccessClass[read .. any];
AccessEntry: TYPE = REF AccessEntryRep;
AccessEntryRep:
TYPE =
RECORD [
codedPassword: GVBasics.Password,
records: ARRAY LimitedAccessClass OF AccessRecord ← ALL[[]]
];
AccessRecord:
TYPE =
RECORD [
fileDate: BasicTime.GMT ← BasicTime.nullGMT,
friend: AccessValue ← unknown];
AccessValue:
TYPE = {unknown, yes, no};
accessFileNames:
ARRAY AccessClass
OF
ROPE = [
nil: NIL,
read: "[]<>STPServer.readAccess",
create: "[]<>STPServer.createAccess",
any: "[]<>STPServer.anyAccess"
];
accessFileCreateDates:
ARRAY LimitedAccessClass
OF
GMT ←
ALL[BasicTime.nullGMT];
AfterRollback:
PROC [clientData:
REF
ANY] ~ {
accessFileCreateDates ← ALL[BasicTime.nullGMT];
};
WatchAccessFiles:
PROC = {
ce: REF READONLY FSBackdoor.CreateEvent ← NIL;
DO
ce ← FSBackdoor.NextCreateEvent[ce];
FOR ac: LimitedAccessClass
IN LimitedAccessClass
DO
len: INT ~ accessFileNames[ac].Size[];
IF accessFileNames[ac].Equal[ce.fName.Substr[len: len],
FALSE]
THEN {
accessFileCreateDates[ac] ← FS.FileInfo[accessFileNames[ac] ! FS.Error => {accessFileCreateDates[ac] ← BasicTime.nullGMT; CONTINUE}].created;
EXIT;
};
ENDLOOP;
ENDLOOP;
};
CanAccess:
PROC [name:
ROPE, codedPassword: GVBasics.Password, class: AccessClass]
RETURNS [
BOOL] = {
accessEntry, oldAccessEntry: AccessEntry ← NIL;
now: BasicTime.GMT ← BasicTime.Now[];
WITH SymTab.Fetch[accessCache, name].val
SELECT
FROM
access: AccessEntry => {
valid: BOOL ← codedPassword = access.codedPassword;
FOR ac: LimitedAccessClass
IN LimitedAccessClass
WHILE valid
DO
IF accessFileCreateDates[ac] # access.records[ac].fileDate THEN valid ← FALSE;
ENDLOOP;
IF valid
THEN accessEntry ← access
The user is OK, and the last check is recent
ELSE {
oldAccessEntry ← access;
[] ← SymTab.Delete[accessCache, name]};
The user needs verification or something, so kill the cache
};
ENDCASE;
IF accessEntry =
NIL
THEN {
IF GVNames.AuthenticateKey[name, codedPassword] # individual
THEN
RETURN [FALSE];
We need a new access entry, and the user needs verification
accessEntry ← NEW[AccessEntryRep ← [codedPassword: codedPassword]];
FOR ac: LimitedAccessClass
IN LimitedAccessClass
DO
accessEntry.records[ac] ←
IF oldAccessEntry #
NIL
AND oldAccessEntry.records[ac].fileDate = accessFileCreateDates[ac]
THEN oldAccessEntry.records[ac]
ELSE [fileDate: accessFileCreateDates[ac], friend: unknown];
ENDLOOP;
[] ← SymTab.Store[accessCache, name, accessEntry];
};
IF promiscuous
THEN
RETURN [
TRUE];
The server can be started up to be easy.
IF class = nil THEN RETURN [TRUE];
FOR ac: LimitedAccessClass
DECREASING
IN [class .. any]
DO
value: AccessValue ← accessEntry.records[ac].friend;
IF value = unknown
THEN {
masterName: ROPE ~ accessFileNames[ac];
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.Size < friends.Size
THEN
after ← friends.Fetch[offset+name.Size];
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.Size[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 => value ← accessEntry.records[ac].friend ← no;
good => value ← accessEntry.records[ac].friend ← yes;
};
SELECT value
FROM
yes => RETURN [TRUE];
no => IF ac = class THEN RETURN [FALSE];
ENDCASE => ERROR;
ENDLOOP;
ERROR;
};
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: FileName, created: BasicTime.
GMT, bytes:
INT, translator: NamedTranslator]
RETURNS [refused:
BOOL ←
FALSE] ~ {
rFull: ROPE;
cp: FS.ComponentPositions;
desiredProperty: ARRAY STP.ValidProperties OF BOOL ← userProps.desiredProperty;
-- Anybody know what this was for ?? /HGM, Feb 25, 86
desiredProperty[serverName] ← desiredProperty[directory] ← desiredProperty[nameBody] ← desiredProperty[version] ← desiredProperty[byteSize] ← TRUE;
[rFull, cp] ← FS.ExpandName[fullFName.remote];
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, rFull.Substr[cp.dir.start, cp.dir.length]];
IO.PutChar[stream, '>];
IO.PutRope[stream, rFull.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, rFull.Substr[cp.dir.start, cp.dir.length]];
IF cp.subDirs.length > 0 THEN IO.PutChar[stream, '>];
IO.PutRope[stream, rFull.Substr[cp.subDirs.start, cp.subDirs.length]];
IO.PutChar[stream, ')];
};
IF desiredProperty[nameBody]
THEN {
IO.PutRope[stream, "(Name-Body "];
IO.PutRope[stream, rFull.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, rFull.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, ')];
};
SatisfyRetrieve:
PROC [stream:
STREAM, userProps: UserProperties, fileName: FileName, created: BasicTime.
GMT, bytes:
INT]
RETURNS [refused:
BOOL ←
FALSE] ~ {
errorDesc: FS.ErrorDesc;
cs: CommandString;
HereIsPList[stream, userProps, fileName, created, bytes];
cs ← GetCommandString[stream];
SELECT cs.mark
FROM
yes => {
ENABLE {
FS.Error => {errorDesc ← error; GO TO bogus};
IO.Error => {errorDesc ← FS.ErrorFromStream[stream]; GO TO bogus};
};
local: STREAM;
local ←
FS.StreamOpen[
fileName: fileName.local,
accessOptions: $read,
streamOptions: streamOptions,
streamBufferParms: streamBufferParms ];
SendMark[stream, hereIsFile];
CopyStream[from: local, to: stream, fileByteSize: local.GetLength];
IO.Close[local];
YesWithoutEOC[stream, "Transfer complete"];
EXITS bogus => GenerateFileError[stream, errorDesc]
};
no => refused ← TRUE;
ENDCASE;
};
RetrieveFile:
PROC [stream:
STREAM, userProps: UserProperties, fullFName: FileName, created: BasicTime.
GMT, bytes:
INT, translator: NamedTranslator]
RETURNS [refused:
BOOL ←
FALSE] ~ {
errorDesc: FS.ErrorDesc;
IF translator #
NIL
THEN {
ENABLE {
FS.Error => {errorDesc ← error; GO TO bogus};
IO.Error => {errorDesc ← FS.ErrorFromStream[stream]; GO TO bogus};
};
tempUntranslated: FS.OpenFile ← CreateTempFile[];
tempTranslated: FS.OpenFile ← CreateTempFile[];
fileName: FileName ~ [local: FS.GetName[tempTranslated].fullFName, remote: fullFName.remote];
wantedCreate: BasicTime.GMT ~ IF created = BasicTime.nullGMT THEN created ELSE BasicTime.Update[created, -1];
CopyFromRemote[to: tempUntranslated, remoteName: fullFName.local, created: wantedCreate, userProps: userProps];
tempUntranslated ← CloseAndOpenTempFile[tempUntranslated];
translator.translator[input: tempUntranslated, output: tempTranslated];
tempTranslated ← CloseAndOpenTempFile[tempTranslated];
refused ← SatisfyRetrieve[stream: stream, userProps: userProps, fileName: fileName, created: created, bytes: FS.GetInfo[tempTranslated].bytes];
FS.Close[tempUntranslated];
FS.Close[tempTranslated];
CleanTempFiles[];
EXITS bogus => {GenerateFileError[stream, errorDesc]}
}
ELSE {
refused ← SatisfyRetrieve[stream: stream, userProps: userProps, fileName: fullFName, created: created, bytes: bytes];
};
};
DeleteFile:
PROC [stream:
STREAM, userProps: UserProperties, fullFName: FileName, created: BasicTime.
GMT, bytes:
INT, translator: NamedTranslator]
RETURNS [refused:
BOOL ←
FALSE] ~ {
errorDesc: FS.ErrorDesc;
cs: CommandString;
HereIsPList[stream, userProps, fullFName, created, bytes];
cs ← GetCommandString[stream];
SELECT cs.mark
FROM
yes => {
FS.Delete[fullFName.local, created
! FS.Error => {errorDesc ← error; GO TO bogus}
];
YesWithoutEOC[stream, "Deleted"];
EXITS bogus => GenerateFileError[stream, errorDesc];
};
no => refused ← TRUE;
ENDCASE;
};
FullFNameFromUserProperties:
PROC [userProps: UserProperties]
RETURNS [fullFName: FileName] ~ {
IF userProps.serverName #
NIL
THEN {
sName: ROPE ← userProps.serverName;
IF Rope.Size[sName] > 0 AND Rope.Fetch[sName, 0] = '< THEN sName ← Rope.Concat["[]", sName];
fullFName ← BothFromOne[
FS.ExpandName[
sName,
Rope.Cat["[]<", userProps.directory, ">"]
].fullFName,
remoteToLocal];
}
ELSE {
dlen: INT ~ Rope.Size[userProps.directory];
Dir:
PROC [i:
INT]
RETURNS [
CHAR]
~ INLINE {RETURN[Rope.Fetch[userProps.directory, i]]};
text: REF TEXT ← RefText.ObtainScratch[100];
PutC: PROC [c: CHAR] ~ INLINE {text ← RefText.AppendChar[text, c]};
PutR: PROC [r: ROPE] ~ INLINE {text ← RefText.AppendRope[text, r]};
PutR["[]"];
IF dlen = 0 OR Dir[0] # '< THEN PutC['<];
PutR[userProps.directory];
IF dlen = 0 OR Dir[dlen-1] # '> THEN PutC['>];
PutR[userProps.nameBody];
fullFName ← BothFromOne[Rope.FromRefText[text], remoteToLocal];
RefText.ReleaseScratch[text];
};
};
streamOptions: FS.StreamOptions ~ [tiogaRead: FALSE, commitAndReopenTransOnFlush: TRUE, truncatePagesOnClose: TRUE, finishTransOnClose: TRUE, closeFSOpenFileOnClose: FALSE];
streamBufferParms:
FS.StreamBufferParms ← [vmPagesPerBuffer: 32, nBuffers: 2];
StoreFile:
PROC [stream:
STREAM, userProps: UserProperties, cs: CommandString, newStore:
BOOL ←
TRUE] ~ {
local: STREAM ← NIL;
errorDesc: FS.ErrorDesc ← [group: ok, code: NIL, explanation: NIL];
createByteCount: INT ← 2560;
fullFName: FileName ← nilFileName;
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 => {errorDesc ← error; 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 # nilFileName
THEN {
local ←
FS.StreamOpen[
fileName: fullFName.local,
accessOptions: $create,
streamOptions: streamOptions,
keep: 2,
createByteCount: createByteCount,
streamBufferParms: streamBufferParms
! FS.Error => {errorDesc ← error; 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 ← BothFromOne[realName, localToRemote];
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 ←
VAL[PupStream.ConsumeMark[stream]]
FROM
no => {
cs ← GetCommandString[stream: stream, markConsumed: TRUE, mark: cs.mark];
};
hereIsFile => {
CopyStream[from: stream, to: local, fileByteSize: createByteCount
! IO.Error => {errorDesc ← FS.ErrorFromStream[stream]; GO TO bogus};
];
cs ← GetCommandString[stream];
SELECT cs.mark
FROM
yes => {
openFile: FS.OpenFile ← FS.OpenFileFromStream[local];
name: FileName ← BothFromOne[FS.GetName[openFile].fullFName, localToRemote];
local.Close[
! IO.Error => {errorDesc ← FS.ErrorFromStream[stream]; GO TO bogus}
];
IF desiredCreate # BasicTime.nullGMT
AND errorDesc.explanation =
NIL
THEN {
FS.SetByteCountAndCreatedTime[file: openFile, created: desiredCreate
! FS.Error => {errorDesc ← error; GO TO bogus}
];
};
IF errorDesc.explanation =
NIL
THEN openFile.Close[
! FS.Error => {errorDesc ← error; GO TO bogus}
];
IF errorDesc.explanation # NIL THEN {GenerateFileError[stream, errorDesc]; RETURN};
Yes[stream, "Transfer Completed"];
IF desiredVersion > 0
THEN
IF SetVersion[name, desiredVersion]
THEN IO.PutF1[stream, "\000Version set for %g.", [rope[name.remote]]]
ELSE IO.PutF[stream, "\000Version not set for %g, %g desired.", [rope[name.remote]], [integer[desiredVersion]]];
};
no => {
openFile: FS.OpenFile ← FS.OpenFileFromStream[local];
name: FileName ← BothFromOne[FS.GetName[openFile].fullFName, localToRemote];
created: BasicTime.GMT ← FS.GetInfo[openFile].created;
local.Close[abort:
TRUE
! IO.Error => {errorDesc ← FS.ErrorFromStream[stream]; GO TO bogus}];
FS.Delete[name.local ! FS.Error => CONTINUE];
No[stream, notCompleted, "Store not completed"];
IF errorDesc.explanation # NIL THEN GO TO bogus;
};
ENDCASE => SIGNAL ProtocolError;
};
ENDCASE => SIGNAL ProtocolError;
EXITS bogus => {GenerateFileError[stream, errorDesc]; RETURN};
};
};
SetVersion:
PROC [name: FileName, 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.local]
IN [1..version)
THEN {
sansVersion: ROPE ← Rope.Flatten[name.local, 0, Rope.SkipTo[name.local, 0, "!"]];
curName: ROPE ← name.local;
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:
PUBLIC
PROC [name:
ROPE]
RETURNS [version:
INT ← 0] = {
len: INT ← Rope.Size[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.Size[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, error:
FS.ErrorDesc] ~ {
replyCode: STPCode.Reply ←
SELECT error.group
FROM
bug => badCommand,
environment =>
SELECT error.code
FROM
$wentOffline => transientError,
$hardware => fileDataError,
$volumeFull, $fragmented, $quotaExceeded => tooLong,
$badCredentials => illegalUserName,
$accessDenied => accessDenied,
ENDCASE => permanentError,
lock => fileBusy,
client => badCommand,
user =>
SELECT error.code
FROM
$nonCedarVolume, $unknownVolume, $unknownServer, $unknownFile, $unknownCreatedTime => fileNotFound,
$illegalName, $patternNotAllowed, $badWorkingDir => badPList,
ENDCASE => fileNotFound,
ENDCASE => null;
No[stream, replyCode, error.explanation];
};
No:
PROC [stream:
STREAM, replyCode: STPCode.Reply, 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;
SendMark[stream, no];
IO.PutChar[stream, LOOPHOLE[replyCode]];
Finish[stream, expl];
};
YesWithoutEOC:
PROC [stream:
STREAM, expl:
ROPE] ~ {
SendMark[stream, yes];
IO.PutChar[stream, 0C];
IF expl # NIL THEN IO.PutRope[stream, expl];
};
Yes:
PROC [stream:
STREAM, expl:
ROPE] ~ {
SendMark[stream, yes];
IO.PutChar[stream, 0C];
Finish[stream, expl];
};
Finish:
PROC [stream:
STREAM, expl:
ROPE ←
NIL] ~ {
IF expl # NIL THEN IO.PutRope[stream, expl];
SendMark[stream, eoc];
};
SendMark:
PROC [stream:
STREAM, mark: STPCode.Mark] ~ {
PupStream.SendMark[stream, mark.ORD];
};
HereIsPList:
PROC [stream:
STREAM, userProps: UserProperties, fullFName: FileName, created: BasicTime.
GMT, bytes:
INT] ~ {
SendMark[stream, hereIsPList];
[] ← SendPropList[stream, userProps, fullFName, created, bytes, NIL];
Finish[stream];
};
Translator:
TYPE ~
PROC [input, output:
FS.OpenFile];
NamedTranslator:
TYPE ~ STPServerFileTranslation.NamedTranslator;
NamedTranslatorRep:
TYPE ~ STPServerFileTranslation.NamedTranslatorRep;
translators:
LIST
OF NamedTranslator ←
NIL;
Register:
PUBLIC
ENTRY
PROC [name: Rope.
ROPE, translator: Translator] ~ {
ENABLE UNWIND => NULL;
translators ← CONS[NEW[NamedTranslatorRep ← [name, translator]], translators];
};
FindNamedTranslator:
PUBLIC
ENTRY
PROC [rope:
ROPE, start, length:
INT]
RETURNS [NamedTranslator] ~ {
ENABLE UNWIND => NULL;
IF doTranslating
THEN {
length ← MIN[Rope.Size[rope]-start, length];
FOR p:
LIST
OF NamedTranslator ← translators, p.rest
UNTIL p =
NIL
DO
IF Rope.Size[p.first.name] = length AND length = Rope.Run[s1: rope, pos1: start, s2: p.first.name, case: FALSE] THEN RETURN [p.first]
ENDLOOP;
};
RETURN [NIL];
};
NamedTranslatorFromProplist:
PROC [propList:
ROPE]
RETURNS [NamedTranslator] ~ {
key: ROPE ~ "(Directory ";
start: INT ← Rope.Index[s1: propList, pos1: 0, s2: key, case: FALSE]+Rope.Size[key];
end: INT ← MIN[Rope.Index[s1: propList, pos1: start, s2: ")"], Rope.Index[s1: propList, pos1: start, s2: ">"]];
IF start >= Rope.Size[propList] THEN RETURN [NIL];
IF Rope.Fetch[propList, start] = '< THEN start ← start + 1;
RETURN [FindNamedTranslator[propList, start, end-start]];
};
FixPseudoName:
PROC [remoteName:
ROPE, namedTranslator: NamedTranslator]
RETURNS [
ROPE] ~ {
pos: INT ~ Rope.Index[s1: remoteName, pos1: 0, s2: "]<"];
pre: ROPE ~ Rope.Cat["[]<", namedTranslator.name, ">"];
pseudo: ROPE ~ Rope.Cat[pre, Rope.Substr[remoteName, 1, pos-1], ">", Rope.Substr[remoteName, pos+2]];
RETURN [pseudo]
};
RemoteNameOfFileToBeTranslated:
PROC [userProps: UserProperties]
RETURNS [
ROPE] ~ {
fileName: FileName ~ FullFNameFromUserProperties[userProps];
fsName: ROPE;
serverNameLength: INT ← 0;
cp: FS.ComponentPositions;
[fsName, cp] ← FS.ExpandName[fileName.remote];
serverNameLength ← Rope.Index[s1: fsName, s2: ">", pos1: cp.subDirs.start, case: FALSE]-cp.subDirs.start;
RETURN [Rope.Cat["[", Rope.Substr[fsName, cp.subDirs.start, serverNameLength], "]<", Rope.Substr[fsName, cp.subDirs.start+serverNameLength+1]]];
};
tempFileName:
ROPE ← "[]<>Temp>STPTranslator.temp";
pageGuess: INT ← 20;
CreateTempFile:
ENTRY
PROC
RETURNS [
FS.OpenFile] ~ {
ENABLE UNWIND => NULL;
RETURN [FS.Create[name: tempFileName, pages: pageGuess, setPages: FALSE, setKeep: TRUE, keep: 2]]
};
CloseAndOpenTempFile:
ENTRY
PROC [temp:
FS.OpenFile]
RETURNS [
FS.OpenFile] ~ {
ENABLE UNWIND => NULL;
name: ROPE ~ FS.GetName[temp].fullFName;
FS.Close[temp];
temp ← FS.Open[name: name, lock: read];
RETURN [temp];
};
CleanTempFiles:
ENTRY
PROC ~ {
ENABLE UNWIND => NULL;
FS.SetKeep[tempFileName, 0]; -- does keep processing to delete old versions
};
CopyFromRemote: PROC [to: FS.OpenFile, remoteName: ROPE, created: BasicTime.GMT, userProps: UserProperties] ~ {
-- stub - this needs to use STP, and needs to authenticate
outputStream: IO.STREAM ~ FS.StreamFromOpenFile[openFile: to, accessRights: write, streamOptions: streamOptions];
inputStream: IO.STREAM ~ FS.StreamOpen[fileName: remoteName, accessOptions: read, streamOptions: streamOptions, wantedCreatedTime: created];
CopyStream[from: inputStream, to: outputStream, fileByteSize: 0];
created ← FS.GetInfo[FS.OpenFileFromStream[inputStream]].created;
IO.Close[inputStream];
IO.Close[outputStream];
};
CopyFromRemote:
PROC [to:
FS.OpenFile, remoteName:
ROPE, created: BasicTime.
GMT, userProps: UserProperties] ~ {
outputStream: IO.STREAM ← FS.StreamFromOpenFile[openFile: to, accessRights: write, streamOptions: streamOptions];
fullFName, server, file: ROPE;
cp: FS.ComponentPositions;
[fullFName, cp] ← FS.ExpandName[remoteName];
server ← Rope.Substr[fullFName, cp.server.start, cp.server.length];
file ← Rope.Substr[fullFName, cp.dir.start-1];
IF Rope.IsEmpty[server] THEN ERROR FS.Error[[user, $noServer, "Missing server name"]]
ELSE {
stp: STP.Handle ← STP.Create[];
open: BOOL ← FALSE;
Action:
PROC ~ {
Confirm: STP.ConfirmProcType = TRUSTED {RETURN[answer: do, localStream: outputStream]};
herald: ROPE ← STP.Open[stp, FSRemoteFile.GetServerPupName[server]];
open ← TRUE;
STP.Login[stp, userProps.userName, userProps.userPassword];
STP.Retrieve[stp, file, Confirm];
STP.Close[stp];
open ← FALSE;
};
Action[ !
STP.Error => ReportSTPError[stpCode: code, server: server, file: file, time: created];
UNWIND => {IF open THEN STP.Close[stp]; IF outputStream#NIL THEN {IO.Close[outputStream]; outputStream ← NIL}};
];
IO.Close[outputStream]; outputStream ← NIL;
};
};
ReportSTPError:
PROC [stpCode:
STP.ErrorCode, server, file:
ROPE, time: BasicTime.
GMT] = {
Unfortunate duplication from FSRemoteFileImpl.
BracketServer:
PROC[server:
ROPE]
RETURNS [
ROPE] = {
IF Rope.Match["[*", server]
THEN RETURN [server]
ELSE RETURN [ Rope.Cat[ "[", server, "]" ] ];
};
gName: ROPE = Rope.Concat[BracketServer[server], file];
e1: ROPE ← "Server for \"";
e2: ROPE ← "\"";
code: FSBackdoor.ErrorCode;
NewError:
PROC [group:
FS.ErrorGroup, code:
ATOM, explanation:
ROPE] = {
ERROR FS.Error[[group, code, Rope.Cat[e1, gName, "\"", explanation]]];
};
IF stpCode = noSuchFile
THEN {
FSReport.UnknownFile[gName, time]; -- raises FS.Error
};
SELECT stpCode
FROM
noRouteToNetwork, noNameLookupResponse => {
code ← serverInaccessible;
e2 ← "\" is inaccessible";
};
connectionClosed => {
code ← wentOffline;
e2 ← "\" connection closed unexpectedly (wentOffline)";
};
connectionRejected => {
code ← connectionRejected;
e2 ← "\" rejected the connection attempt";
};
connectionTimedOut => {
code ← connectionTimedOut;
e2 ← "\" timed-out the connection";
};
accessDenied => {
code ← accessDenied;
e2 ← "\" denied file access permission";
};
requestRefused => {
code ← quotaExceeded;
e1 ← "Request refused (possibily no quota for storing) for \"";
};
accessError => {
code ← fileBusy;
e1 ← "\"";
e2 ← "\" is locked on the server";
};
illegalUserName => {
code ← badCredentials;
e1 ← "Credentials rejected when accessing \"";
};
illegalFileName => {
code ← illegalName;
e2 ← "\" says that the file name is illegal";
};
noSuchHost => {
code ← unknownServer;
e1 ← "Couldn't find the server for \"";
};
alreadyAConnection =>
NewError[bug, $alreadyAConnection, " already had a connection"];
noConnection =>
NewError[bug, $noConnection, " gave a noConnection error"];
illegalUserPassword =>
NewError[environment, $illegalUserPassword, " had an illegal user password"];
illegalUserAccount =>
NewError[environment, $illegalUserAccount, " had an illegal user account"];
illegalConnectName =>
NewError[environment, $illegalConnectName, " had an illegal connect name"];
illegalConnectPassword =>
NewError[environment, $illegalConnectPassword, " had an illegal connect password"];
credentailsMissing =>
NewError[environment, $credentailsMissing, " had missing credentails"];
protocolError =>
NewError[bug, $protocolError, " gave a protocol error to STP"];
noSuchFile =>
NewError[bug, $noSuchFile, " reported no such file"];
undefinedError =>
NewError[bug, $undefinedError, " gave STP an undefinedError"];
ENDCASE => ERROR;
FSBackdoor.ProduceError[code, Rope.Cat[e1, gName, e2]];
};
DoFiles:
PROC [stream:
STREAM, userProps: UserProperties, cs: CommandString, action:
PROC [stream:
STREAM, userProps: UserProperties, fullFName: FileName, created: BasicTime.
GMT, bytes:
INT, translator: NamedTranslator]
RETURNS [refused:
BOOL ←
FALSE]] ~ {
matches: BOOL ← FALSE;
first: BOOL ← TRUE;
namedTranslator: NamedTranslator ← NamedTranslatorFromProplist[cs.string];
Info:
PROC [fullFName, attachedTo:
ROPE, created: BasicTime.
GMT, bytes:
INT, keep:
CARDINAL]
RETURNS [continue:
BOOL ←
TRUE] ~ {
refused: BOOL;
fileName: FileName ← BothFromOne[fullFName, localToRemote];
IF namedTranslator # NIL THEN fileName.remote ← FixPseudoName[fileName.remote, namedTranslator];
IF (first AND cs.mark = newDirectory) OR cs.mark = directory
THEN SendMark[stream, hereIsPList];
IF namedTranslator#
NIL
THEN {
created ← BasicTime.Update[created, 1];
bytes ← (bytes+999)/1000*1000;
};
refused ← action[stream: stream, userProps: userProps, fullFName: fileName, created: created, bytes: bytes, translator: namedTranslator];
IF NOT refused THEN matches ← TRUE;
first ← FALSE;
};
Name:
PROC [fullFName:
ROPE]
RETURNS [continue:
BOOL ←
TRUE] ~ {
refused: BOOL;
fileName: FileName ← BothFromOne[fullFName, localToRemote];
IF namedTranslator # NIL THEN fileName.remote ← FixPseudoName[fileName.remote, namedTranslator];
IF (first AND cs.mark = newDirectory) OR cs.mark = directory
THEN SendMark[stream, hereIsPList];
refused ← action[stream: stream, userProps: userProps, fullFName: fileName, created: BasicTime.nullGMT, bytes: 0, translator: namedTranslator];
IF NOT refused THEN matches ← TRUE;
first ← FALSE;
};
errorDesc: FS.ErrorDesc;
fsPattern: ROPE ← NIL;
listOrRetrieve: BOOL ~ (cs.mark = retrieve OR cs.mark = directory OR cs.mark = newDirectory);
GetUserProperties[cs, userProps];
IF
NOT ValidUser[userProps.userName, userProps.userPassword,
IF namedTranslator#
NIL
AND listOrRetrieve
THEN newDirectory
ELSE cs.mark]
THEN {
No[stream, accessDenied, "Access denied"];
RETURN;
};
IF userProps.version =
NIL
AND cs.mark = retrieve
THEN {
userProps.version ← "H";
};
IF namedTranslator #
NIL
THEN {
fsPattern ← RemoteNameOfFileToBeTranslated[userProps !
FS.Error => {errorDesc ← error; CONTINUE}
]
}
ELSE {
fsPattern ← FullFNameFromUserProperties[userProps !
FS.Error => {errorDesc ← error; CONTINUE}
].local
};
IF fsPattern#
NIL
AND Rope.Size[userProps.version] > 0
THEN {
fsPattern ← Rope.Cat[fsPattern, "!", userProps.version];
};
IF errorDesc.explanation # NIL THEN {GenerateFileError[stream, errorDesc]; RETURN};
IF userProps.desiredProperty[createDate]
OR userProps.desiredProperty[size]
THEN {
FS.EnumerateForInfo[pattern: fsPattern, proc: Info
! FS.Error => {errorDesc ← error; CONTINUE}
];
}
ELSE {
FS.EnumerateForNames[pattern: fsPattern, proc: Name
! FS.Error => {errorDesc ← error; CONTINUE}
];
};
IF errorDesc.explanation # NIL THEN {GenerateFileError[stream, errorDesc]; RETURN};
IF matches THEN Finish[stream, ""] ELSE No[stream, fileNotFound, "File not found"];
};
RopeFromMark:
PROC [mark: STPCode.Mark]
RETURNS [
ROPE] ~ {
RETURN [
SELECT mark
FROM
retrieve => "Retrieve",
newStore => "New-Store",
comment => "Comment",
iAmVersion => "Version",
directory => "Enumerate",
newDirectory => "New-Enumerate",
delete => "Delete",
yes => "Yes",
no => "No",
ENDCASE => Convert.RopeFromInt[mark.ORD, 8]
]
};
MakeNewServerViewer:
PROC [stream:
STREAM, clientData:
REF
ANY, remote: Pup.Address] ~ {
otherGuy: ROPE ← PupName.HisName[remote];
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
directory => DoFiles[stream, userProps, cs, SendPropList];
newDirectory => DoFiles[stream, userProps, cs, SendPropList];
retrieve => DoFiles[stream, userProps, cs, RetrieveFile];
store => StoreFile[stream, userProps, cs, FALSE];
newStore => StoreFile[stream, userProps, cs];
delete => DoFiles[stream, userProps, cs, DeleteFile];
comment => NULL;
ENDCASE => No[stream, STPCode.Reply.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: STPCode.Mark ← null,
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: STPCode.Mark ← null]
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 ← null;
GetTextToMark[];
IF text.length # 0 THEN SIGNAL ProtocolError;
IF closed THEN RETURN;
cs.mark ← VAL[PupStream.ConsumeMark[stream]];
};
GetTextToMark[];
cs.string ← Rope.FromRefText[text];
RefText.ReleaseScratch[text];
{
t: STPCode.Mark ← VAL[PupStream.ConsumeMark[stream]];
IF t # eoc 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 # iAmVersion
DO
SIGNAL ProtocolError;
cs ← GetCommandString[stream];
ENDLOOP;
};
SendHerald:
PROC [stream:
STREAM] ~ {
SendMark[stream, iAmVersion];
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] ~ {
viewer: ViewerClasses.Viewer ← FindMyViewer[from, to];
pie: PieData ← NARROW[ViewerOps.FetchProp[viewer, $PieData]];
text: REF TEXT ← RefText.ObtainScratch[512];
toGo: INT ← fileByteSize;
WHILE
IO.GetBlock[from, text, 0] > 0
DO
IO.PutBlock[to, text];
toGo ← toGo - text.length;
pie.fraction ← REAL[toGo]/MAX[fileByteSize, 1];
ENDLOOP;
RefText.ReleaseScratch[text];
pie.fraction ← REAL[toGo]/MAX[fileByteSize, 1];
};
ftpListener: PupStream.Listener ← 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]]];
};
TurnOn:
PROC = {
ftpListener ← PupStream.CreateListener[
local: PupWKS.ftp,
worker: MakeNewServerViewer,
getTimeout: 3*LONG[60000],
putTimeout: 30*LONG[60000] ];
IF useSingle THEN StartSingle[];
ShowOption["started"];
};
onOffed: BOOL ← FALSE;
out.PutRope[heraldMessage];
out.PutChar['\n];
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], Rope.Equal[arg, "off",
FALSE] => {
IF ftpListener #
NIL
THEN {
PupStream.DestroyListener[ftpListener];
ftpListener ← NIL;
};
StopSingle[];
ShowOption["stopped"];
onOffed ← TRUE;
};
Rope.Equal[arg, "start",
FALSE], Rope.Equal[arg, "on",
FALSE] => {
TurnOn[];
onOffed ← TRUE;
};
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"];
};
Rope.Equal[arg, "translate",
FALSE] => {
doTranslating ← TRUE;
ShowOption["willing to translate files"];
};
Rope.Equal[arg, "noTranslate",
FALSE] => {
doTranslating ← FALSE;
ShowOption["not willing to translate files"];
};
ENDCASE => {
ShowOption[IF ftpListener # NIL THEN "running" ELSE "not running"];
onOffed ← TRUE;
};
ENDLOOP;
IF ftpListener = NIL AND NOT onOffed THEN TurnOn[];
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 ← [icon: maxIcon, fraction: 1.0]]];
viewer.icon ← private;
viewer.class ← fakeTypescriptClass;
TRUSTED { Process.Detach[FORK WatchPieFraction[viewer]]; };
};
};
FindMyViewer:
PROC [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];
};
maxIcon: NAT ← 19;
PieData: TYPE ~ REF PieDataRep;
PieDataRep:
TYPE ~
RECORD [icon:
INT, fraction:
REAL];
WatchPieFraction:
PROC [viewer: ViewerClasses.Viewer] ~ {
pause: Process.Ticks = Process.MsecToTicks[100];
pieData: PieData ← NARROW[ViewerOps.FetchProp[viewer, $PieData]];
old: INT ← -1;
Process.SetPriority[Process.priorityBackground];
UNTIL viewer.destroyed
DO
icon: INT ← Real.RoundLI[MAX[MIN[pieData.fraction, 1.0], 0.0]*maxIcon];
IF icon = 0 AND pieData.fraction > 0 THEN icon ← 1;
IF icon # old
AND viewer.iconic
THEN {
old ← icon;
pieData.icon ← icon;
ViewerOps.PaintViewer[viewer, all, FALSE]; };
Process.Pause[pause];
ENDLOOP;
};
MyPaint: ViewerClasses.PaintProc ~ {
IF self.iconic
THEN {
icon: INT ← maxIcon;
WITH ViewerOps.FetchProp[self, $PieData]
SELECT
FROM
pieData: PieData => icon ← pieData.icon;
ENDCASE => NULL;
MyPaintIcon[context, icon, 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";