-- 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.