
    <<STPServerMainImpl.mesa>>
        <<Copyright (C) 1984, 1985 Xerox Corporation.  All rights reserved.>>
        <<Michael Plass, December 31, 1985 9:57:05 am 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>>
        <<Hal Murray, May 12, 1986 7:07:38 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, 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";

    <<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.