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