STPServerMainImpl.mesa
Copyright (C) 1984, 1985 Xerox Corporation. All rights reserved.
Michael Plass, February 18, 1986 3:17:56 pm PST
Jim Gasbarro, March 8, 1985 11:39:14 am PST
Russ Atkinson (RRA) June 21, 1985 1:05:20 pm PDT
Spreitzer, September 4, 1985 10:01:17 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],
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, 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],
PupDefs USING [GetHostName],
PupStream USING [CloseReason, ConsumeMark, CreatePupByteStreamListener, DestroyPupListener, PupListener, SecondsToTocks, SendMark, StreamClosing, TimeOut],
PupTypes USING [ftpSoc, PupAddress],
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],
STPOps USING [markComment, markDelete, markDirectory, markEOC, markHereIsFile, markHereIsPList, markIAmVersion, markNewDirectory, markNewStore, markNo, markRetrieve, markStore, markYes],
STPReplyCode USING [ReplyCode],
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, PupDefs, 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 18, 1986 3:17:55 pm PST";
debugging: BOOLFALSE;
promiscuous: BOOLFALSE;
useSingle: BOOLTRUE;
doTranslating: BOOLTRUE;
mute: BOOLFALSE;
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];
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 GMTALL[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: BOOLFALSE] ~ {
rFull: ROPE;
cp: FS.ComponentPositions;
desiredProperty: ARRAY STP.ValidProperties OF BOOL ← userProps.desiredProperty;
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: BOOLFALSE] ~ {
errorDesc: FS.ErrorDesc;
cs: CommandString;
HereIsPList[stream, userProps, fileName, created, bytes];
cs ← GetCommandString[stream];
SELECT cs.mark FROM
STPOps.markYes => {
ENABLE {
FS.Error => {errorDesc ← error; GO TO bogus};
IO.Error => {errorDesc ← FS.ErrorFromStream[stream]; GO TO bogus};
};
local: STREAM;
local ← FS.StreamOpen[fileName.local, $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];
YesWithoutEOC[stream, "Transfer complete"];
EXITS bogus => GenerateFileError[stream, errorDesc]
};
STPOps.markNo => refused ← TRUE;
ENDCASE;
};
RetrieveFile: PROC [stream: STREAM, userProps: UserProperties, fullFName: FileName, created: BasicTime.GMT, bytes: INT, translator: NamedTranslator] RETURNS [refused: BOOLFALSE] ~ {
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: BOOLFALSE] ~ {
errorDesc: FS.ErrorDesc;
cs: CommandString;
HereIsPList[stream, userProps, fullFName, created, bytes];
cs ← GetCommandString[stream];
SELECT cs.mark FROM
STPOps.markYes => {
FS.Delete[fullFName.local, created
! FS.Error => {errorDesc ← error; GO TO bogus}
];
YesWithoutEOC[stream, "Deleted"];
EXITS bogus => GenerateFileError[stream, errorDesc];
};
STPOps.markNo => 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];
StoreFile: PROC [stream: STREAM, userProps: UserProperties, cs: CommandString, newStore: BOOLTRUE] ~ {
local: STREAMNIL;
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
! FS.Error => {errorDesc ← error; 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 ← 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 ← 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 => {errorDesc ← FS.ErrorFromStream[stream]; GO TO bogus};
];
cs ← GetCommandString[stream];
SELECT cs.mark FROM
STPOps.markYes => {
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]]];
};
STPOps.markNo => {
openFile: FS.OpenFile ← FS.OpenFileFromStream[local];
name: FileName ← BothFromOne[FS.GetName[openFile].fullFName, localToRemote];
created: BasicTime.GMTFS.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: BOOLFALSE] = {
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: STPReplyCode.ReplyCode ← 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: 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];
};
YesWithoutEOC: PROC [stream: STREAM, expl: ROPE] ~ {
PupStream.SendMark[stream, STPOps.markYes];
IO.PutChar[stream, 0C];
IF expl # NIL THEN IO.PutRope[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: FileName, created: BasicTime.GMT, bytes: INT] ~ {
PupStream.SendMark[stream, STPOps.markHereIsPList];
[] ← 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: INTMIN[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.STREAMFS.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: BOOLFALSE;
Action: PROC ~ {
Confirm: STP.ConfirmProcType = TRUSTED {RETURN[answer: do, localStream: outputStream]};
herald: ROPESTP.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: BOOLFALSE]] ~ {
matches: BOOLFALSE;
first: BOOLTRUE;
namedTranslator: NamedTranslator ← NamedTranslatorFromProplist[cs.string];
Info: PROC [fullFName, attachedTo: ROPE, created: BasicTime.GMT, bytes: INT, keep: CARDINAL] RETURNS [continue: BOOLTRUE] ~ {
refused: BOOL;
fileName: FileName ← BothFromOne[fullFName, localToRemote];
IF namedTranslator # NIL THEN fileName.remote ← FixPseudoName[fileName.remote, namedTranslator];
IF (first AND cs.mark = STPOps.markNewDirectory) OR cs.mark = STPOps.markDirectory
THEN PupStream.SendMark[stream, STPOps.markHereIsPList];
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: BOOLTRUE] ~ {
refused: BOOL;
fileName: FileName ← BothFromOne[fullFName, localToRemote];
IF namedTranslator # NIL THEN fileName.remote ← FixPseudoName[fileName.remote, namedTranslator];
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: fileName, created: BasicTime.nullGMT, bytes: 0, translator: namedTranslator];
IF NOT refused THEN matches ← TRUE;
first ← FALSE;
};
errorDesc: FS.ErrorDesc;
fsPattern: ROPENIL;
listOrRetrieve: BOOL ~ (cs.mark = STPOps.markRetrieve OR cs.mark = STPOps.markDirectory OR cs.mark = STPOps.markNewDirectory);
GetUserProperties[cs, userProps];
IF NOT ValidUser[userProps.userName, userProps.userPassword, IF namedTranslator#NIL AND listOrRetrieve THEN STPOps.markNewDirectory ELSE cs.mark] THEN {
No[stream, accessDenied, "Access denied"];
RETURN;
};
IF userProps.version = NIL AND cs.mark = STPOps.markRetrieve 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: 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]]];
};
TurnOn: PROC = {
ftpListener ← PupStream.CreatePupByteStreamListener[
local: PupTypes.ftpSoc,
proc: MakeNewServerViewer,
ticks: PupStream.SecondsToTocks[60]
];
IF useSingle THEN StartSingle[];
ShowOption["started"];
};
onOffed: BOOLFALSE;
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.DestroyPupListener[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 ← [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";
Initialization
TextFromTioga: PROC [input, output: FS.OpenFile] ~ {
document: TextNode.Ref ~ PutGet.FromFileC[file: input];
outputStream: IO.STREAM ~ FS.StreamFromOpenFile[openFile: output, accessRights: write, streamOptions: streamOptions];
PutGet.WritePlain[h: outputStream, root: document, restoreDashes: TRUE];
TEditInput.FreeTree[document];
IO.Close[outputStream];
};
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]
];
FOR ac: LimitedAccessClass IN LimitedAccessClass DO
created: GMT ← BasicTime.nullGMT;
created ← FS.FileInfo[accessFileNames[ac] ! FS.Error => CONTINUE].created;
accessFileCreateDates[ac] ← created;
ENDLOOP;
Register["TextFromTioga", TextFromTioga];
Booting.RegisterProcs[r: AfterRollback];
TRUSTED {Process.Detach[FORK WatchAccessFiles[]]};
Commander.Register["STPServer", STPServerCommand, "STPServer [ start | stop ]\n[]<>STPServer.readAccess should have list of permissible readers"];
};
Init[];
END.