NetLSCommand: Commander.CommandProc = {
arg: ROPE = CommanderOps.NextArgument[cmd];
P: EnumerateCallbackProc = {
EnumerateCallbackProc: TYPE ~ PROC [protocolFamily: ATOM, transportClass: ATOM] RETURNS [continue: BOOL ← TRUE];
cmd.out.PutF["%g %g\n", [atom[protocolFamily]], [atom[transportClass]]];
};
Enumerate[NIL, NIL, P];
};
listeners: LIST OF ListenerReg ¬ NIL;
ListenerReg:
TYPE ~
RECORD [
l: NetworkStream.Listener,
protocolFamily, transportClass: ATOM ← NIL,
local, localPort: ROPE ← NIL,
sr: LocalRegistryAgent.ServiceRegistration ← NIL];
NetUnListenCommand: Commander.CommandProc = {
UNTIL listeners =
NIL
DO
LocalRegistryAgent.StopService[listeners.first.sr];
DestroyListener[listeners.first.l];
listeners ¬ listeners.rest;
ENDLOOP;
};
NetListenCommand: Commander.CommandProc = {
ENABLE {
NetworkName.Error => CommanderOps.Failed[msg];
NetworkStream.Error => CommanderOps.Failed[msg];
IO.Error => CommanderOps.Failed[Rope.Concat["i/o error ... ", GetIOErrorDetails[stream].msg]];
};
portHint, lock: ROPE;
transportClass: ATOM;
listener: NetworkStream.Listener;
lr: ListenerReg;
props: LocalRegistryAgent.PropList ← NIL;
[portHint, lock, transportClass] ¬ GetNetComArgs[cmd];
listener ¬ NetworkStream.CreateListener[
protocolFamily: $ARPA,
transportClass: transportClass,
local: NetworkName.AddressFromName[family: $ARPA, name: NIL, portHint: portHint, components: port].addr,
listenerWorkerProc: CommanderWork
];
lr ¬ [l: listener];
IF lock # NIL THEN passkey ¬ lock;
[lr.protocolFamily, lr.local, lr.transportClass,,] ← GetListenerInfo[listener];
lr.localPort ← NetworkName.NameFromAddress[$ARPA, lr.local, port].name;
props ← Atom.PutPropOnList[props, $BootTime, Convert.RopeFromTimeRFC822[BootTime.Get[]]];
props ← Atom.PutPropOnList[props, $StartTime, Convert.RopeFromTimeRFC822[BasicTime.Now[]]];
props ← Atom.PutPropOnList[props, $port, lr.localPort];
props ¬ Atom.PutPropOnList[props, $UserName, SystemNames.UserName[]];
lr.sr ← LocalRegistryAgent.MaintainService[ "Cedar/NetCommander(29-Jun-92)", props, 1200*1000, 400*1000];
listeners ¬ CONS[lr, listeners];
IO.PutF[cmd.out, "Connection command: NetCommander %g %g\n", [rope[lr.local]], [atom[lr.transportClass]]];
RETURN};
NetLockCommand: Commander.CommandProc = {
passkey ¬ CommanderOps.NextArgument[cmd];
};
NetListenersCommand: Commander.CommandProc = {
FOR tail:
LIST
OF ListenerReg ¬ listeners, tail.rest
UNTIL tail =
NIL
DO
lr: ListenerReg ~ tail.first;
IO.PutFL[cmd.out, "%g %g (%g) %g\n", LIST[[rope[lr.local]], [atom[lr.transportClass]], [atom[lr.protocolFamily]], [refAny[lr.l]]] ];
ENDLOOP;
};
GetNetComArgs:
PROC[cmd: Commander.Handle]
RETURNS[portHint, passkey:
ROPE, transportClass:
ATOM] ~ {
DO
arg: ROPE ¬ CommanderOps.NextArgument[cmd];
IF arg = NIL THEN EXIT;
SELECT
TRUE
FROM
Rope.Equal[arg, "-lock"] => passkey ¬ CommanderOps.NextArgument[cmd];
Rope.Fetch[arg, 0] = '- => CommanderOps.Failed[IO.PutFR1["bad argument %g\n", [rope[arg]]] ];
portHint = NIL => portHint ¬ arg;
transportClass = NIL => transportClass ¬ Atom.MakeAtom[arg];
ENDCASE => CommanderOps.Failed[IO.PutFR1["Too many args %g\n", [rope[arg]]] ];
ENDLOOP;
IF transportClass = NIL THEN transportClass ¬ $TCP;
};
defaultPrompt: ROPE ¬ "RCedar %l%% %l";
NetworkPrompt:
PROC [cmd: Commander.Handle] ~ {
prompt:
ROPE ~
WITH CommanderOps.GetProp[cmd, $Prompt]
SELECT
FROM
rope: ROPE => rope,
ENDCASE => defaultPrompt;
IO.PutF[cmd.err, prompt, [rope["b"]], [rope["B"]]];
IO.Flush[cmd.err];
};
ExitCommander: ERROR = CODE;
CommanderWork:
PROC [listener: NetworkStream.Listener, in, out:
IO.
STREAM] ~ {
ENABLE { IO.Error => IF stream=in OR stream=out THEN GOTO closeit };
filteredin: IO.STREAM ~ CRFilterStream[in];
Inner:
PROC = {
commander: Commander.Handle = CommanderOps.CreateFromStreams[in: filteredin, out: FlushOutStream[out]];
CommanderBackdoor.GetCommandToolData[commander].Prompt ¬ NetworkPrompt;
CommanderOps.PutProp[commander, $Prompt, Rope.Concat[GetListenerInfo[listener].local, " %l%% %l"]];
[] ¬ CommanderOps.ReadEvalPrintLoop[commander];
};
IF Authentic[filteredin, out] THEN ProcessProps.AddPropList[LIST[NEW[Atom.DottedPairNode ¬ [$listener, listener]]], Inner];
GOTO closeit;
EXITS
closeit => {
IO.Close[in ! IO.Error => CONTINUE];
IO.Close[out ! IO.Error => CONTINUE];
};
};
CRFilterData: TYPE ~ REF CRFilterDataRep;
CRFilterDataRep:
TYPE ~
RECORD [
source: IO.STREAM,
state: {normal, postLF, postCR} ¬ normal,
peeked: BOOL ¬ FALSE,
peekChar: CHAR ¬ 0C,
eofOnControlD: BOOL ¬ TRUE
];
CRFilterGetChar:
PROC [self:
STREAM]
RETURNS [
CHAR] ~ {
data: CRFilterData ~ NARROW[self.streamData];
IF data.peeked THEN {data.peeked ¬ FALSE; RETURN [data.peekChar]};
DO
ch: CHAR ~ IO.GetChar[data.source];
SELECT ch
FROM
Ascii.
CR =>
IF data.state = postCR
THEN {data.state ¬ normal}
ELSE {data.state ¬ postLF; RETURN ['\n]};
Ascii.
LF =>
IF data.state = postLF
THEN {data.state ¬ normal}
ELSE {data.state ¬ postCR; RETURN ['\n]};
Ascii.ControlD => {
data.state ¬ normal;
IF data.eofOnControlD THEN ERROR IO.EndOfStream[self];
RETURN [ch]
};
ENDCASE => { data.state ¬ normal; RETURN [ch] };
ENDLOOP;
};
CRFilterCharsAvail:
PROC [self:
STREAM, wait:
BOOL]
RETURNS [
INT] ~ {
data: CRFilterData ~ NARROW[self.streamData];
n: INT ¬ IO.CharsAvail[data.source];
IF n # INT.LAST THEN n ¬ n + ORD[data.peeked];
RETURN [n]
};
CRFilterBackup:
PROC [self:
STREAM, char:
CHAR] ~ {
data: CRFilterData ~ NARROW[self.streamData];
IF data.peeked THEN {IO.Backup[data.source, data.peekChar]};
data.peekChar ¬ char;
data.peeked ¬ TRUE;
};
CRFilterEndOf:
PROC [self:
STREAM]
RETURNS [
BOOL] ~ {
data: CRFilterData ~ NARROW[self.streamData];
IF data.peeked THEN RETURN[data.peekChar # Ascii.ControlD];
IF IO.EndOf[data.source] THEN RETURN[TRUE];
data.eofOnControlD ¬ FALSE;
data.peekChar ¬ CRFilterGetChar[self];
data.peeked ¬ TRUE;
data.eofOnControlD ¬ TRUE;
RETURN [data.peekChar # Ascii.ControlD];
};
CRFilterReset:
PROC [self:
STREAM] ~ {
data: CRFilterData ~ NARROW[self.streamData];
data.peeked ¬ FALSE;
IO.Reset[data.source];
};
CRFilterClose:
PROC [self:
STREAM, abort:
BOOL] ~ {
data: CRFilterData ~ NARROW[self.streamData];
data.peeked ¬ FALSE;
IO.Close[data.source, abort];
};
CRFilterStream:
PROC [source:
IO.
STREAM]
RETURNS [
IO.
STREAM] ~ {
RETURN [
IO.CreateStream[
streamProcs: IO.CreateStreamProcs[variety: input, class: $CRFilter, getChar: CRFilterGetChar, endOf: CRFilterEndOf, charsAvail: CRFilterCharsAvail, backup: CRFilterBackup, reset: CRFilterReset, close: CRFilterClose],
streamData: NEW[CRFilterDataRep ¬ [source: source]]
]];
};
FlushOutData: TYPE ~ REF FlushOutDataRep;
FlushOutDataRep:
TYPE ~
RECORD [
dest: IO.STREAM,
specialSeen: BOOL ¬ FALSE
];
PromptChar:
PROC [ch:
CHAR]
RETURNS [
BOOL] = {
RETURN [ch IN (' ..'A) AND ch NOT IN ['0..'9] AND ch # ', AND ch # ';]
};
FlushOutUnsafePutBlock:
PROC [self:
IO.
STREAM, block:
IO.UnsafeBlock] ~
TRUSTED {
This procedure attempts to do SendSoon at newlines and at places that may require user action (prompts), while not generating too many extraneous packets.
data: FlushOutData ~ NARROW[self.streamData];
base: POINTER TO Basics.RawBytes ~ block.base;
IO.UnsafePutBlock[data.dest, block];
IF block.count # 0
THEN {
ss: BOOL = IF block.count = 1 THEN data.specialSeen ELSE PromptChar[VAL[base[block.startIndex+block.count-2]]];
ch: CHAR = VAL[base[block.startIndex+block.count-1]];
data.specialSeen ¬ PromptChar[ch];
IF ss AND ch = ' THEN {NetworkStream.SendSoon[data.dest, 250]; RETURN};
};
FOR i:
CARD
DECREASING
IN [block.startIndex..block.startIndex+block.count)
DO
SELECT base[i]
FROM
ORD[Ascii.
LF],
ORD[Ascii.
CR],
ORD['?],
ORD[':] => {
NetworkStream.SendSoon[data.dest, 250];
EXIT;
};
ENDCASE => NULL;
ENDLOOP;
};
FlushOutFlush:
PROC [self:
IO.
STREAM] ~ {
data: FlushOutData ~ NARROW[self.streamData];
IO.Flush[data.dest];
};
FlushOutClose:
PROC [self:
IO.
STREAM, abort:
BOOL] ~ {
data: FlushOutData ~ NARROW[self.streamData];
IO.Close[data.dest, abort];
};
FlushOutEraseChar:
PROC [self:
IO.
STREAM, char:
CHAR] ~ {
data: FlushOutData ~ NARROW[self.streamData];
IO.EraseChar[data.dest, char];
data.specialSeen ¬ TRUE; -- Conservative hint.
};
FlushOutStream:
PROC [dest:
IO.
STREAM]
RETURNS [
IO.
STREAM] ~ {
RETURN [
IO.CreateStream[
streamProcs: IO.CreateStreamProcs[variety: output, class: $FlushOut, unsafePutBlock: FlushOutUnsafePutBlock, flush: FlushOutFlush, close: FlushOutClose, eraseChar: FlushOutEraseChar],
streamData: NEW[FlushOutDataRep ¬ [dest: dest]]
]];
};
passkey: Rope.ROPE ¬ NIL;
Authentic:
PROC [in, out:
STREAM]
RETURNS [
BOOL] ~ {
name, password: Rope.ROPE ¬ NIL;
[name, password] ← UserCredentials.Get[];
name ¬ WITH CommanderOps.GetProp[NIL, $USER] SELECT FROM rope: ROPE => rope ENDCASE => NIL;
IO.PutRope[out, "User name is "];
IO.PutRope[out, name];
IO.PutRope[out, "\n"];
IF password = NIL THEN password ¬ passkey;
IF password = NIL THEN RETURN [TRUE];
IO.PutRope[out, "Password:"];
IO.Flush[out];
RETURN [Rope.Equal[password, IO.GetLineRope[in]]];
};
Terminator: TYPE = REF TerminatorRep;
TerminatorRep:
TYPE =
RECORD [
doneFlag: BOOL ¬ FALSE,
doneMsg: ROPE ¬ NIL,
done: CONDITION
];
Done:
ENTRY
PROC [terminator: Terminator, msg:
ROPE] = {
IF terminator #
NIL
THEN {
terminator.doneFlag ¬ TRUE;
terminator.doneMsg ¬ msg;
BROADCAST terminator.done;
};
};
Wait:
ENTRY
PROC [terminator: Terminator]
RETURNS [
ROPE] = {
ENABLE UNWIND => NULL;
UNTIL terminator.doneFlag DO WAIT terminator.done ENDLOOP;
RETURN [terminator.doneMsg]
};
CopyStream:
PROC [from, to:
IO.
STREAM, terminator: Terminator] = {
ENABLE {
IO.Error => { Done[terminator, GetIOErrorDetails[stream].msg]; GOTO end };
IO.EndOfStream => { Done[terminator, eofRope]; GOTO end };
};
buf: REF TEXT ~ NEW[TEXT[256]];
UNTIL terminator.doneFlag
DO {
ENABLE IO.Rubout => { IO.PutChar[to, '\n]; IO.Reset[from]; CONTINUE };
n: INT ~ IO.CharsAvail[from];
IF n > 0
THEN {
try: NAT ~ MIN[n, buf.maxLength];
bytesRead: NAT ~ from.GetBlock[block: buf, startIndex: 0, count: try];
IF bytesRead > 0 THEN to.PutBlock[buf];
IF bytesRead = try THEN LOOP;
};
IO.Flush[to];
IO.PutChar[to, IO.GetChar[from]];
} ENDLOOP;
IO.Flush[to];
EXITS end => {}
};
eofRope: ROPE = "EOF";
abortRope: ROPE = "ABORTED";
NetCommanderCommand: Commander.CommandProc = {
ENABLE {
NetworkName.Error => CommanderOps.Failed[msg];
NetworkStream.Error => CommanderOps.Failed[msg];
IO.Error => { CommanderOps.Failed[GetIOErrorDetails[stream].msg] };
};
remote, lock: ROPE ;
transportClass: ATOM;
terminator: Terminator = NEW[TerminatorRep ¬ []];
in, out: IO.STREAM;
CloseUp:
PROC = {
IF in # NIL THEN IO.Close[in ! IO.Error => CONTINUE];
in ¬ NIL;
IF out # NIL THEN IO.Close[out ! IO.Error => CONTINUE];
out ¬ NIL;
};
[remote, lock, transportClass] ¬ GetNetComArgs[cmd];
TRUSTED { Process.EnableAborts[@terminator.done] };
remote ¬ NetworkName.AddressFromName[family: $ARPA, name: remote].addr;
[in, out] ¬ CreateStreams[protocolFamily: $ARPA, remote: remote, transportClass: transportClass, timeout: 15000];
IF lock = NIL THEN lock ¬ passkey;
IF lock #
NIL
THEN {
IO.PutRope[out, lock];
IO.PutRope[out, "\n"];
};
WITH CommanderOps.GetProp[cmd, $WorkingDirectory]
SELECT
FROM
rope:
ROPE => {
IO.PutF1[out, "CD %g\n", [rope[rope]] !
IO.Error => {
msg ¬ GetIOErrorDetails[stream].msg;
CloseUp[];
CommanderOps.Failed[msg];
}
];
};
ENDCASE;
BEGIN
ENABLE
UNWIND => CloseUp[];
p1: PROCESS = FORK CopyStream[from: in, to: cmd.out, terminator: terminator];
p2: PROCESS = FORK CopyStream[from: cmd.in, to: out, terminator: terminator];
msg ¬ Wait[terminator ! ABORTED => { msg ¬ abortRope; CONTINUE }];
Process.Abort[p1];
Process.Abort[p2];
CloseUp[];
TRUSTED { [] ¬ JOIN p1; [] ¬ JOIN p2 };
result ¬ IF msg = eofRope THEN NIL ELSE $Failure;
END;
IF msg = abortRope THEN ERROR ABORTED;
};
Stop:
PROC [
REF
ANY] ~ {
[] ← NetUnListenCommand[NIL];
RETURN};
Termination.CallBeforeQuitWorld[Stop];
Commander.Register["NetTransportLS", NetLSCommand, "list registered (protocolFamily, transportClass) pairs"];
Commander.Register["NetCommanderOn", NetListenCommand, "Make a Commander listener.\nargs: port transportClass [-lock password]"];
Commander.Register["NetCommanderLock", NetLockCommand, "Set a password for incoming connections.\nargs: password"];
Commander.Register["NetCommanderOff", NetUnListenCommand, "Destroy current Commander listeners"];
Commander.Register["NetCommanderListeners", NetListenersCommand, "List current Commander listeners"];
Commander.Register["NetCommander", NetCommanderCommand, "Talk to a listener.\nargs: port transportClass [-lock password]"];
-- CreateStreams: PROC [protocolFamily: ATOM, remote: ROPE, transportClass: ATOM ¬ NIL, timeout: Milliseconds ¬ waitForever, transportParameters: REF ¬ NIL] RETURNS [in: STREAM, out: STREAM];
-- If transportClass = NIL, use any registered transport in given protocol family.
-- GetStreamInfo: PROC [stream: STREAM] RETURNS [protocolFamily: ATOM, local: ROPE, remote: ROPE, transportClass: ATOM];
-- GetTimeout: PROC [stream: STREAM] RETURNS [timeout: Milliseconds, signalTimeout: BOOL];
-- SetTimeout: PROC [stream: STREAM, timeout: Milliseconds ¬ waitForever, signalTimeout: BOOL ¬ FALSE];
-- A transport provider is free not to implement listeners.
-- ListenerWorkerProc: TYPE ~ PROC [listener: Listener, in: STREAM, out: STREAM];
-- Create a listener at the specified local address (which may include a port).
-- If transportClass = NIL, use any registered transport in given protocol family.
-- The ListenerWorkerProc is called with a newly-created stream pair for each connection request. The stream timeouts are initially infinite, but can be changed with SetTimeout.
-- GetListenerInfo: PROC [listener: Listener] RETURNS [protocolFamily: ATOM, local: ROPE, transportClass: ATOM, proc: ListenerWorkerProc, clientData: REF];
--EnumerateCallbackProc: TYPE ~ PROC [protocolFamily: ATOM, transportClass: ATOM] RETURNS [continue: BOOL ¬ TRUE];
-- Enumerate: PROC [families: ATOM, classes: ATOM, proc: EnumerateCallbackProc];