RemoteViewersTerminalsKernelImpl.mesa
Copyright Ó 1990, 1992 by Xerox Corporation. All rights reserved.
Last tweaked by Mike Spreitzer on July 14, 1992 10:53 am PDT
Willie-s, April 22, 1992 11:17 am PDT
DIRECTORY BasicTime, Commander, CommanderOps, HostAndTerminalOps, IO, NetAddressing, NetworkName, NetworkStream, Process, RefTab, RemoteViewersTerminalsKernel, Rope, SimpleFeedback, SymTab, TerminalMultiServing;
RemoteViewersTerminalsKernelImpl:
CEDAR
MONITOR
IMPORTS BasicTime, Commander, CommanderOps, HostAndTerminalOps, IO, NetAddressing, NetworkName, NetworkStream, Process, RefTab, Rope, SimpleFeedback, SymTab, TerminalMultiServing
EXPORTS RemoteViewersTerminalsKernel
=
BEGIN OPEN HAT:HostAndTerminalOps, NA:NetAddressing, NN:NetworkName, Nws:NetworkStream, RemoteViewersTerminalsKernel, TMS:TerminalMultiServing;
ROPE: TYPE ~ Rope.ROPE;
PVRMismatch: PUBLIC ERROR [other: HAT.ProtocolVersionRange] ~ CODE;
StyleData: TYPE ~ REF StylePrivate;
StylePrivate:
TYPE ~
RECORD [
MakeAnother: PROC,
idleServers: LIST OF ViewersServer ¬ NIL
];
debug: BOOL ¬ TRUE;
impld: BOOL ¬ FALSE;
myVersionRange: HAT.ProtocolVersionRange ¬ [min: HAT.ProtocolVersion.LAST, max: HAT.ProtocolVersion.FIRST];
int: TMS.Interest ~ NEW [TMS.InterestPrivate ¬ [NoteHost]];
addrToServer: RefTab.Ref ~ RefTab.Create[equal: TMS.EqualHostReferents, hash: TMS.HashHostReferent];
styles: SymTab.Ref--style -> Style-- ~ SymTab.Create[case: FALSE];
curStyle: ROPE ¬ NIL;
styleList: ROPE ¬ NIL;
SetViewersImpl:
PUBLIC
PROC [pvr:
HAT.ProtocolVersionRange, style:
ROPE,
MakeAnother:
PROC] ~ {
Doit:
ENTRY
PROC
RETURNS [start:
BOOL] ~ {
ENABLE UNWIND => NULL;
sd: StyleData ¬ NARROW[styles.Fetch[style].val];
IF impld
THEN {
start ¬ FALSE;
IF pvr # myVersionRange
THEN RETURN WITH ERROR PVRMismatch[myVersionRange]}
ELSE {
start ¬ impld ¬ TRUE;
myVersionRange ¬ pvr;
HAT.SetProtocolVersionRangeForSide[Terminal, "Viewers", myVersionRange];
};
IF sd=
NIL
THEN
IF NOT styles.Insert[style, NEW[StylePrivate ¬ [NIL]]] THEN ERROR;
IF sd.MakeAnother=
NIL
THEN styleList ¬ IF styleList#NIL THEN Rope.Cat[styleList, ", ", style] ELSE style;
sd.MakeAnother ¬ MakeAnother;
curStyle ¬ style;
RETURN};
IF Doit[]
THEN {
int.AddMultiInterest[];
TCPStart[! Nws.Error => {
SimpleFeedback.PutF[$RemoteTerminal, oneLiner, $Error, "%g trying to create Terminal Viewers TCP listener", [rope[NA.FormatError[codes, msg]]]];
CONTINUE}];
TMS.SetViewersWorker[Work]};
RETURN};
AddViewersServer:
PUBLIC
ENTRY
PROC [s: ViewersServer] ~ {
ENABLE UNWIND => NULL;
sd: StyleData ¬ NARROW[styles.Fetch[s.style].val];
IF sd=
NIL
THEN
{IF NOT styles.Insert[s.style, sd ¬ NEW[StylePrivate ¬ [NIL]] ] THEN ERROR};
sd.idleServers ¬ CONS[s, sd.idleServers];
RETURN};
GetViewersServerForHost:
PUBLIC
ENTRY
PROC [host: Host]
RETURNS [vs: ViewersServer] ~ {
ENABLE UNWIND => NULL;
ra: REF TMS.Host ~ NEW [TMS.Host ¬ host];
vs ¬ NARROW[addrToServer.Fetch[ra].val];
RETURN};
NoteHost:
PROC [interest:
TMS.Interest, addr: Host, isHost:
BOOL] ~ {
ra: REF TMS.Host ~ NEW [TMS.Host ¬ addr];
Try:
ENTRY
PROC
RETURNS [
PROC] ~ {
ENABLE UNWIND => NULL;
sd: StyleData ~ NARROW[styles.Fetch[curStyle].val];
s: ViewersServer ¬ NARROW[addrToServer.Fetch[ra].val];
IF isHost = (s#NIL) THEN RETURN [NIL];
IF
NOT isHost
THEN {
s.StopServing[s];
IF NOT addrToServer.Delete[ra] THEN ERROR;
sd.idleServers ¬ CONS[s, sd.idleServers];
RETURN [NIL]};
IF sd.idleServers=NIL THEN RETURN [sd.MakeAnother];
s ¬ sd.idleServers.first;
s.StartServing[s, addr];
sd.idleServers ¬ sd.idleServers.rest;
IF NOT addrToServer.Insert[ra, s] THEN ERROR;
RETURN [NIL]};
creator: PROC ~ Try[];
IF creator=NIL THEN RETURN;
creator[];
IF Try[]#NIL THEN ERROR--can't serve this host--;
};
WakeStyle:
PROC [style:
ROPE, err:
IO.
STREAM]
RETURNS [ok:
BOOL ¬
TRUE] ~ {
Try:
ENTRY
PROC
RETURNS [
PROC] ~ {
ENABLE UNWIND => NULL;
sd: StyleData ~ NARROW[styles.Fetch[style].val];
IF sd=
NIL
THEN {
err.PutF1["Style \"%q\" not registered.\n", [rope[style]] ];
ok ¬ FALSE;
RETURN [NIL]};
FOR vsl:
LIST
OF ViewersServer ¬ sd.idleServers, vsl.rest
WHILE vsl#
NIL
DO
IF
NOT vsl.first.Wake[vsl.first]
THEN {
curStyle ¬ style;
RETURN [NIL]};
ENDLOOP;
RETURN [sd.MakeAnother]};
creator: PROC ~ Try[];
IF creator=NIL THEN RETURN;
creator[];
IF Try[]#
NIL
THEN {
err.PutF1["Creator for %g style failed to make another terminal.\n", [rope[style]] ];
RETURN [FALSE]}};
Advise:
PROC [name:
ROPE] ~ {
remote: NA.Address ~ NA.ParseAddress[name];
NoteHost[NIL, remote, TRUE];
RETURN};
StopAdvising:
PROC [name:
ROPE] ~ {
remote: NA.Address ~ NA.ParseAddress[name];
NoteHost[NIL, remote, FALSE];
RETURN};
TCPStart:
PROC = {
arpaListener ¬ Nws.CreateListener[
protocolFamily: $ARPA,
transportClass: $basicStream,
local: NN.AddressFromName[$ARPA, NIL, arpaViewersTerminalSocket, port].addr,
listenerWorkerProc: NwsWorkForHost
];
SimpleFeedback.PutFL[$RemoteViewersTerminal, oneLiner, $FYI, "At %g, listening as Viewers Terminal on TCP port %g.", LIST[[time[BasicTime.Now[]]], [rope[arpaViewersTerminalSocket]]] ];
RETURN};
arpaListener: Nws.Listener ¬ NIL;
arpaViewersTerminalSocket: ROPE ~ "58811";
Filter:
ENTRY
PROC [remote: Host]
RETURNS [reject:
ROPE] ~ {
ENABLE UNWIND => NULL;
IF TMS.IsHost[remote] THEN RETURN [NIL];
RETURN ["I'm not a terminal for you"]};
NwsWorkForHost:
PROC [listener: Nws.Listener, in, out:
IO.
STREAM] ~ {
pf, tc: ATOM;
remote, invertErr, reject, sessPort, sessionDescr: ROPE ¬ NIL;
rna: NA.Address ¬ NA.nullAddress;
[protocolFamily: pf, remote: remote, transportClass: tc] ¬ Nws.GetStreamInfo[out];
rna ¬ NA.FromNnAddress[remote, pf !NA.Error => {invertErr ¬ NA.FormatError[codes, msg]; CONTINUE}];
IF invertErr=
NIL
THEN {
sessPort ¬ NA.ExtractSocket[rna];
rna ¬ NA.SetSocket[rna, "58812"];
sessionDescr ¬ IO.PutFR["%g (session %g)", [rope[NA.FormatAddress[rna, TRUE]]], [rope[sessPort]] ];
reject ¬ Filter[rna];
IF reject=
NIL
THEN {
IF debug THEN SimpleFeedback.PutFL[$RemoteViewersTerminal, oneLiner, $Debug, "At %g, starting RemoteViewersTerminal service for %g.", LIST[[time[BasicTime.Now[]]], [rope[sessionDescr]]] ];
Work[in, out, rna, sessionDescr, NwsPush !
UNWIND =>
IF debug THEN SimpleFeedback.PutFL[$RemoteViewersTerminal, oneLiner, $Debug, "At %g, aborting RemoteViewersTerminal service for %g.", LIST[[time[BasicTime.Now[]]], [rope[sessionDescr]]] ] ];
IF debug THEN SimpleFeedback.PutFL[$RemoteViewersTerminal, oneLiner, $Debug, "At %g, ending RemoteViewersTerminal service for %g.", LIST[[time[BasicTime.Now[]]], [rope[sessionDescr]]] ]}
ELSE SimpleFeedback.PutFL[$RemoteViewersTerminal, oneLiner, $Warning, "Refused RemoteViewersTerminal service to %g because %g", LIST[[rope[sessionDescr]], [rope[reject]]] ];
}
ELSE SimpleFeedback.PutFL[$RemoteViewersTerminal, oneLiner, $Warning, "Refused RemoteViewersTerminal service to %g %g of error (%g) inverting that NetworkName.address", LIST[[atom[pf]], [rope[remote]], [rope[invertErr]]] ];
in.Close[!IO.Error => CONTINUE];
out.Close[!IO.Error => CONTINUE];
};
Work:
PROC [in, out:
IO.
STREAM, host: Host, sessionDescr:
ROPE,
Push: PushProc] = {
rejection: ROPE;
version: HAT.ProtocolVersion;
server: ViewersServer;
TRUSTED {[rejection, version, server] ¬ Good[in, out, host]};
IF rejection#
NIL
THEN SimpleFeedback.PutFL[$RemoteViewersTerminal, oneLiner, $Warning,
"At %g, not RemoteViewersTerminal serving %g 'cause %g.",
LIST[[rope[Now[]]], [rope[sessionDescr]], [rope[rejection]]] ]
ELSE server.Work[server, in, out, host, sessionDescr, version, Push];
RETURN};
Good:
PROC [in, out:
IO.
STREAM, host: Host]
RETURNS [rejection:
ROPE, version:
BYTE ¬ 0, server: ViewersServer ¬
NIL] ~ {
ENABLE {
IO.Error => {rejection ¬ "IO.Error or stream close during initial negotiation"; CONTINUE};
IO.EndOfStream => {rejection ¬ "IO.EndOfStream during initial negotiation"; CONTINUE};
};
hisPassword: CHAR;
hisVersion, hisOldestCompatibleVersion: BYTE;
out.PutChar[CHAR.LAST];
out.PutChar[VAL[myVersionRange.max]];
out.PutChar[VAL[myVersionRange.min]];
out.Flush[];
hisPassword ¬ in.GetChar[];
IF hisPassword#CHAR.LAST THEN RETURN ["host didn't properly open initial negotiations"];
hisVersion ¬ in.GetChar[].ORD;
hisOldestCompatibleVersion ¬ in.GetChar[].ORD;
version ¬ MIN[hisVersion, myVersionRange.max];
IF version <
MAX[myVersionRange.min, hisOldestCompatibleVersion]
THEN
RETURN [
IO.PutFLR[
"[%g..%g] <> [%g..%g] (host's version range vs. this terminal's)",
LIST[[cardinal[hisOldestCompatibleVersion]], [cardinal[hisVersion]],
[cardinal[myVersionRange.min]], [cardinal[myVersionRange.max]]]] ];
server ¬ NARROW[addrToServer.Fetch[NEW [NA.Address ¬ host]].val];
IF server=NIL THEN rejection ¬ "not told to";
RETURN};
NwsPush:
PROC [pushStream:
IO.
STREAM] = {
Nws.SendSoon[pushStream, 0];
RETURN};
Now:
PROC
RETURNS [
ROPE] ~ {
up: BasicTime.Unpacked ~ BasicTime.Unpack[BasicTime.Now[]];
RETURN [
IO.PutFLR["%g/%g %g:%02g:%02g",
LIST[[cardinal[up.month.ORD+1]],
[cardinal[up.day]],
[cardinal[up.hour]],
[cardinal[up.minute]],
[cardinal[up.second]]
]] ]};
StopTCP:
PROC [cmd: Commander.Handle]
RETURNS [result:
REF
ANY ¬
NIL, msg:
ROPE ¬
NIL] ~ {
old: Nws.Listener ~ arpaListener;
IF old#NIL THEN {arpaListener ¬ NIL; Nws.DestroyListener[old]; Process.PauseMsec[2000]};
RETURN};
RestartTCP:
PROC [cmd: Commander.Handle]
RETURNS [result:
REF
ANY ¬
NIL, msg:
ROPE ¬
NIL] ~ {
[] ¬ StopTCP[NIL];
TCPStart[! Nws.Error => {
cmd.err.PutF1["%g trying to create Terminal Viewers TCP listener", [rope[NA.FormatError[codes, msg]]]];
CONTINUE}];
RETURN};
TerminalByCmd:
PROC [cmd: Commander.Handle]
RETURNS [result:
REF
ANY ¬
NIL, msg:
ROPE ¬
NIL] ~ {
argv: CommanderOps.ArgumentVector ~ CommanderOps.Parse[cmd];
IF argv.argc<1 THEN ERROR;
IF argv.argc#2 OR argv[1].Equal["?"] THEN RETURN [$Null, Rope.Cat["Usage: ", argv[0], " [?|style] --- list available styles, or open a Remote Cedar Terminal in the given style, which should be one of (", styleList, ")"]];
IF NOT WakeStyle[argv[1], cmd.err] THEN RETURN [$Failure];
RETURN};
Commander.Register["RestartTerminalViewersTcp", RestartTCP, "restart the Terminal Viewers TCP listener"];
Commander.Register["StopTerminalViewersTcp", StopTCP, "stop the Terminal Viewers TCP listener"];
Commander.Register["TerminalBy", TerminalByCmd, "[?|<style>] --- list available styles, or open a Remote Cedar Terminal in the given style"];
END.