
    <<TerminalCoordinationImpl.Mesa>>
        <<Copyright Ó 1990, 1992 by Xerox Corporation.  All rights reserved.>>
        <<Last tweaked by Mike Spreitzer on February 20, 1992 11:29 am PST>>
        <<Willie-s, April 21, 1992 7:57 pm PDT>>

    DIRECTORY BasicTime, Commander, Convert, HostAndTerminalOps, IO, IOErrorFormatting, NetAddressing, NetworkName, NetworkStream, 
    Process, Rope, SimpleFeedback, TerminalMultiServing;

    TerminalCoordinationImpl: CEDAR MONITOR
        LOCKS rm USING rm: RefLock
        IMPORTS BasicTime, Commander, Convert, HostAndTerminalOps, IO, IOErrorFormatting, NetAddressing, NetworkName, NetworkStream, 
        Process, Rope, SimpleFeedback
        EXPORTS TerminalMultiServing
        =

    BEGIN OPEN HaTO:HostAndTerminalOps, NA:NetAddressing, NN:NetworkName, Nws:NetworkStream, TMS:TerminalMultiServing;
<<Random Stuff>>
    ROPE: TYPE ~ Rope.ROPE;
    RefLock: TYPE ~ REF MONITORLOCK;
<<Network Service>>
    debugNetworkService: BOOL Ź TRUE;
    firstTerminalPort: INT Ź 58813;
    deltaPort: INT Ź 10;
    portLimit: INT Ź 10;
    arpaTerminalPort: ROPE Ź "?uninitialized?";
    arpaListener: Nws.Listener Ź NIL;

    TheVWorker: TMS.ViewersWorker Ź NIL;
    TheSWorker: TMS.SimpleTerminalWorker Ź NIL;

    RestartArpaListeningForHosts: Commander.CommandProc ~ {
        [] Ź StopArpaListeningForHosts[NIL];
        FOR i: INT IN [0 .. portLimit] DO
            arpaTerminalPort Ź IO.PutFR1["%g", [integer[firstTerminalPort + i*deltaPort]] ];
            arpaListener Ź Nws.CreateListener[
                protocolFamily: $ARPA,
                transportClass: $basicStream,
                local: NN.AddressFromName[$ARPA, NIL, arpaTerminalPort, port].addr,
                listenerWorkerProc: NwsWorkForHost
                ! IO.Error => {
                    codes: LIST OF ATOM Ź NIL;
                    msg: ROPE Ź "!Error getting details!";
                    [codes, msg] Ź Nws.GetIOErrorDetails[stream !NetworkStream.Error => CONTINUE];
                    SimpleFeedback.PutFL[$TerminalCoordination, oneLiner, $Error, "%g creating Terminal Control TCP listener on port %g", 
                    LIST[[rope[NA.FormatError[codes, msg]]], [rope[arpaTerminalPort]]] ];
                    CONTINUE};
                Nws.Error => {
                    SimpleFeedback.PutFL[$TerminalCoordination, oneLiner, $Error, "%g creating Terminal Control TCP listener on port %g", 
                    LIST[[rope[NA.FormatError[codes, msg]]], [rope[arpaTerminalPort]]] ];
                    CONTINUE}];
            IF arpaListener#NIL THEN {
                SimpleFeedback.PutFL[$TerminalCoordination, oneLiner, $FYI, "At %g, Terminal Control listener on TCP port %g.", 
                LIST[[time[BasicTime.Now[]]], [rope[arpaTerminalPort]]] ];
                EXIT};
            ENDLOOP;
        RETURN};

    StopArpaListeningForHosts: Commander.CommandProc ~ {
        l: Nws.Listener ~ arpaListener;
        IF l#NIL THEN {
            arpaListener Ź NIL;
            Nws.DestroyListener[l];
            Process.PauseMsec[2000]};
        RETURN};

    NwsWorkForHost: PROC [listener: NetworkStream.Listener, in, out: IO.STREAM] ~ {
        pf, tc: ATOM;
        remote, invertErr: ROPE Ź NIL;
        rna: NA.Address Ź NA.nullAddress;
        [protocolFamily: pf, remote: remote, transportClass: tc] Ź NetworkStream.GetStreamInfo[out];
        rna Ź NA.FromNnAddress[remote, pf !NA.Error => {invertErr Ź NA.FormatError[codes, msg]; CONTINUE}];
        WorkForHost[in, out, rna, remote, invertErr];
        RETURN};

    versionBrick: CHAR ~ CHAR.LAST;
    coordVersions: HaTO.ProtocolVersionRange Ź [1, 4];

    FailWork: ERROR [why: ROPE] ~ CODE;

    WorkForHost: PROC [in, out: IO.STREAM, remote: TMS.Host, remoteAddress, invertErr: ROPE] ~ {
        GetPort: PROC ~ {
            IF pv >= 4 THEN {
                addr: ROPE ~ in.GetRopeLiteral[];
                portName: ROPE ~ NN.NameFromAddress[$ARPA, addr, port !NN.Error => FailWork[NA.FormatError[CONS[$NetworkNameError, codes], msg]] 
                ].name;
                sep: CHAR ~ in.GetChar[];
                IF sep#'; THEN FailWork[IO.PutFR1["sep was '%c, not ';", [character[sep]] ]];
                remote Ź remote.SetSocket[portName];
                RETURN}
            ELSE {
                remote Ź remote.SetSocket["58812"];
                RETURN};
            };
        cmd: CHAR;
        reply: ROPE Ź NIL;
        pv: HaTO.ProtocolVersion Ź 1;
        {ENABLE {
            IO.Error => IF stream=in OR stream=out THEN GOTO closeit;
            IO.EndOfStream => IF stream=in OR stream=out THEN GOTO closeit;
            };
        cmd Ź in.GetChar[];
        {ENABLE FailWork => {reply Ź why; CONTINUE};
        IF cmd=versionBrick THEN {
            out.PutChar[versionBrick];
            out.PutChar[VAL[coordVersions.min]];
            out.PutChar[VAL[coordVersions.max]];
            out.Flush[];
            {hisVR: HaTO.ProtocolVersionRange Ź [min: in.GetChar[].ORD];
            hisVR.max Ź in.GetChar[].ORD;
            pv Ź MIN[coordVersions.max, hisVR.max];
            IF MAX[hisVR.min, coordVersions.min] > pv THEN {
                reply Ź IO.PutFLR["version mismatch: your[%g..%g] <> my[%g .. %g] coordination protocol", LIST[[integer[hisVR.min]], 
                [integer[hisVR.max]], [integer[coordVersions.min]], [integer[coordVersions.max]]] ];
                GOTO Reply};
            cmd Ź in.GetChar[];
            cmd Ź cmd}}
        ELSE {reply Ź "didn't open with version brick";
            GOTO Reply};
        IF remote = NA.nullAddress THEN {
            reply Ź IO.PutFR["Couldn't invert your address (%g): %g", [rope[remoteAddress]], [rope[invertErr]] ];
            GOTO Reply};
        SELECT cmd FROM
            'D => {
                GetPort[];
                IF IsHost[remote] THEN {
                    DontServeHost[remote];
                    reply Ź "OK";
                    }
                ELSE reply Ź "already disconnected from you";
                };
            'V => {
                sessPort: ROPE Ź NA.ExtractSocket[remote];
                GetPort[];
                SELECT TRUE FROM
                    NOT IsHost[remote] => reply Ź "I'm not a terminal for you";
                    TheVWorker = NIL => reply Ź "Host not fully initialized yet";
                    ENDCASE => {
                        sessionDescr: ROPE ~ IO.PutFR["%g (session %g)", [rope[NA.FormatAddress[remote, TRUE]]], [rope[sessPort]] ];
                        IF debugNetworkService THEN SimpleFeedback.PutFL[$RemoteViewersTerminal, oneLiner, $Debug, "At %g, starting RemoteViewersTerminal 
                        service for %g.", LIST[[time[BasicTime.Now[]]], [rope[sessionDescr]]] ];
                        TheVWorker[in, out, remote, sessionDescr, NwsPush !UNWIND =>
                            IF debugNetworkService THEN SimpleFeedback.PutFL[$RemoteViewersTerminal, oneLiner, $Debug, "At %g, aborting RemoteViewersTerminal 
                            service for %g.", LIST[[time[BasicTime.Now[]]], [rope[sessionDescr]]] ] ];
                        IF debugNetworkService THEN SimpleFeedback.PutFL[$RemoteViewersTerminal, oneLiner, $Debug, "At %g, ending RemoteViewersTerminal 
                        service for %g.", LIST[[time[BasicTime.Now[]]], [rope[sessionDescr]]] ];
                        GOTO closeit};
                };
            'S => {
                sessPort: ROPE Ź NA.ExtractSocket[remote];
                GetPort[];
                SELECT TRUE FROM
                    NOT IsHost[remote] => reply Ź "I'm not a terminal for you";
                    TheSWorker = NIL => reply Ź "Host not fully initialized yet";
                    ENDCASE => {
                        sessionDescr: ROPE ~ IO.PutFR["%g (session %g)", [rope[NA.FormatAddress[remote, TRUE]]], [rope[sessPort]] ];
                        close: BOOL;
                        IF debugNetworkService THEN SimpleFeedback.PutFL[$RemoteSimpleTerminal, oneLiner, $Debug, "At %g, starting RemoteSimpleTerminal 
                        service for %g.", LIST[[time[BasicTime.Now[]]], [rope[sessionDescr]]] ];
                        close Ź TheSWorker[in, out, remote, sessPort !UNWIND =>
                            IF debugNetworkService THEN SimpleFeedback.PutFL[$RemoteSimpleTerminal, oneLiner, $Debug, "At %g, aborting RemoteSimpleTerminal 
                            service for %g.", LIST[[time[BasicTime.Now[]]], [rope[sessionDescr]]] ] ];
                        IF debugNetworkService THEN SimpleFeedback.PutFL[$RemoteSimpleTerminal, oneLiner, $Debug, "At %g, ending RemoteSimpleTerminal 
                        service for %g.", LIST[[time[BasicTime.Now[]]], [rope[sessionDescr]]] ];
                        IF close THEN GOTO closeit ELSE RETURN};
                };
            's => {outStream: IO.STREAM ~ IO.ROS[];
                SendPVR: PROC [protocol: ROPE, pvr: HaTO.ProtocolVersionRange] ~ {
                    outStream.PutF["\"%q\" %g %g; ", [rope[protocol]], [integer[pvr.min]], [integer[pvr.max]]];
                    RETURN};
                HaTO.EnumerateProtocolVersionsOfSide[Host, SendPVR];
                reply Ź outStream.RopeFromROS[];
                };
            ENDCASE => {
                reply Ź IO.PutFR1["Bad command character: %g", [rope[Rope.FromChar[cmd]]]];
                };
        EXITS Reply => NULL};
        out.PutRope[reply.Concat["\r"]];
        IF debugNetworkService THEN SimpleFeedback.PutFL[$TerminalCoordination, oneLiner, $Debug, "Reply to cmd %g from host %g 
        (invertErr=%g) is %g", LIST[[character[cmd]], [rope[remoteAddress]], [rope[invertErr]], [rope[reply]]] ];
        IO.Flush[out]; [] Ź in.GetChar[];
        in.Close[!IO.Error => CONTINUE]; out.Close[!IO.Error => CONTINUE];
        out Ź out;
        EXITS closeit => {
            in.Close[!IO.Error => CONTINUE];
            out.Close[!IO.Error => CONTINUE]};
        };
        RETURN};

    NwsPush: PROC [pushStream: IO.STREAM] = {
        Nws.SendSoon[pushStream, 0];
        RETURN};
<<Exports to TerminalMultiServing>>
    InterestList: TYPE ~ LIST OF TMS.Interest;
    HostList: TYPE ~ LIST OF TMS.Host;

    clientLock: RefLock ~ NEW [MONITORLOCK Ź []];
    addrs: HostList Ź NIL;
    interests: InterestList Ź NIL;

    debugSendCommand: BOOL Ź TRUE;

    EqualHosts: PUBLIC PROC [c1, c2: TMS.Host] RETURNS [BOOL]
        ~ {RETURN NA.EqualAddrs[c1, c2]};

    EnumerateHosts: PUBLIC PROC [Consume: PROC [TMS.Host]] ~ {
        FOR al: HostList Ź addrs, al.rest WHILE al#NIL DO
            Consume[al.first];
            ENDLOOP;
        RETURN};

    IsHost: PUBLIC PROC [addr: TMS.Host] RETURNS [BOOL] ~ {
        Enter: ENTRY PROC [rm: RefLock] RETURNS [BOOL] ~ {
            ENABLE UNWIND => NULL;
            RETURN InnerIsHost[addr]};
        RETURN Enter[clientLock]};

    InnerIsHost: INTERNAL PROC [addr: TMS.Host] RETURNS [BOOL] ~ {
        FOR al: HostList Ź addrs, al.rest WHILE al#NIL DO
            IF EqualHosts[al.first, addr] THEN RETURN [TRUE];
            ENDLOOP;
        RETURN [FALSE]};

    ServeHost: PUBLIC PROC [addr: TMS.Host, role: TMS.Role] RETURNS [whyNot: ROPE] ~ {
        WithLock: ENTRY PROC [rm: RefLock] RETURNS [BOOL] ~ {
            ENABLE UNWIND => NULL;
            IF InnerIsHost[addr] THEN RETURN [TRUE];
            addrs Ź CONS[addr, addrs];
            FOR is: InterestList Ź interests, is.rest WHILE is # NIL DO
                is.first.NoteHost[is.first, addr, TRUE];
                ENDLOOP;
            RETURN [FALSE]};
        whyNot Ź NIL;
        IF addr=NA.nullAddress THEN RETURN ["I can't serve the null client"];
        [] Ź WithLock[clientLock];
        whyNot Ź SendCommand[addr, roleCmds[role], TRUE, TRUE].ans;
        whyNot Ź IF whyNot.Length[]=0 THEN "no response" ELSE IF whyNot.Equal["OK"] THEN NIL ELSE whyNot;
        IF whyNot # NIL THEN DontServeHost[addr];
        RETURN};
    roleCmds: ARRAY TMS.Role OF CHAR ~ [primary: 'c, secondary: 'o];

    DontServeHost: PUBLIC PROC [addr: TMS.Host] ~ {
        WithLock: ENTRY PROC [rm: RefLock] RETURNS [BOOL] ~ {
            ENABLE UNWIND => NULL;
            prev: HostList Ź NIL;
            addrs Ź addrs;
            FOR al: HostList Ź addrs, al.rest WHILE al#NIL DO
                IF EqualHosts[al.first, addr] THEN {
                    IF prev#NIL THEN prev.rest Ź al.rest ELSE addrs Ź al.rest;
                    EXIT};
                prev Ź al;
                REPEAT FINISHED => RETURN [FALSE];
                ENDLOOP;
            addrs Ź addrs;
            FOR is: InterestList Ź interests, is.rest WHILE is # NIL DO
                is.first.NoteHost[is.first, addr, FALSE];
                ENDLOOP;
            RETURN [TRUE]};
        IF WithLock[clientLock] THEN TRUSTED {Process.Detach[FORK Kissoff[addr, Convert.RopeFromTime[from: BasicTime.Now[], end: 
        seconds]]]};
        RETURN};

    Kissoff: PROC [addr: NA.Address, startTime: ROPE] ~ {
        [] Ź SendCommand[addr, 'd, TRUE, FALSE];
        RETURN};

    ServeNoHosts: PUBLIC PROC ~ {
        Dont: PROC [addr: TMS.Host] ~ {DontServeHost[addr]};
        EnumerateHosts[Dont];
        RETURN};

    AddMultiInterest: PUBLIC PROC [i: TMS.Interest] ~ {
        WithLock: ENTRY PROC [rm: RefLock] ~ {
            ENABLE UNWIND => NULL;
            interests Ź CONS[i, interests];
            FOR al: HostList Ź addrs, al.rest WHILE al#NIL DO
                i.NoteHost[i, al.first, TRUE];
                ENDLOOP;
            RETURN};
        WithLock[clientLock];
        RETURN};

    GetHisTerminal: PUBLIC PROC [host: TMS.Host] RETURNS [ok: BOOL, ans: ROPE] ~ {
        RETURN SendCommand[host, 'q, FALSE, FALSE];
        };

    GetHisVersions: PUBLIC PROC [client: TMS.Host] RETURNS [ok: BOOL, ans: ROPE] ~ {
        RETURN SendCommand[client, 's, FALSE, FALSE];
        };

    GetHisTerminalByName: PROC [name: ROPE] RETURNS [ok: BOOL, ans: ROPE] ~ {
        RETURN GetHisTerminal[NA.ParseAddress[name]];
        };

    SendCommand: PROC [dest: TMS.Host, cmd: CHAR, postfixSelf, postfixVersions: BOOL] RETURNS [ok: BOOL Ź TRUE, ans: ROPE] ~ {
        cmdIn, cmdOut: IO.STREAM Ź NIL;
        pv: HaTO.ProtocolVersion Ź 1;
        desta: ROPE Ź NIL;
        destf: ATOM Ź NIL;
        ansFromRem: BOOL Ź FALSE;
        {ENABLE {
            IO.Error => {ok Ź FALSE; ans Ź IOErrorFormatting.FormatError[ec]; CONTINUE};
            IO.EndOfStream => {ok Ź FALSE; ans Ź "IO.EndOfStream"; CONTINUE};
            Nws.Error => {ok Ź FALSE; ans Ź NA.FormatError[codes, msg]; CONTINUE};
            };
        SendPVR: PROC [protocol: ROPE, pvr: HaTO.ProtocolVersionRange] ~ {
            cmdOut.PutF["\"%q\" %g %g\r", [rope[protocol]], [integer[pvr.min]], [integer[pvr.max]]];
            RETURN};
        [desta, destf] Ź NA.ToNnAddress[dest !NA.Error => {ok Ź FALSE; ans Ź IO.PutFR["%g while converting %g %g %g to address", 
        [rope[NA.FormatError[codes, msg]]], [rope[NA.FormatAddress[dest, TRUE]]] ]; GOTO Dun}];
        [cmdIn, cmdOut] Ź Nws.CreateStreams[protocolFamily: destf, transportClass: $basicStream, remote: desta ];
        cmdOut.PutChar[versionBrick];
        cmdOut.PutChar[VAL[coordVersions.min]];
        cmdOut.PutChar[VAL[coordVersions.max]];
        cmdOut.Flush[];
        IF debugSendCommand THEN SimpleFeedback.PutFL[$TerminalCoordination, oneLiner, $Debug, "Sending cmd %g to host %g", 
        LIST[[character[cmd]], [rope[desta]]] ];
        {hisBrick: CHAR ~ cmdIn.GetChar[];
        IF hisBrick#versionBrick THEN {ans Ź "Host didn't open with version brick"; GOTO Dun};
        {hisVR: HaTO.ProtocolVersionRange Ź [min: cmdIn.GetChar[].ORD];
        hisVR.max Ź cmdIn.GetChar[].ORD;
        pv Ź MIN[coordVersions.max, hisVR.max];
        IF MAX[coordVersions.min, hisVR.min] > pv THEN {
            ans Ź IO.PutFLR["version mismatch: his[%g..%g] <> my[%g .. %g] coordination protocol", LIST[[integer[hisVR.min]], 
            [integer[hisVR.max]], [integer[coordVersions.min]], [integer[coordVersions.max]]] ];
            GOTO Dun};
        }};
        cmdOut.PutChar[cmd];
        IF postfixSelf AND pv>=4 THEN cmdOut.PutF1["\"%q\";", [rope[NN.AddressFromName[$ARPA, NIL, arpaTerminalPort, port].addr]] ];
        IF postfixVersions THEN {
            HaTO.EnumerateProtocolVersionsOfSide[Terminal, SendPVR];
            cmdOut.PutRope["\"\" 0 0\r"]};
        IO.Flush[cmdOut];
        IF debugSendCommand THEN SimpleFeedback.PutFL[$TerminalCoordination, oneLiner, $Debug, "Waiting for reply to cmd %g from host %g", 
        LIST[[character[cmd]], [rope[desta]]] ];
        ans Ź cmdIn.GetLineRope[]; ansFromRem Ź TRUE;
        EXITS Dun => cmd Ź cmd;
        };
        IF debugSendCommand THEN SimpleFeedback.PutFL[$TerminalCoordination, oneLiner, $Debug, "Answer for cmd %g from host %g is %g", 
        LIST[[character[cmd]], [rope[desta]], [rope[ans]]] ];
        IF cmdIn#NIL THEN {
            ENABLE IO.Error => CONTINUE;
            cmdOut.PutChar['.]; cmdOut.Flush[];
            cmdOut.Close[]; cmdIn.Close[]};
        RETURN};

    DescribeAtom: PROC [a: ATOM] RETURNS [ROPE] ~ {
        IF a=NIL THEN RETURN ["NIL"];
        RETURN IO.PutFR1["$%g", [atom[a]]]};

    EqualHostReferents: PUBLIC PROC [key1, key2: REF ANY] RETURNS [BOOL] ~ {
        ra1: REF TMS.Host ~ NARROW[key1];
        ra2: REF TMS.Host ~ NARROW[key2];
        RETURN EqualHosts[ra1­, ra2­]};

    HashHostReferent: PUBLIC PROC [key: REF ANY] RETURNS [CARDINAL] ~ TRUSTED {
        rh: REF TMS.Host ~ NARROW[key];
        RETURN rh­.HashAddr[]};

    SetViewersWorker: PUBLIC PROC [w: TMS.ViewersWorker]
        ~ {TheVWorker Ź w};

    SetSimpleTerminalWorker: PUBLIC PROC [w: TMS.SimpleTerminalWorker]
        ~ {TheSWorker Ź w};
<<Final Randomness>>
    HaTO.SetProtocolVersionRangeForSide[Terminal, "TerminalCoordination", coordVersions];
    [] Ź RestartArpaListeningForHosts[NIL];
    Commander.Register["RestartTerminalControlTcp", RestartArpaListeningForHosts, "restart Terminal Control TCP listener"];
    Commander.Register["StopTerminalControlTcp", StopArpaListeningForHosts, "stop Terminal Control TCP listener"];
END.