<> <> <> <> <> <<>> <<*** 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 <> = 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 = { <> <> <<};>> commandLine: ROPE _ GetCommand[]; <> <> 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] ~ { <> <> <> 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]]; < CONTINUE];>> <> <> 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]; }; <> 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....