-- ChatServer.mesa
-- Edited by Brotz, June 25, 1982 3:42 PM
-- Edited by Andrew Birrell 5 Jan. 1982 2:53 pm PST (Tuesday)
-- Edited by Mark Johnson 19-May-81 13:28:28
-- Derived from [Indigo]<Grapevine>MS>GlassImpl.mesa


DIRECTORY
Ascii,
-- drD: FROM "LaurelDriverDefs" USING [interruptWakeup],
dsD: FROM "DisplayDefs",
exD: FROM "ExceptionDefs",
inD: FROM "InteractorDefs",
Inline USING [BITAND, BITOR, COPY],
intCommon,
LaurelTTYDefs USING [buffer, CleanupTTYEditor, HandleObject, Handle, TTYInterface,
ZeroBuffer],
Process USING [DisableTimeout, SecondsToTicks, SetTimeout, Yield],
PupDefs USING [PupAddress],
PupStream USING [CreatePupByteStreamListener, DestroyPupListener, PupListener,
RejectThisRequest, StreamClosing, veryLongWait],
PupTypes USING [telnetSoc],
Stream,
String USING [AppendDecimal, AppendLongDecimal, EquivalentString, InvalidNumber,
StringToDecimal];

ChatServer: MONITOR
IMPORTS exD, inD, Inline, intC: intCommon, LaurelTTYDefs, Process, PupStream, Stream,
String=

BEGIN


listenerCond: CONDITION;
wantToDie: BOOLEAN ← FALSE;
TimeOut: SIGNAL = CODE;
SynchReply: SIGNAL = CODE;
ReaderDied: ERROR = CODE;


Listen: PUBLIC ENTRY PROCEDURE [work: PROC [LaurelTTYDefs.Handle]] =
BEGIN
inUse: BOOLEAN ← FALSE;

TelnetWork: PROCEDURE [str: Stream.Handle, from: PupDefs.PupAddress] =
BEGIN
-- Note that there is an over-all assumption that the client calls
-- the chat server stream from only one process. The monitor locks are
-- used only to synchronize between the "Reader" process and the client.
-- we maintain a circular buffer of incoming characters, primarily to look ahead for DEL
-- rPos = next index for reading from buffer --
-- wPos = next index for writing into buffer --
-- rPos = wPos iff buffer is empty --
-- (wPos + 1) MOD bLength = rPos iff buffer is full --
-- buffer data has "markBit" on iff datum is a "Mark" byte --
readerPSB: PROCESS;
readerWanted: BOOLEAN ← TRUE;
charMask: WORD = 177B;
markBit: WORD = 200B;
bLength: CARDINAL = 100;
buffer: PACKED ARRAY [0 .. bLength) OF CHARACTER;
rPos: CARDINAL ← 0;
wPos: CARDINAL ← 0;
bChange: CONDITION;
delCount: CARDINAL ← 0;
charsWritten: BOOLEAN ← FALSE; -- chars written but not sent
readerDead: BOOLEAN ← FALSE;
lineWidth: CARDINAL ← 0;
pageHeight: CARDINAL ← 0;
terminal: CARDINAL ← 0;
charPos: CARDINAL ← 0;
linePos: CARDINAL ← 0;

NoteDeadReader: ENTRY PROCEDURE = {readerDead ← TRUE; NOTIFY bChange};

ChangeWPos: ENTRY PROCEDURE [change: CARDINAL] = INLINE
BEGIN
ENABLE UNWIND => NULL;
IF rPos = wPos THEN NOTIFY bChange;
wPos ← wPos + change; IF wPos = bLength THEN wPos ← 0;
END; -- of ChangeWPos --

WLimit: ENTRY PROCEDURE RETURNS[ limit: CARDINAL ] = INLINE
BEGIN
ENABLE UNWIND => NULL;
WHILE (limit ← IF wPos >= rPos THEN IF rPos = 0 THEN bLength-1 ELSE bLength
ELSE rPos-1 )
= wPos
DO WAIT bChange ENDLOOP;
END; -- of WLimit --

AddDel: ENTRY PROCEDURE =
BEGIN
ENABLE UNWIND => NULL;
delCount ← delCount + 1;
Stream.SendAttention[str, 0];
Stream.SetSST[str, 1 --data mark--];
END; -- of AddDel --

GetByte: ENTRY PROCEDURE RETURNS [c: UNSPECIFIED] =
BEGIN
ENABLE UNWIND => NULL;
WHILE rPos = wPos DO
IF charsWritten THEN {charsWritten ← FALSE; Stream.SendNow[str]};
IF readerDead THEN ERROR ReaderDied[];
WAIT bChange;
IF rPos = wPos THEN SIGNAL TimeOut[];
ENDLOOP;
c ← buffer[rPos];
rPos ← rPos + 1;
IF rPos = bLength THEN rPos ← 0;
NOTIFY bChange; -- in case buffer was full --
IF c = Ascii.DEL THEN delCount ← delCount - 1;
END; -- of GetByte --

Reader: PROCEDURE =
BEGIN
Stream.SetInputOptions
[str, [terminateOnEndPhysicalRecord: TRUE, signalLongBlock: FALSE,
signalShortBlock: FALSE, signalSSTChange: FALSE, signalEndOfStream: FALSE]];
DO ENABLE {Stream.TimeOut => RESUME; PupStream.StreamClosing => EXIT;};
used: CARDINAL;
why: Stream.CompletionCode;
sst: Stream.SubSequenceType;
[used, why, sst] ← Stream.GetBlock[str, [@buffer, wPos, WLimit[]]];
FOR index: CARDINAL IN [wPos .. wPos+ used) DO
SELECT (buffer[index] ← Inline.BITAND[buffer[index], charMask]) FROM
Ascii.ControlC, Ascii.DEL => {buffer[index] ← Ascii.DEL; AddDel[]};
ENDCASE => NULL;
ENDLOOP;
ChangeWPos[used];
IF why = sstChange THEN
BEGIN
buffer[wPos] ← Inline.BITOR[sst, markBit];
ChangeWPos[1];
IF sst = 6 --timing mark reply-- AND NOT readerWanted THEN EXIT;
END;
ENDLOOP;
NoteDeadReader[];
END; -- of Reader --

ConsiderSST: PROCEDURE [thisSST: Stream.SubSequenceType] =
BEGIN
SELECT thisSST FROM
1 => -- data mark -- NULL;
2 => lineWidth ← GetByte[];
3 => pageHeight ← GetByte[];
4 => terminal ← GetByte[];
5 => Stream.SetSST[str, 6--timing mark reply--];
6 => SIGNAL SynchReply[];
ENDCASE; -- ignore --
END; -- of ConsiderSST --

ReadChar: PROCEDURE RETURNS [c: CHARACTER] =
BEGIN
DO
c ← GetByte[];
IF Inline.BITAND[c, markBit] # 0 THEN ConsiderSST[Inline.BITAND[c, charMask]]
ELSE EXIT
ENDLOOP;
linePos ← 0; -- only count lines between input operations --
END; -- of ReadChar --

ReadString: PROCEDURE [s: STRING] RETURNS [end: CHARACTER] =
BEGIN

ShowIt: PROCEDURE = {WriteString[s]};

Unwrite: PROCEDURE =
BEGIN
IF s.length > 0 THEN
BEGIN
WriteChar[’\];
WriteChar[s[s.length - 1]];
s.length ← s.length - 1;
END;
END; -- of Unwrite --

ClearWord: PROCEDURE =
BEGIN
state: {alpha, other} ← other;
WHILE s.length > 0 DO
SELECT s[s.length - 1] FROM
IN [’a .. ’z], IN [’A .. ’Z], IN [’0 .. ’9] => state ← alpha;
ENDCASE => IF state # other THEN EXIT;
Unwrite[];
ENDLOOP;
END; -- of ClearWord --

c: CHARACTER;
ShowIt[];
SELECT (c ← ReadChar[]) FROM
Ascii.ControlA, Ascii.BS, Ascii.ControlW, --client wants to edit it--
Ascii.SP, Ascii.CR, Ascii.DEL => NULL; --client accepts it--
ENDCASE =>
IF s.length > 0 THEN {WriteString["← "L]; s.length ← 0}; --client rejects it--
DO
SELECT c FROM
Ascii.ControlA, Ascii.BS => Unwrite[];
Ascii.ControlW => ClearWord[];
ENDCASE =>
BEGIN
SELECT c FROM
Ascii.SP, Ascii.CR, Ascii.ESC, Ascii.DEL => {end ← c; EXIT};
ENDCASE => NULL;
IF s.length < s.maxlength THEN
BEGIN
s[s.length] ← c;
s.length ← s.length + 1;
WriteChar[c];
END
ELSE WriteChar[Ascii.BEL];
END;
c ← ReadChar[];
ENDLOOP;
END; -- of ReadString --

ReadDecimal: PROCEDURE RETURNS [n: CARDINAL] =
BEGIN
s: STRING ← [10];
[] ← ReadString[s];
n ← String.StringToDecimal[s ! String.InvalidNumber => {n ← 0; CONTINUE}];
END; -- of ReadDecimal --

WriteChar: PROCEDURE [c: CHARACTER] =
-- assumed to be called from only one process --
-- otherwise, we need two monitor locks: this may use ReadChar --
BEGIN
ENABLE UNWIND => NULL;

WS: PROCEDURE [s: STRING] =
BEGIN -- sneak in a string --
FOR index: CARDINAL IN [0 .. s.length) WHILE charPos < lineWidth DO
PutSingleWidth[s[index]]
ENDLOOP;
END; -- of WS --

Lf: PROCEDURE =
BEGIN
IF linePos + 1 >= pageHeight AND pageHeight # 0 THEN
BEGIN
IF charPos > 0 THEN Stream.PutChar[str, Ascii.CR];
charPos ← 0;
Stream.PutChar[str, Ascii.LF];
WS["Type ESC for next page ..."L];
SendNow[];
UNTIL ReadChar[] = Ascii.ESC DO ENDLOOP;
Stream.PutChar[str, Ascii.CR];
charPos ← 0;
END;
Stream.PutChar[str, Ascii.LF];
linePos←linePos+1;
END; -- of Lf --

Newline: PROCEDURE =
BEGIN
Stream.PutChar[str, Ascii.CR];
charPos ← 0;
Lf[];
END; -- of Newline --

PutSingleWidth: PROCEDURE[c: CHARACTER] = INLINE
BEGIN
IF charPos = lineWidth AND lineWidth > 0 THEN Newline[];
Stream.PutChar[str, c]; charPos ← charPos+1;
END; -- of PutSingleWidth --

NoteWritten: ENTRY PROCEDURE = INLINE {charsWritten ← TRUE};

Process.Yield[];
IF delCount # 0 THEN RETURN;
SELECT c FROM
IN [40C .. 177C] => PutSingleWidth[c];
Ascii.CR => Newline[];
Ascii.LF => Lf[];
Ascii.BEL => Stream.PutChar[str, c];
Ascii.TAB =>
DO
PutSingleWidth[Ascii.SP];
IF charPos MOD 8 = 0 THEN EXIT;
ENDLOOP;
IN [0C .. 40C) => {PutSingleWidth[’↑]; PutSingleWidth[c + 100B]};
ENDCASE; -- illegal character values --
NoteWritten[];
END; -- of WriteChar --

WriteString: PROCEDURE [s: STRING] =
{FOR i: CARDINAL IN [0 .. s.length) DO WriteChar[s[i]] ENDLOOP};

WriteLine: PROCEDURE [s: STRING] = {WriteString[s]; WriteChar[Ascii.CR]};

WriteDecimal: PROCEDURE [n: CARDINAL] =
BEGIN
s: STRING = [6] -- -65536 --;
String.AppendDecimal[s, n];
WriteString[s];
END; -- of WriteDecimal --

WriteLongDecimal: PROCEDURE [n: LONG INTEGER] =
BEGIN
s: STRING = [11] -- -6553665536 --;
String.AppendLongDecimal[s,n];
WriteString[s];
END; -- of WriteLongDecimal --

NoteSent: ENTRY PROCEDURE = INLINE {charsWritten ← FALSE};

SendNow: PROCEDURE = {NoteSent[]; Stream.SendNow[str]};

CharsLeft: PROCEDURE RETURNS [CARDINAL] =
{RETURN[IF lineWidth > 0 THEN lineWidth - charPos ELSE LAST[CARDINAL]]};

LinesLeft: PROCEDURE RETURNS [CARDINAL] =
{RETURN[IF pageHeight > 0 THEN pageHeight - linePos ELSE LAST[CARDINAL]]};

SetWidth: PROCEDURE [new: CARDINAL] = {lineWidth ← new};

SetHeight: PROCEDURE [new: CARDINAL] = {pageHeight ← new};

DelTyped: ENTRY PROCEDURE RETURNS [BOOLEAN] = {RETURN[delCount # 0]};

Synch: PROCEDURE = {Stream.SetSST[str, 5]};

Flush: PROCEDURE = {WHILE delCount > 0 DO [] ← ReadChar[] ENDLOOP};

MyConfirm: PROCEDURE RETURNS [BOOLEAN] =
BEGIN
WriteString["Type ESC to confirm, DEL to cancel."L];
SELECT ReadChar[] FROM
Ascii.ESC, Ascii.CR, ’y, ’Y => {WriteString["Yes"L]; RETURN[TRUE]};
ENDCASE => {WriteString["Yes"L]; RETURN[FALSE]};
END; -- of MyConfirm --

obj: LaurelTTYDefs.HandleObject ←
[ReadChar, ReadString, ReadDecimal, WriteChar, WriteString, WriteLine, WriteDecimal,
WriteLongDecimal, SendNow, CharsLeft, LinesLeft, SetWidth, SetHeight, DelTyped,
Synch, Flush];
exD.SetExternalExceptionProc[WriteString];
inD.SetExternalConfirmProc[MyConfirm];
Process.SetTimeout[@bChange, Process.SecondsToTicks[600]];
readerPSB ← FORK Reader[];
BEGIN
ENABLE {PupStream.StreamClosing, ReaderDied => CONTINUE; TimeOut => RESUME };
work[@obj ! SynchReply => RESUME];
readerWanted ← FALSE;
Synch[];
DO [] ← ReadChar[ ! SynchReply => EXIT] ENDLOOP;
END;
JOIN readerPSB;
str.delete[str];
SetInUse[FALSE];
END; -- of TelnetWork --

TelnetFilter: PROCEDURE [addr: PupDefs.PupAddress] =
{IF InUse[] THEN PupStream.RejectThisRequest["Server full"L]};

InUse: ENTRY PROCEDURE RETURNS [BOOLEAN] = {RETURN[inUse]};

SetInUse: ENTRY PROCEDURE [value: BOOLEAN] = {inUse ← value};

listener: PupStream.PupListener ← PupStream.CreatePupByteStreamListener
[PupTypes.telnetSoc, TelnetWork, PupStream.veryLongWait, TelnetFilter];
-- Process.DisableTimeout[@drD.interruptWakeup];
Process.DisableTimeout[@listenerCond];
UNTIL wantToDie DO WAIT listenerCond ENDLOOP;
PupStream.DestroyPupListener[listener];
-- Process.SetTimeout[@drD.interruptWakeup, 1];
-- NOTIFY drD.interruptWakeup;
END; -- of Listen --


KillTheListener: ENTRY PROCEDURE = {wantToDie ← TRUE; NOTIFY listenerCond};


Work: PROCEDURE [h: LaurelTTYDefs.Handle] =
BEGIN OPEN h;
password: STRING ← [40];
char: CHARACTER;
WriteLine["Laurel Chat Server, Version of April 13, 1982"L];
DO
WriteString["Password: "L];
SendNow[];
DO
SELECT char ← ReadChar[] FROM
Ascii.ESC =>
BEGIN
IF password.length = 0 THEN {WriteLine["Closing connection"L]; RETURN};
IF String.EquivalentString[password, intC.user.password] THEN GO TO ok;
password.length ← 0;
WriteLine[""L];
EXIT;
END;
Ascii.DEL => {password.length ← 0; WriteLine[""L]; EXIT};
ENDCASE =>
IF password.length < password.maxlength THEN
BEGIN
password[password.length] ← char;
password.length ← password.length + 1;
WriteChar[’*];
END;
ENDLOOP;
REPEAT
ok => WriteLine[""L];
ENDLOOP;
SendNow[];
LaurelTTYDefs.TTYInterface[h];
END; -- of Work --


Main: PROCEDURE =
BEGIN
pCursor: POINTER TO ARRAY [0 .. 15] OF CARDINAL = LOOPHOLE[431B];
phone: ARRAY [0 .. 15] OF CARDINAL ←
[17774B, 37776B, 77777B, 72027B, 73767B, 3760B, 16534B, 17774B,
16534B,17774B, 16534B, 17774B, 16534B, 17774B, 0, 0];
savedDCBptr: dsD.DCBptr ← dsD.DCBorg↑;
listenPSB: PROCESS;
typein: STRING ← [40];

dsD.DCBorg↑ ← dsD.DCBnil;
LaurelTTYDefs.ZeroBuffer[@LaurelTTYDefs.buffer];
listenPSB ← FORK Listen[Work];
DO
char: CHARACTER;
Process.Yield[];
Inline.COPY[from: @phone, to: pCursor, nwords: 16];
IF ~intC.keystream.endof[intC.keystream] THEN
SELECT char ← intC.keystream.get[intC.keystream] FROM
Ascii.ESC =>
IF String.EquivalentString[typein, intC.user.password] THEN
{KillTheListener[]; EXIT}
ELSE typein.length ← 0;
Ascii.DEL => {typein.length ← 0};
ENDCASE =>
IF typein.length < typein.maxlength THEN
{typein[typein.length] ← char; typein.length ← typein.length + 1};
ENDLOOP;
JOIN listenPSB;
dsD.DCBorg↑ ← savedDCBptr;
LaurelTTYDefs.CleanupTTYEditor[];
exD.SetExternalExceptionProc[NIL];
inD.SetExternalConfirmProc[NIL];
END; -- of Main --


Main[];


END. -- of ChatServer --