-- Copyright (C) 1983, 1984, 1985  by Xerox Corporation. All rights reserved. 
-- GVPServer.mesa, the ALTO end of the GVPatch system
-- HGM, 15-Sep-85 11:48:37
-- Steve Temple, September 29, 1982 9:50 am
-- Brenda Hankins   2-Jun-83 15:52:06	 
-- kludge to get around authentication problem for Mission.

DIRECTORY
  BodyDefs: TYPE USING [maxRNameLength, RName],
  IODefs USING [WriteDecimal, WriteLine, WriteString],
  HeapXDefs USING [ObjectHeader, PageHeader],
  NameInfoDefs USING [Authenticate, IsMemberClosure],
  ProtocolDefs USING [
    DestroyStream, Failed, Handle, ReceiveByte, ReceiveBytes, ReceiveCount,
    ReceiveRName, ReceiveString, SendByte, SendBytes, SendCount, SendNow,
    SendString],
  PupDefs USING [PupAddress, PupPackageMake, PupSocketID],
  PupStream USING [CreatePupByteStreamListener, veryLongWait],
  String USING [AppendString, EqualStrings],
  TemporaryBooting USING [BootFromVolume],
  VMDefs USING [
    AllocatePage, CantOpen, CantReadBackingStore, CantWriteBackingStore,
    CloseFile, Deactivate, Error, FileHandle, GetFileLength, InitializeVM,
    MarkStartWait, OpenFile, OpenOptions, Page, PageByteIndex, pageByteSize,
    PageNumber, Position, ReadPage, RemapPage, SetFileLength, UnmapPage],
  Volume USING [systemID];


GVPServer: PROGRAM

  IMPORTS
    IODefs, NameInfoDefs, ProtocolDefs, PupDefs, PupStream, String,
    TemporaryBooting, VMDefs, Volume =

  BEGIN OPEN IODefs, VMDefs;

  Byte: TYPE = [0..255];

  Command: TYPE = Byte;

  login: Command = 1;
  readHeaders: Command = 2;
  openFile: Command = 3;
  readPage: Command = 4;
  writePage: Command = 5;
  restartServer: Command = 6;
  setLength: Command = 7;
  errorCode: Command = 255;

  oldFile: Byte = 0;
  oldOrNewFile: Byte = 1;

  GVPatchSocket: PupDefs.PupSocketID = [0, 47B];

  maxString: CARDINAL = 64;
  voidString: STRING = "? ? ? \\ ? ? ? "L;

  --==============================================================================

  currentUser: STRING ¬ [maxString];
  session: CARDINAL ¬ 0;
  fileName: STRING ¬ [maxString];
  file: FileHandle ¬ NIL;
  fileEnd: Position;
  pageBuffer: Page ¬ NIL;

  Open: PROC [name: STRING, option: Byte] RETURNS [openAlready: BOOLEAN ¬ TRUE] =
    BEGIN
    IF NOT String.EqualStrings[name, fileName] THEN {
      opener: OpenOptions = IF option = oldFile THEN old ELSE oldOrNew;
      Close[];
      file ¬ OpenFile[name: name, cacheFraction: 100, options: opener];
      fileName.length ¬ 0;
      String.AppendString[to: fileName, from: name];
      fileEnd ¬ GetFileLength[file];
      openAlready ¬ FALSE}
    END;

  Close: PROC =
    BEGIN
    IF pageBuffer # NIL THEN Deactivate[pageBuffer];
    pageBuffer ¬ NIL;
    IF file # NIL THEN CloseFile[file];
    file ¬ NIL;
    fileName.length ¬ 0;
    String.AppendString[to: fileName, from: voidString]
    END;

  TrashUser: PROC =
    BEGIN
    currentUser.length ¬ 0;
    String.AppendString[to: currentUser, from: voidString]
    END;

  NewLine: PROC [s: STRING] = {WriteLine[""L]; WriteString[s]};

  --==============================================================================


  CommandInterpreter: PROC [
    stream: ProtocolDefs.Handle, from: PupDefs.PupAddress] =
    BEGIN

    ENABLE ProtocolDefs.Failed => GOTO clearOut;  -- other end died probably 

    userName: BodyDefs.RName ¬ [BodyDefs.maxRNameLength];
    password: STRING ¬ [maxString];

    ok: BOOLEAN;

    IF ProtocolDefs.ReceiveByte[stream] # login THEN GOTO closeOut;  -- we are quitting
    ProtocolDefs.ReceiveRName[stream, userName];
    ProtocolDefs.ReceiveString[stream, password];

    IF String.EqualStrings[userName, "Wizard.gv"L] THEN ok ¬ TRUE
    ELSE
      BEGIN
      ok ¬ NameInfoDefs.Authenticate[userName, password] = individual;
      IF ok THEN
        ok ¬ (NameInfoDefs.IsMemberClosure["Transport^.ms"L, userName] = yes);
      END;

    IF NOT ok THEN BEGIN SendError[stream, "Login failed"L]; GOTO closeOut END;

    IF NOT String.EqualStrings[userName, currentUser]
      AND NOT String.EqualStrings[currentUser, voidString] THEN
      BEGIN
      SendError[stream, "Server in use by someone else"L];
      GOTO closeOut
      END;

    currentUser.length ¬ 0;
    String.AppendString[to: currentUser, from: userName];

    ProtocolDefs.SendByte[stream, login];
    ProtocolDefs.SendNow[stream];
    session ¬ session + 1;
    NewLine["Session "L];
    WriteDecimal[session];
    WriteString[" started, user is "L];
    WriteLine[userName];

    DO
      SELECT ProtocolDefs.ReceiveByte[stream] FROM

        --+++++++++++++++++++++++++++++++++++++++++++++++++++++
        --
        --   readHeaders, transmit structural info of "heap.data". 
        --
        --       We receive - just the command byte
        --       We send    -  error item or...
        --          (a) readHeaders command (byte)
        --          (b) X, number of pages in file then X items..
        --              (1) Y, number of MS objects on this page (count)
        --              (2) page header for this page (2 words)
        --              (3) Y object headers (each 3 words)
        -- 
        --+++++++++++++++++++++++++++++++++++++++++++++++++++++

        readHeaders =>
          BEGIN
          heapPages: CARDINAL;

          byteVec: TYPE = PACKED ARRAY [0..pageByteSize) OF Byte;
          packBufferVec: byteVec;
          packBuffer: POINTER TO byteVec ¬ @packBufferVec;

          PackPage: PROC [from: Page, to: POINTER TO byteVec]
            RETURNS [objects, bytes: CARDINAL] =
            BEGIN OPEN HeapXDefs;

            bpw: CARDINAL = 2;
            pageHdrByteSize: CARDINAL = SIZE[PageHeader] * bpw;
            objHdrByteSize: CARDINAL = SIZE[ObjectHeader] * bpw;

            offset: CARDINAL ¬ pageHdrByteSize;
            toIndex: PageByteIndex ¬ pageHdrByteSize;
            objH: LONG POINTER TO ObjectHeader;

            FOR i: CARDINAL IN [0..pageHdrByteSize) DO  -- copy the page header
              to[i] ¬ from.bytes[i] ENDLOOP;

            objects ¬ 0;
            WHILE offset <= pageByteSize - objHdrByteSize DO  -- copy each object header
              objects ¬ objects + 1;
              objH ¬ LOOPHOLE[from + offset / bpw];

              FOR i: CARDINAL IN [0..objHdrByteSize) DO  -- copy an object header
                to[toIndex] ¬ from.bytes[offset];
                offset ¬ offset + 1;
                toIndex ¬ toIndex + 1
                ENDLOOP;

              offset ¬ offset + objH.size * bpw;
              ENDLOOP;
            bytes ¬ toIndex
            END;

          NewLine["Reading of heap file "L];

          [] ¬ Open[
            name: "heap.data"L, option: oldFile !
            CantOpen => {SendError[stream, "Unable to open file"L]; GOTO getOut}];

          heapPages ¬ fileEnd.page + (IF fileEnd.byte = 0 THEN 0 ELSE 1);
          ProtocolDefs.SendByte[stream, readHeaders];
          ProtocolDefs.SendCount[stream, heapPages];
          ProtocolDefs.SendNow[stream];  -- help things along a little

          FOR i: CARDINAL IN [0..heapPages) DO
            bytes, objects: CARDINAL;
            pageBuffer ¬ ReadPage[
              [file, i], 0 !
              CantReadBackingStore, Error => {
                SendError[stream, "File read error"L]; GOTO getOut}];

            [objects, bytes] ¬ PackPage[pageBuffer, packBuffer];

            ProtocolDefs.SendCount[stream, objects];
            ProtocolDefs.SendBytes[stream, packBuffer, bytes];
            Deactivate[pageBuffer];
            pageBuffer ¬ NIL
            ENDLOOP;

          ProtocolDefs.SendNow[stream];
          Close[];

          WriteLine["succeeded"L]
          EXITS getOut => WriteLine["failed"L]
          END;

        --+++++++++++++++++++++++++++++++++++++++++++++++++++++
        --
        -- open File, open a file on the server and send back some info
        --
        --       We receive - 
        --          (a) openFile command (byte)
        --          (b) file name (string)
        --          (c) read/write (byte)
        --
        --       We send - an error item or...
        --          (a) openFile command (byte)
        --          (b) end of file page (count)
        --          (c) end of file byte (count)
        --     
        --+++++++++++++++++++++++++++++++++++++++++++++++++++++

        openFile =>
          BEGIN
          name: STRING ¬ [maxString];
          oldNew: Byte;

          ProtocolDefs.ReceiveString[stream, name];
          oldNew ¬ ProtocolDefs.ReceiveByte[stream];

          IF NOT Open[
            name: name, option: oldNew !
            CantOpen => {
              SendError[stream, "Unable to open file"L];
              NewLine["Open "L];
              WriteString[name];
              WriteLine[
                IF oldNew = oldFile THEN " old only - failed"L
                ELSE " old or new - failed"L];
              GOTO getOut}] THEN
            BEGIN
            NewLine["Open "L];
            WriteString[name];
            WriteString[
              IF oldNew = oldFile THEN " old only"L ELSE " old or new"L];
            WriteString[", length ("L];
            WriteDecimal[fileEnd.page];
            WriteString[", "L];
            WriteDecimal[fileEnd.byte];
            WriteLine[") OK"L]
            END;

          ProtocolDefs.SendByte[stream, openFile];
          ProtocolDefs.SendCount[stream, fileEnd.page];
          ProtocolDefs.SendCount[stream, fileEnd.byte];
          ProtocolDefs.SendNow[stream]
          EXITS getOut => NULL
          END;

        --+++++++++++++++++++++++++++++++++++++++++++++++++++++
        --
        --  setLength, set length of file
        --
        --       We receive - 
        --          (a) setLength command (byte)
        --          (b) end of file page (count)
        --          (c) end of file byte (count)
        -- 
        --       We send    - an error item or...
        --          (a) setLength command (byte)
        --     
        --+++++++++++++++++++++++++++++++++++++++++++++++++++++

        setLength =>
          BEGIN
          p: CARDINAL;
          b: CARDINAL;

          NewLine["Set "L];
          WriteString[fileName];

          p ¬ ProtocolDefs.ReceiveCount[stream];
          b ¬ ProtocolDefs.ReceiveCount[stream];

          WriteString[" ("L];
          WriteDecimal[p];
          WriteString[", "L];
          WriteDecimal[b];
          WriteString[")"L];

          IF b NOT IN [0..pageByteSize) THEN
            BEGIN SendError[stream, "Bad byte number"L]; GOTO getOut END;

          IF file = NIL THEN
            BEGIN SendError[stream, "No file open"L]; GOTO getOut END;

          SetFileLength[file, [p, b]];
          fileEnd ¬ GetFileLength[file];
          ProtocolDefs.SendByte[stream, setLength];
          ProtocolDefs.SendNow[stream];

          WriteLine[" OK"L];
          EXITS getOut => WriteLine["failed"L];
          END;

        --+++++++++++++++++++++++++++++++++++++++++++++++++++++
        --
        --  readPage, read a page from the currently open file on the server.
        --
        --       We receive - 
        --          (a) readPage command (byte)
        --          (b) page number (count)
        --
        --       We send    - an error item or...
        --          (a) readPage command (byte)
        --          (b) data from the page (bytes)
        --     
        --+++++++++++++++++++++++++++++++++++++++++++++++++++++

        readPage =>
          BEGIN
          pageNum: CARDINAL;

          WriteString["RP "L];
          pageNum ¬ ProtocolDefs.ReceiveCount[stream];
          WriteDecimal[pageNum];

          IF file = NIL THEN {SendError[stream, "No file open"]; GOTO getOut};

          IF fileEnd.page = 0 AND fileEnd.byte = 0 THEN {
            SendError[stream, "Empty file"]; GOTO getOut};

          IF NOT
            (pageNum IN [0..fileEnd.page)
              OR (fileEnd.byte # 0 AND pageNum = fileEnd.page)) THEN {
            SendError[stream, "Bad page number for read"L]; GOTO getOut};

          pageBuffer ¬ ReadPage[
            [file, pageNum], 0 !
            CantReadBackingStore, Error => {
              SendError[stream, "File read error"L]; GOTO getOut}];

          ProtocolDefs.SendByte[stream, readPage];
          ProtocolDefs.SendBytes[stream, pageBuffer, pageByteSize];
          ProtocolDefs.SendNow[stream];
          Deactivate[pageBuffer];
          pageBuffer ¬ NIL;
          WriteString[", "]
          EXITS getOut => WriteLine[" failed"L];
          END;

        --+++++++++++++++++++++++++++++++++++++++++++++++++++++
        --
        --  writePage, write a page onto currently open file on the server.
        --
        --       We receive - 
        --          (a) writePage command (byte)
        --          (b) page number of this page (count)
        --          (c) data for the page (bytes)
        --
        --       We send - an error item or...
        --          (a) writePage command (byte))
        --
        --+++++++++++++++++++++++++++++++++++++++++++++++++++++

        writePage =>
          BEGIN
          pageNum: CARDINAL;

          WriteString["WP "L];

          pageBuffer ¬ AllocatePage[];
          pageNum ¬ ProtocolDefs.ReceiveCount[stream];
          ProtocolDefs.ReceiveBytes[stream, pageBuffer, pageByteSize];
          WriteDecimal[pageNum];

          IF file = NIL THEN {SendError[stream, "No file open"]; GOTO getOut};

          fileEnd ¬ GetFileLength[file];

          IF NOT pageNum IN [0..fileEnd.page] THEN
            BEGIN
            SendError[stream, "Bad page number for write"L];
            GOTO getOut
            END;

          RemapPage[pageBuffer, [file, pageNum]];

          MarkStartWait[
            pageBuffer !
            CantWriteBackingStore, Error => {
              SendError[stream, "File write error"L]; GOTO getOut}];

          ProtocolDefs.SendByte[stream, writePage];
          ProtocolDefs.SendNow[stream];

          UnmapPage[pageBuffer];
          Deactivate[pageBuffer];
          pageBuffer ¬ NIL;

          WriteString[", "L]
          EXITS getOut => WriteLine[" failed"L]
          END;

        --+++++++++++++++++++++++++++++++++++++++++++++++++++++
        --
        --  restartServer, start up the Grapevine server again.
        --
        --       We receive - 
        --          (a) restartServer command (byte)
        --          (b) command line (string)
        -- 
        --       We send - acknowledgement
        --+++++++++++++++++++++++++++++++++++++++++++++++++++++ 

        restartServer =>
          BEGIN
          commandLine: STRING ¬ [maxString];

          WriteLine["Server restart commencing..."L];

          -- "START ME UP"  

          ProtocolDefs.SendByte[stream, restartServer];
          ProtocolDefs.SendNow[stream];
          ProtocolDefs.DestroyStream[stream];
          TemporaryBooting.BootFromVolume[Volume.systemID, ];
          END;

        ENDCASE =>
          BEGIN NewLine["Bad command received, stopping"L]; GOTO closeOut END;

      ENDLOOP;

    EXITS
      closeOut => {ProtocolDefs.DestroyStream[stream]; Close[]; TrashUser[]};
      clearOut => {Close[]; TrashUser[]}

    END;  -- of CommandLoop

  --==============================================================================



  SendError: PROC [stream: ProtocolDefs.Handle, error: STRING] =
    BEGIN
    WriteString[" (error - "L];
    WriteString[error];
    WriteString[") "L];
    ProtocolDefs.SendByte[stream, errorCode];
    ProtocolDefs.SendString[stream, error];
    ProtocolDefs.SendNow[stream]
    END;


  [] ¬ PupDefs.PupPackageMake[];
  InitializeVM[min: 2, max: 8];

  Close[];
  TrashUser[];

  [] ¬ PupStream.CreatePupByteStreamListener[
    GVPatchSocket, CommandInterpreter, PupStream.veryLongWait];

  END.