-- 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 --(635)\f1