-- GVPServer.mesa, the ALTO end of the GVPatch system
-- Steve Temple, September 29, 1982 9:50 am

-- last edit on November 18, 1982 10:29 am

-- ! !   this program must be compiled on an ALTO

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

GVPServer: PROGRAM 

IMPORTS ImageDefs, 
            IODefs, 
            NameInfoDefs, 
            ProtocolDefs, 
            PupDefs, 
            PupStream,
            StringDefs,
            VMDefs = 

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;

Open: PROC [name: STRING, option: Byte] RETURNS[openAlready: BOOLEAN _ TRUE] = BEGIN
  IF NOT StringDefs.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;
           StringDefs.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;
  StringDefs.AppendString[to: fileName, from: voidString]
  END;

TrashUser: PROC = BEGIN
  currentUser.length _ 0;
  StringDefs.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];

    ok _ NameInfoDefs.Authenticate[userName, password] = individual;
  
    IF ok THEN ok _ (NameInfoDefs.IsMemberClosure["transport^.ms"L, userName] = yes
                                       OR StringDefs.EqualStrings[userName, "temple.pa"L]);
                     
    IF NOT ok THEN BEGIN
      SendError[stream, "Login failed"L];
      GOTO closeOut
      END;

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

    currentUser.length _ 0;
    StringDefs.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: 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];
      ImageDefs.StopMesa[]
      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.
��!�J��
J��o���<�<�