ChatCommandsImpl.mesa
Copyright (C) 1984, 1986, Xerox Corporation. All rights reserved.
Michael Plass, October 31, 1984 10:18:59 am PST
Tim Diebert: February 17, 1986 1:53:38 pm PST
Dave Rumph, August 8, 1986 12:55:06 pm PDT
*** Remember to update the date in helloMsg when you make changes.
DIRECTORY
BasicTime USING [GMT, Now, Period],
Commander,
CommandTool,
Convert,
DefaultRemoteNames USING [Get],
FS USING [Error, StreamOpen],
GVNames,
IO,
List USING [DottedPairNode, PutAssoc],
ProcessProps USING [AddPropList],
Pup,
PupName,
PupStream,
PupWKS,
ReadEvalPrint USING [Handle, RObject],
Rope,
RuntimeError USING [UNCAUGHT],
UserProfile USING [Token];
ChatCommandsImpl: CEDAR PROGRAM
IMPORTS BasicTime, Commander, CommandTool, Convert, DefaultRemoteNames, FS, GVNames, IO, List, ProcessProps, PupName, PupStream, Rope, RuntimeError, UserProfile
EXPORTS ChatCmds
= BEGIN
ROPE: TYPE ~ Rope.ROPE;
STREAM: TYPE ~ IO.STREAM;
helloMsg: ROPE ← "Cedar CommandTool Server of October 23, 1986 6:22:22 pm PDT";
defaultPrompt: ROPE ← "%l%% %l";
Upper: PROC [ch: CHAR] RETURNS [CHAR] = INLINE {
RETURN [IF ch IN ['a..'z] THEN ch - ('a - 'A) ELSE ch]
};
Lower: Rope.TranslatorType = {
[old: CHAR] RETURNS [new: CHAR]
RETURN [IF old IN ['A..'Z] THEN old+('a-'A) ELSE old];
};
loginMessage: ROPE ← NIL;
ConsRope: PROC [r: ROPE, list: LIST OF REF ANY ← NIL] RETURNS [LIST OF REF ANY] = {
RETURN [CONS[r, list]];
};
TalkWithUser: PUBLIC PROC [stream: IO.STREAM] = {
outputStream: STREAM ~ CreateCleanTelnetStream[stream];
user: ROPE ← NIL;
defaultRegistry: ROPE ~ DefaultRemoteNames.Get[].registry;
loggedIn: BOOLEAN ← FALSE;
cmd: Commander.Handle ~ NEW[Commander.CommandObject ← [
commandLine: NIL,
out: outputStream,
err: outputStream,
propertyList: List.PutAssoc[key: $SearchRules, val: ConsRope["///", ConsRope["///Commands/"]], aList: NIL]
]];
BEGIN
ENABLE {PupStream.StreamClosing => GOTO Closing;
PupStream.Timeout => GOTO TimeOut};
string: REF TEXT ← NEW [TEXT [180]];
password: ROPE;
account: ROPE;
quitting: BOOLEAN ← FALSE;
accessAllowed: BOOLEAN ← TRUE;
echo: BOOLEAN ← TRUE;
flushed: BOOLEAN ← FALSE;
lastRequest: INT ← -1;
PutChar: PROC [char: CHAR] = { IO.PutChar[outputStream, char]; flushed ← FALSE; };
PutString: PROC [string: ROPE] = { IO.PutRope[outputStream, string]; flushed ← FALSE; };
PutXXX: PROC = { PutString[" XXX\n\l"]};
sep: CHAR ← ' ;
DelHit: ERROR = CODE;
SendNow: PROC = {IO.Flush[stream]; flushed ← TRUE};
GetChar: PROC RETURNS [CHAR] = {
c: CHAR;
ignore: INT ← 0;
IF NOT flushed THEN SendNow[];
WHILE ignore >= 0 DO
mark: NAT ← 0;
timingMark: NAT = 5;
timingMarkReply: NAT = 6;
dataMark: NAT = 1;
charsAvail: INT ← 0;
bytes: PACKED ARRAY [0..4] OF CHAR;
TRUSTED {charsAvail ← IO.UnsafeGetBlock[stream, [LOOPHOLE[LONG[@bytes]], 0, 1]]};
IF charsAvail # 0 THEN c ← bytes[0]
ELSE {
gotMark: BOOL ← FALSE;
IF stream.GetInfo.class = $Pup THEN {
gotMark ← TRUE;
mark ← PupStream.ConsumeMark[stream ! RuntimeError.UNCAUGHT => {gotMark ← FALSE; CONTINUE}];
};
};
SELECT mark FROM
0 => NULL;
dataMark => {ignore ← 1};
timingMark => {ignore ← 1};
ENDCASE => ignore ← 2;
ignore ← ignore - 1;
ENDLOOP;
IF c = '\177 THEN {PutXXX[]; ERROR DelHit};
RETURN [c]
};
GetStringToSpace: PROC [stopper1: CHAR ← ' , stopper2: CHAR ← '\t] RETURNS [r: ROPE] = {
c: CHAR ← GetChar[];
dashCount: NAT ← 0;
inComment: BOOLEAN ← FALSE;
commentHit: BOOLEAN ← FALSE;
string.length ← 0;
UNTIL string.length = string.maxLength
OR (NOT inComment AND (c=stopper1 OR c=stopper2))
OR c='\n DO
IF c= 'H - 100B OR c= 'A - 100B THEN {
IF commentHit THEN {PutXXX[]; ERROR DelHit};
IF string.length > 0 THEN {
IF echo THEN PutChar[c];
string.length ← string.length - 1;
};
}
ELSE IF c= 'W - 100B THEN {
IF commentHit THEN {PutXXX[]; ERROR DelHit};
WHILE string.length > 0 DO
IF echo THEN PutChar['H - 100B];
string.length ← string.length - 1;
ENDLOOP;
}
ELSE {
IF echo THEN PutChar[c];
IF c = '- THEN {
commentHit ← TRUE;
dashCount ← dashCount + 1;
IF dashCount = 2 THEN {
inComment ← NOT inComment;
dashCount ← 0;
};
}
ELSE {
WHILE dashCount > 0 DO
IF NOT inComment THEN {
string[string.length] ← '-;
string.length ← string.length + 1;
};
dashCount ← dashCount - 1;
ENDLOOP;
IF NOT inComment THEN {
string[string.length] ← c;
string.length ← string.length + 1;
};
};
};
c ← GetChar[];
ENDLOOP;
IF string.length <= string.maxLength THEN sep ← c ELSE sep ← ' ;
IF string.length = 0 AND sep # '\n THEN {
PutChar[sep];
IO.Flush[stream];
RETURN[GetStringToSpace[stopper1, stopper2]];
};
IO.Flush[stream];
RETURN [Rope.FromRefText[string]];
};
GetStringToCR: PROC [] RETURNS [ROPE] = {
RETURN[GetStringToSpace['\n, '\n]];
};
GetCommand: PROC RETURNS [command: ROPE] = {
command ← NIL;
DO
PutString["%>"];
command ← GetStringToCR[];
IF command.IsEmpty[] THEN {PutChar['\n]; PutChar['\l]; SendNow[]}
ELSE EXIT;
ENDLOOP;
SendNow[];
};
DoCommand: PROC = {
Backspace: PROC RETURNS [CHAR] ~ {
RETURN ['A - 100B]
};
commandLine: ROPE ← GetCommand[];
PutString[Rope.FromProc[len: commandLine.Length[], p: Backspace]];
IgnoreNextNChars[outputStream, commandLine.Length[]];
DoCommandRope[commandLine, cmd];
};
IO.PutF1[stream, "\n\l%g\n\l", IO.rope[helloMsg]];
UNTIL loggedIn OR quitting DO
command: ROPE ~ GetStringToSpace[];
todo: ATOM;
todo ← Convert.AtomFromRope[Rope.Translate[base: command, translator: Lower] ! Convert.Error => {todo ← NIL; CONTINUE}];
SELECT todo FROM
$login => {
registryMissing: BOOLEAN ← TRUE;
PutString[" --User-- "];
user ← GetStringToSpace[];
registryMissing ← Rope.Find[user, "."] < 0;
IF registryMissing THEN {
user ← Rope.Concat[user, defaultRegistry];
PutString[defaultRegistry];
};
PutString[" --Password-- "];
echo ← FALSE;
password ← GetStringToSpace[ ! UNWIND => echo ← TRUE];
echo ← TRUE;
IF sep # '\n THEN {
PutString[" --Account-- "];
account ← GetStringToSpace[];
};
PutString[" -- Authenticating ... "];
SendNow[];
SELECT GVNames.Authenticate[user, password] FROM
individual => {PutString["OK"]; loggedIn ← TRUE};
allDown => {PutString["all GV servers down; I'll have to trust you."]; loggedIn ← TRUE};
badPwd => {PutString["bad password"]; loggedIn ← FALSE};
ENDCASE => {PutString["bad name"]; loggedIn ← FALSE};
PutChar['\n];
PutChar['\l];
IO.Flush[stream];
IF loggedIn THEN { --Check access to this machine
msg: ROPE;
[loggedIn, msg] ← CanAccess[user];
PutString[msg];
};
IF loggedIn THEN DoCommandRope[Rope.Cat["CD ///Users/", user, "/"], cmd];
IF loginMessage.Length > 0 THEN {
IO.PutF1[stream, "%g\n\l", IO.rope[loginMessage]];
};
};
$quit => {loggedIn ← FALSE; PutChar['\n]; PutChar['\l]; SendNow[]; quitting ← TRUE};
ENDCASE => PutString["Please log in.\n\l"];
ENDLOOP;
WHILE loggedIn DO DoCommand[! DelHit => CONTINUE] ENDLOOP;
EXITS Closing => {
};
TimeOut => {
};
END;
};
cleanTelnetStreamProcs: REF IO.StreamProcs ~ IO.CreateStreamProcs[
variety: inputOutput,
class: $CleanTelnetInput,
putChar: CTSPutChar
];
CTSData: TYPE ~ RECORD [ignore, unflushed: INT ← 0, lastFlushed: BasicTime.GMT ← BasicTime.Now[]];
CreateCleanTelnetStream: PROC [telnet: STREAM] RETURNS [cts: STREAM] ~ {
cts ← IO.CreateStream[streamProcs: cleanTelnetStreamProcs, streamData: NEW[CTSData ← [ignore: 0]], backingStream: telnet];
};
IgnoreNextNChars: PROC [self: STREAM, toIgnore: INT] ~ {
d: REF CTSData ~ NARROW[self.streamData];
d.ignore ← d.ignore+toIgnore;
};
maxUnflushed: INT ← 20;
CTSPutChar: PROC [self: STREAM, char: CHAR] ~ {
WITH self.streamData SELECT FROM
d: REF CTSData => {
IF d.ignore>0 THEN d.ignore ← d.ignore-1 ELSE {
IO.PutChar[self: self.backingStream, char: char];
IF char='\n THEN IO.PutChar[self: self.backingStream, char: '\l];
d.unflushed ← d.unflushed+1;
};
IF BasicTime.Period[from: d.lastFlushed, to: BasicTime.Now[]]>5 OR d.unflushed>maxUnflushed THEN { --This makes it so that the user gets more frequent updates
d.lastFlushed ← BasicTime.Now[];
d.unflushed ← 0;
IO.Flush[self: self.backingStream];
};
};
ENDCASE => ERROR;
};
CanAccess: PROC [name: ROPE] RETURNS [access: BOOL, msg: ROPE] ~ {
file: ROPE ~ UserProfile.Token[key: "ChatCommands.AccessFile", default: "///STPServer.CreateAccess"];
{
stream: STREAM ~ FS.StreamOpen[fileName: file ! FS.Error => GOTO NoFile];
couldntCommunicate: BOOL ← FALSE;
DO
group: ROPE ~ IO.GetTokenRope[stream: stream, breakProc: IO.IDProc ! IO.EndOfStream => EXIT].token;
IF Rope.Equal[s1: group, s2: name, case: FALSE] THEN RETURN [TRUE, "Access granted.\n"];
SELECT GVNames.IsMemberClosure[name: group, member: name] FROM
no, notGroup => {};
yes => RETURN [TRUE, Rope.Cat["You are permitted access as a member of ", group, "."]];
allDown => couldntCommunicate ← TRUE;
ENDCASE => ERROR;
ENDLOOP;
RETURN [FALSE, IF couldntCommunicate THEN "Because Grapevine is down, couldn't confirm that you are permitted access to this machine.\n" ELSE "You do not currently have access to this machine.\n"];
EXITS
NoFile => {RETURN [FALSE, Rope.Cat["Could not find file \"", file, "\" on server.\n"]]}
};
};
DoCommandRope: PROC [commandLine: ROPE ← NIL, parent: Commander.Handle] ~ {
Execute the given commandLine. (The command name must be the first token on the commandLine). The in, out, and err streams connected to the corresponding ropes. (Calls EachCommand) The property list and error streams come from parent.
out: ROPE;
outS: STREAM ← IO.ROS[];
rep: ReadEvalPrint.Handle;
oldREP: ReadEvalPrint.Handle ← NIL;
cmd: Commander.Handle ← NEW[Commander.CommandObject ← []];
rep ← NEW[ReadEvalPrint.RObject ← [menuHitQueue: NIL]];
IO.PutRope[self: parent.out, r: "\n"];
IgnoreNextNChars[parent.out, commandLine.Length[]];
cmd.out ← CommandTool.Insulate[parent.out];
cmd.in ← IO.RIS[rope: "This is junk."];
IF parent # NIL
THEN {
cmd.err ← parent.err;
cmd.propertyList ← parent.propertyList;
oldREP ← NARROW[CommandTool.GetProp[parent, $ReadEvalPrintHandle]];
rep.prompt ← NARROW[CommandTool.GetProp[parent, $Prompt]];
rep.out ← parent.out;
}
ELSE ERROR;
IF rep.prompt.IsEmpty[] THEN rep.prompt ← defaultPrompt;
rep.clientData ← cmd;
rep.viewer ← IF oldREP # NIL THEN oldREP.viewer ELSE NIL;
rep.out.PutRope[CommandTool.EachCommand[h: rep, command: commandLine]];
out ← IO.RopeFromROS[outS ! IO.Error => CONTINUE];
outS.Close[];
IO.PutRope[self: parent.out, r: out];
IO.Flush[self: parent.out];
};
NewConnection: SAFE PROCEDURE [stream: IO.STREAM, clientData: REF ANY, remote: Pup.Address] = TRUSTED {
Inner: PROC ~ TRUSTED { --This guarantees that we have a working directory prop attached to the process
TalkWithUser[stream ! PupStream.StreamClosing => CONTINUE];
};
PupStream.ListenerProc
otherGuy: Rope.ROPE ← PupName.AddressToRope[remote];
defaultDirectory: ROPE ~ "///Temp";
ProcessProps.AddPropList[propList: LIST[NEW[List.DottedPairNode ← [$WorkingDirectory, defaultDirectory]]], inner: Inner];
IO.Close[stream];
};
usageMsg: ROPE ~ "Usage: ChatCommands on|off.";
ChatCommands: Commander.CommandProc = TRUSTED BEGIN
turnOn, turnOff: BOOL ← FALSE;
tokens: LIST OF ROPE ← CommandTool.ParseToList[cmd: cmd].list;
FOR each: LIST OF ROPE ← tokens, each.rest UNTIL each=NIL DO
token: ATOM ~ Convert.AtomFromRope[r: Rope.Translate[base: each.first, translator: Lower] ! Convert.Error => LOOP];
SELECT token FROM
$on => {
IF turnOff THEN GOTO Fail;
turnOn ← TRUE;
};
$off => {
IF turnOn THEN GOTO Fail;
turnOff ← TRUE;
};
ENDCASE => GOTO Fail;
ENDLOOP;
SELECT TRUE FROM
turnOn AND pupListener#NIL => msg ← "Chat Commands already on.\n";
turnOn => {
pupListener ← PupStream.CreateListener[
local: PupWKS.telnet,
worker: NewConnection,
getTimeout: 300000, -- 5 minutes
putTimeout: 300000 -- 5 minutes
];
msg ← "Started Chat Commands.\n"
};
turnOff AND pupListener=NIL => msg ← "Chat Commands already off.\n";
turnOff => {
PupStream.DestroyListener[pupListener];
pupListener ← NIL;
msg ← "Stopped Chat Commands.\n"
};
ENDCASE => msg ← Rope.Cat["Chat Commands ", IF pupListener=NIL THEN "off" ELSE "on", ". (", usageMsg, ")"];
EXITS Fail => RETURN [result: $Failure, msg: usageMsg];
END;
pupListener: PupStream.Listener ← NIL;
Commander.Register["ChatCommands", ChatCommands, "Enables Peach server"];
END....