ComputeServerImpl:
CEDAR
MONITOR
IMPORTS AMModel, BasicTime, CedarProcess, CommandTool, ComputeServerCallbacksRpcControl, ComputeServerControllerRpcControl, ComputeServerInternal, ComputeServerServer, ComputeServerStatistics, ComputeUtils, Convert, DFOperations, DFUtilities, FS, GVSend, IO, List, LoadState, Process, ProcessProps, PupName, PupStream, RefText, Rope, RPC, SummonerControllerControl, SymTab, UserCredentials, UserProfile, VM, WorldVM
EXPORTS ComputeServer, ComputeServerControl, ComputeServerInternal, ComputeServerStatistics
SHARES ComputeServerServer
= BEGIN
Variable Declarations
STREAM: TYPE = IO.STREAM;
ROPE: TYPE = Rope.ROPE;
ControllerGVName: PUBLIC ROPE ← NIL;
ControllerInterface: PUBLIC ComputeServerControllerRpcControl.InterfaceRecord ← NIL;
myHostName: PUBLIC ROPE ← PupName.MyName[];
MyNetAddressRope: PUBLIC ROPE ← PupName.MyRope[];
ActiveServicesItem: TYPE = ComputeServerInternal.ActiveServicesItem;
ActiveServicesListBase: PUBLIC ComputeServerInternal.ActiveServicesItem ← NIL;
ActiveServicesItemObject: TYPE = ComputeServerInternal.ActiveServicesItemObject;
ActiveServices: PUBLIC INT ← 0 ; -- count of currently active services
LastActiveTime: PUBLIC BasicTime.GMT ← BasicTime.Now[];
CurrentRequests: PUBLIC LIST OF ComputeServer.Request ← NIL;
BufStreamData: TYPE = ComputeServerInternal.BufStreamData;
bufStreamState: TYPE = ComputeServerInternal.bufStreamState;
BufStreamDataObject: TYPE = ComputeServerInternal.BufStreamDataObject;
CommandTable: PUBLIC SymTab.Ref; -- knowing a command, find the package/version
PackageTable: PUBLIC SymTab.Ref; -- knowing a package, find its commands and maintainer
PackageEntryObject: TYPE = ComputeServerInternal.PackageEntryObject;
PackageEntry: TYPE = ComputeServerInternal.PackageEntry;
CmdEntryObject: TYPE = ComputeServerInternal.CmdEntryObject;
CmdEntry: TYPE = ComputeServerInternal.CmdEntry;
ConfigTable: PUBLIC SymTab.Ref; -- knowing a config, find the package that ran it
ConfigEntryObject: TYPE = ComputeServerInternal.ConfigEntryObject;
ConfigEntry: TYPE = ComputeServerInternal.ConfigEntry;
NotSummonerProcess: PUBLIC ERROR = CODE;
RemoteCommandDir: PUBLIC ROPE ← NIL;
LocalCommandDir: PUBLIC ROPE ← NIL;
ShortPackageList: ROPE ← "PackageList";
clientInterfaceItem:
TYPE =
RECORD [
clientInstance: ROPE ← NIL,
interface: ComputeServerCallbacksRpcControl.InterfaceRecord ← NIL,
lastUsed: BasicTime.GMT ← BasicTime.earliestGMT
];
clientInterfaceCacheSize: INT = 20;
clientInterfaceArray: TYPE = ARRAY [0..clientInterfaceCacheSize) OF clientInterfaceItem;
clientInterfaceCache: REF clientInterfaceArray;
OKToRunBCDs: BOOL ← TRUE;
PackagesOKToRun: LIST OF ROPE ← NIL;
PackagesNotOKToRun: LIST OF ROPE ← NIL;
TryForFreeGFIs: INT ← 10;
OKToUseLocalDisk: PUBLIC BOOL ← FALSE;
DisableIFIdle: PUBLIC BOOL ← TRUE;
DisableIFIdleAfter: PUBLIC INT ← 1900;
DisableIFIdleBefore: PUBLIC INT ← 700;
anotherServerEvent: CONDITION;
serverEventListTail: REF ComputeServerStatistics.ServerEvent ← NIL;
watchingServer: BOOLEAN ← FALSE;
RunListItem:
TYPE =
RECORD [
package: ROPE,
gfi: INT ← 0
];
RunList: TYPE = LIST OF REF RunListItem;
inStreamProcs:
PUBLIC
REF
IO.StreamProcs ←
IO.CreateStreamProcs[
variety: $input,
class: $ROPE,
getChar: inBufGetChar,
endOf: inBufEndOf,
charsAvail: inCharsAvail,
backup: inBackup,
getIndex: inBufGetIndex,
close: inBufClose
];
outStreamProcs:
PUBLIC
REF
IO.StreamProcs ←
IO.CreateStreamProcs[
variety: $output,
class: $ROPE,
putChar: outBufPutChar,
unsafePutBlock: outBufUnsafePutBlock,
flush: outBufFlush,
getIndex: outBufGetIndex,
close: outBufClose
];
Command Directory
InitCommands:
PUBLIC
PROC [remoteCommandDirectory, localCommandDirectory: Rope.
ROPE]
RETURNS [msg:
ROPE ←
NIL] = {
ShortPackageList: ROPE ← "PackageList";
cp: FS.ComponentPositions;
fullFName: ROPE;
packageListLocalName: ROPE;
packageListStream: IO.STREAM;
remotePackageListDate: BasicTime.GMT;
localPackageListDate: BasicTime.GMT ← BasicTime.nullGMT;
packages: LIST OF ROPE ← NIL;
packagesList: LIST OF ROPE ← NIL;
parseError: BOOL ← FALSE;
mapWedgeToSlash: Rope.TranslatorType =
{IF old = '> THEN RETURN['/] ELSE RETURN[old]};
constructFName:
PROC [cr:
FS.ComponentRopes, omitDir:
BOOL]
RETURNS [fName:
ROPE] = {
fName ← Rope.Cat[ "/", cr.server, "/" ];
IF NOT omitDir THEN fName ← Rope.Cat[ fName, cr.dir, "/" ];
IF Rope.Length[cr.subDirs] > 0 THEN fName ← Rope.Cat[ fName, cr.subDirs, "/" ];
fName ← Rope.Cat[ fName, cr.base ];
IF Rope.Length[cr.ext] > 0 THEN fName ← Rope.Cat[ fName, ".", cr.ext ];
IF Rope.Length[cr.ver] > 0 THEN fName ← Rope.Cat[ fName, "!", cr.ver ];
};
check to see if local top level .df file matches that stored on the server
GetProfileConstants[];
IF (RemoteCommandDir ← (
IF Rope.IsEmpty[remoteCommandDirectory]
THEN UserProfile.Token[key: "Summoner.RemoteCommandDirectory"]
ELSE remoteCommandDirectory)) =
NIL
THEN {
RemoteCommandDir ← "[Summoner]<Summoner>Packages1>";
};
[] ←
FS.ExpandName[name: RemoteCommandDir !
FS.Error => {
msg ← Rope.Cat["Bad Remote Command Directory (", RemoteCommandDir, ")"];
GOTO returnMsg;
};
];
IF (LocalCommandDir ← (
IF Rope.IsEmpty[localCommandDirectory]
THEN UserProfile.Token[key: "Summoner.LocalCommandDirectory"]
ELSE localCommandDirectory)) =
NIL
THEN {
LocalCommandDir ← "///Summoner/Packages/";
};
[cp: cp, fullFName: fullFName] ←
FS.ExpandName[name: LocalCommandDir.Concat["foo"] !
FS.Error => {
msg ← Rope.Cat["Bad Local Command Directory (", LocalCommandDir, ")"];
GOTO returnMsg;
};
];
LocalCommandDir ← constructFName[
cr: [fullFName.Substr[cp.server.start, cp.server.length], fullFName.Substr[cp.dir.start, cp.dir.length], Rope.Translate[base: fullFName.Substr[cp.subDirs.start, cp.subDirs.length], translator: mapWedgeToSlash], NIL, NIL, NIL],
omitDir: FALSE
];
[created: remotePackageListDate] ←
FS.FileInfo[name: Rope.Concat[RemoteCommandDir, ShortPackageList] !
FS.Error => {
msg ← Rope.Cat["Cannot do an info on the package list because FS says ", error.explanation];
GOTO cantGetPackageList;
};];
packageListLocalName ← Rope.Concat[LocalCommandDir, ShortPackageList] ;
[created: localPackageListDate] ← FS.FileInfo[name: packageListLocalName, remoteCheck: FALSE ! FS.Error => CONTINUE];
IF localPackageListDate = BasicTime.nullGMT
OR localPackageListDate # remotePackageListDate
THEN {
need a new packagelist
[] ←
FS.Copy[from: Rope.Concat[RemoteCommandDir, ShortPackageList], to: packageListLocalName, setKeep:
TRUE, keep: 2, wantedCreatedTime: remotePackageListDate, remoteCheck:
FALSE, attach:
TRUE
!
FS.Error => {
msg ← Rope.Cat["Cannot open package list because FS says ", error.explanation];
GOTO cantGetPackageList;
};
];
};
packageListStream ←
FS.StreamOpen[packageListLocalName
!
FS.Error => {
msg ← Rope.Cat["Cannot open package list stream because FS says ", error.explanation];
GOTO cantOpenPackageList;
};
];
process the .df file a line at a time in DoOneItem. Result is a LIST OF ROPE of packages.
[packages, parseError] ← FindPackagesAndDoBringOver[packageListStream, FALSE];
IF parseError THEN GOTO syntaxErrorInPackageList;
CommandTable ← SymTab.Create[mod: 59, case: FALSE];
PackageTable ← SymTab.Create[mod: 59, case: FALSE];
ConfigTable ← SymTab.Create[mod: 59, case: FALSE];
FOR packagesList ← packages, packagesList.rest
UNTIL packagesList =
NIL
DO
addCommandsFromFile[packagesList.first];
ENDLOOP;
EXITS
cantGetPackageList => {};
cantOpenPackageList => {};
syntaxErrorInPackageList => {RETURN["Syntax error in Package List"]};
returnMsg => {};
};
FindPackagesAndDoBringOver:
PROC [packageListStream:
IO.
STREAM, deltasOnly:
BOOL]
RETURNS [packages:
LIST
OF
ROPE ←
NIL, parseError:
BOOL ←
FALSE] = {
currentDir: ROPE ← RemoteCommandDir;
DoOneItem: DFUtilities.ProcessItemProc = {
PROC [item: REF ANY] RETURNS [stop: BOOL ← FALSE]
errors, warnings, filesActedUpon: INT ← 0;
remoteName: ROPE;
innerBringOver:
PROC = {
[errors, warnings, filesActedUpon] ← DFOperations.BringOver[dfFile: remoteName, filter: [all, public, all], action: enter];
};
WITH item
SELECT
FROM
dir:
REF DFUtilities.DirectoryItem => {
currentDir ← dir.path1;
};
file:
REF DFUtilities.FileItem => {
shortName: ROPE = Rope.Substr[file.name, 0, Rope.Index[s1: file.name, s2: "!"]];
package: ROPE = shortName.Substr[ 0, Rope.Index[s1: shortName, s2: "."]];
packageDFDate: BasicTime.GMT ← BasicTime.nullGMT;
currentDFDate: BasicTime.GMT ← BasicTime.nullGMT;
remoteName ← Rope.Concat[currentDir, shortName];
[created: currentDFDate] ← FS.FileInfo[name: Rope.Cat[LocalCommandDir, package, "/", shortName], remoteCheck: FALSE ! FS.Error => CONTINUE];
IF file.date.format # explicit
OR file.date.gmt # currentDFDate
OR currentDFDate = BasicTime.nullGMT
THEN {
local .df file does not exist, or is not of the proper create date => bring it over
propList: List.AList;
propList ← List.PutAssoc[key: $WorkingDirectory , val: Rope.Cat[LocalCommandDir, package, "/"], aList: NIL];
ProcessProps.AddPropList[propList: propList, inner: innerBringOver];
IF errors = 0 THEN packages ← CONS[shortName.Substr[ 0, Rope.Index[s1: shortName, s2: "."]], packages];
}
ELSE IF ~deltasOnly THEN packages ← CONS[package, packages];
};
ENDCASE;
};
DFUtilities.ParseFromStream[packageListStream, DoOneItem ! DFUtilities.SyntaxError => GOTO syntaxErrorInPackageList];
EXITS
syntaxErrorInPackageList => {parseError ← TRUE};
};
getNewPackages:
PUBLIC
PROC = {
remotePackageListDate: BasicTime.GMT;
packageListLocalName: ROPE ← NIL;
localPackageListDate: BasicTime.GMT ← BasicTime.nullGMT;
packageListStream: IO.STREAM;
parseError: BOOL ← FALSE;
packages: LIST OF ROPE ← NIL;
packagesList: LIST OF ROPE ← NIL;
[created: remotePackageListDate] ← FS.FileInfo[name: Rope.Concat[RemoteCommandDir, ShortPackageList] ! FS.Error => CONTINUE];
packageListLocalName ← Rope.Concat[LocalCommandDir, ShortPackageList] ;
[created: localPackageListDate] ← FS.FileInfo[name: packageListLocalName, remoteCheck: FALSE ! FS.Error => CONTINUE];
IF localPackageListDate = BasicTime.nullGMT
OR localPackageListDate # remotePackageListDate
THEN {
need a new .df file
[] ← FS.Copy[from: Rope.Concat[RemoteCommandDir, ShortPackageList], to: packageListLocalName, setKeep: TRUE, keep: 2, wantedCreatedTime: remotePackageListDate, remoteCheck: FALSE, attach: TRUE
! FS.Error => GOTO cantGetPackageList];
packageListStream ← FS.StreamOpen[packageListLocalName
! FS.Error => GOTO cantOpenPackageList];
[packages, parseError] ← FindPackagesAndDoBringOver[packageListStream, TRUE];
IF parseError THEN GOTO syntaxErrorInPackageList;
FOR packagesList ← packages, packagesList.rest
UNTIL packagesList =
NIL
DO
addCommandsFromFile[packagesList.first];
ENDLOOP;
};
EXITS
cantGetPackageList => {};
cantOpenPackageList => {};
syntaxErrorInPackageList => {};
};
addCommandsFromFile:
PROC [package:
ROPE] = {
packageListStream: IO.STREAM;
packageRemoteCommands: ROPE = Rope.Cat[LocalCommandDir, package, "/", package, ".remoteCommands"];
packageDF: ROPE = Rope.Cat[LocalCommandDir, package, "/", package, ".df"];
version: LIST OF ROPE ← NIL;
ver: ROPE ← NIL;
maintainer: LIST OF ROPE ← NIL;
commands: LIST OF ROPE ← NIL;
commandsList: LIST OF ROPE ← NIL;
exclusive: BOOL ← FALSE;
countActive: INT ← 10000;
packageEntry: PackageEntry;
packageListFile: FS.OpenFile;
{
-- one of those dumb extra blocks to allow the
EXIT clause to see the variables
open the file manually so that we can avoid the remoteCheck
dfCreate: BasicTime.GMT ← BasicTime.nullGMT;
[created: dfCreate] ← FS.FileInfo[name: packageDF ! FS.Error => CONTINUE;];
packageListFile ← FS.Open[name: packageRemoteCommands, remoteCheck: FALSE ! FS.Error => GOTO cantOpen];
packageListStream ← FS.StreamFromOpenFile[openFile: packageListFile
! FS.Error => GOTO cantOpen];
DO
token: ROPE ← NIL;
tokens, tail: LIST OF ROPE ← NIL;
key: ROPE ← NIL;
token ← ComputeUtils.LocalToken[packageListStream, TRUE];
IF (key ← token) = NIL THEN EXIT;
SELECT ComputeUtils.SkipWhite[packageListStream]
FROM
': => [] ← packageListStream.GetChar[]; -- flush the ':
ENDCASE => {
key was NOT followed by ':, so flush to the end of line and report the error
DO
IF packageListStream.GetChar[ ! IO.EndOfStream => EXIT] = '\n THEN EXIT;
ENDLOOP;
ReportInternal[msg: IO.PutFR["missing : at [%d]", IO.int[position]]];
LOOP;
};
DO
list: LIST OF ROPE ← NIL;
token ← ComputeUtils.LocalToken[packageListStream];
IF token = NIL THEN EXIT;
list ← LIST[token];
IF tail =
NIL
THEN {tail ← tokens ← list}
ELSE {tail.rest ← list; tail ← list};
ENDLOOP;
now the key is key, and the list of tokens is in tokens
SELECT
TRUE
FROM
Rope.Equal[key, "version",
FALSE] => {
IF tail =
NIL
THEN {version ← tokens}
ELSE {tail.rest ← version; version ← tokens};
};
Rope.Equal[key, "maintainer",
FALSE] => {
IF tail =
NIL
THEN {maintainer ← tokens}
ELSE {tail.rest ← maintainer; maintainer ← tokens};
};
Rope.Equal[key, "commands",
FALSE] => {
IF tail =
NIL
THEN {commands ← tokens}
ELSE {tail.rest ← commands; commands ← tokens};
};
Rope.Equal[key, "exclusive",
FALSE] => {
IF tail #
NIL
AND tail = tokens
THEN {
SELECT ComputeUtils.trueOrFalse[tail.first]
FROM
true => exclusive ← TRUE;
false => exclusive ← FALSE;
ENDCASE ;
};
};
Rope.Equal[key, "countActive",
FALSE] => {
IF tail #
NIL
AND tail = tokens
THEN {
count : INT;
bad: BOOL ← FALSE;
count ← Convert.IntFromRope[tail.first ! Convert.Error => {bad ← TRUE; CONTINUE}];
IF ~bad AND count > 0 THEN countActive ← count;
};
};
ENDCASE;
ENDLOOP; -- for that DO way back up there
insert commands into tables
IF version # NIL THEN ver ← NARROW[version.first];
packageEntry ← NEW [PackageEntryObject ← [package, dfCreate, commands, maintainer, ver]];
packageEntry.exclusive ← exclusive;
packageEntry.maxCountActive ← countActive;
[] ← SymTab.Store[x: PackageTable, key: package, val: packageEntry];
FOR commandsList ← commands, commandsList.rest
UNTIL commandsList =
NIL
DO
cmd: ROPE = commandsList.first;
cmdEntry: CmdEntry;
cmdEntry ← NEW [CmdEntryObject ← [cmd, package, ver]];
[] ← SymTab.Store[x: CommandTable, key: cmd, val: cmdEntry];
ENDLOOP;
EXITS
cantOpen => {IF packageListFile # NIL THEN FS.Close[packageListFile ! FS.Error => CONTINUE;];};
};
};
Main Processing Routines
AskForService:
PUBLIC
PROC [service:
ROPE, version:
RPC.ShortROPE, clientMachineName:
RPC.ShortROPE, userName:
RPC.ShortROPE]
RETURNS [found:
ATOM ← $foundOK, serverPupAddress: Pup.Address, errMsg: Rope.
ROPE ←
NIL] = {
sockets: PupStream.Sockets ← NIL;
newItem: ActiveServicesItem;
foundInCmdTable: BOOL;
versionEmpty: BOOL;
cmdVal: REF ANY;
cmdEntry: CmdEntry;
valPack: REF ANY;
foundPack: BOOL;
packageEntry: PackageEntry;
package: ROPE ← NIL;
procHandle: ComputeServerInternal.RegisteredProcHandle ← NIL;
IF ~ComputeServerInternal.ServiceEnabled THEN RETURN [$foundButTooBusy, Pup.nullAddress, "Server not up"];
ComputeServerInternal.LastActiveTime ← BasicTime.Now[];
procHandle ← findCommand[service, version];
[found: foundInCmdTable, val: cmdVal] ← SymTab.Fetch[x: CommandTable, key: service];
cmdEntry ← NARROW[cmdVal];
IF cmdEntry # NIL THEN package ← cmdEntry.package;
versionEmpty ← Rope.InlineIsEmpty[version];
IF procHandle =
NIL
OR (versionEmpty
AND foundInCmdTable
AND cmdEntry.firstTime)
THEN {
IF foundInCmdTable
THEN {
IF versionEmpty
OR Rope.Equal[cmdEntry.version, version,
FALSE]
THEN {
tryRun: BOOL ← OKToRunBCDs;
IF ~versionEmpty THEN procHandle ← NIL; -- use old version if there is a problem with the new one (out of GFI's)
IF OKToRunBCDs
THEN {
FOR loopList:
LIST
OF
ROPE ← PackagesNotOKToRun, loopList.rest
UNTIL loopList =
NIL
DO
IF Rope.Equal[loopList.first, package,
FALSE]
THEN {
tryRun ← FALSE;
EXIT;
};
ENDLOOP;
IF tryRun
AND PackagesOKToRun #
NIL
THEN {
tryRun ← FALSE; -- got to find it on the list for it to be OK
FOR loopList:
LIST
OF
ROPE ← PackagesOKToRun, loopList.rest
UNTIL loopList =
NIL
DO
IF Rope.Equal[loopList.first, package,
FALSE]
THEN {
tryRun ← TRUE;
EXIT;
};
ENDLOOP;
};
};
IF tryRun
THEN {
ok: BOOL;
[ok, errMsg] ← loadPackage[package, version];
IF ok THEN procHandle ← findCommand[service, version];
}
ELSE {
IF procHandle =
NIL
THEN {
controllerInterface: ComputeServerControllerRpcControl.InterfaceRecord;
controllerInterface ← ComputeServerInternal.ControllerInterface;
errMsg ← "Command not now running on Server, and running not enabled";
found ← $foundButTooBusy;
serverPupAddress ← Pup.nullAddress;
IF controllerInterface #
NIL
THEN controllerInterface.CommandUnavailable[serverMachineName: ComputeServerInternal.MyNetAddressRope, commandName: service, version: version !
RPC.CallFailed => {
SummonerControllerControl.ControllerCallFailed[why];
ControllerInterface ← NIL ;
CONTINUE;
};
];
RETURN;
};
};
};
}
ELSE errMsg ← "Command not known on Server";
};
IF procHandle =
NIL
THEN {
controllerInterface: ComputeServerControllerRpcControl.InterfaceRecord;
controllerInterface ← ComputeServerInternal.ControllerInterface;
IF errMsg.IsEmpty[] THEN errMsg ← Rope.Cat["Processed summonerLoad file for ", package, " but even then could not find the command ", service, " registered via a call to ComputeServerServer.Register on Server"];
IF foundInCmdTable THEN found ← $foundButTooBusy ELSE found ← $notFound;
serverPupAddress ← Pup.nullAddress;
IF controllerInterface #
NIL
THEN controllerInterface.CommandUnavailable[serverMachineName: ComputeServerInternal.MyNetAddressRope, commandName: service, version: version !
RPC.CallFailed => {
SummonerControllerControl.ControllerCallFailed[why];
ControllerInterface ← NIL ;
CONTINUE;
};
];
RETURN;
};
IF cmdEntry #
NIL
THEN {
cmdEntry.firstTime ← FALSE;
[found: foundPack, val: valPack] ← SymTab.Fetch[x: PackageTable, key: cmdEntry.package];
IF ~foundPack THEN RETURN[$notFound, Pup.nullAddress, "Package missing from Package table on Server"];
packageEntry ← NARROW[valPack, PackageEntry];
IF packageEntry.exclusive AND ActiveServices > 0 THEN RETURN[$foundButTooBusy, Pup.nullAddress, "Cannot get exclusive package access to server"];
IF packageEntry.nowActive >= packageEntry.maxCountActive THEN RETURN[$foundButTooBusy, Pup.nullAddress, "Too many commands running from this package"];
}
ELSE {
cmdEntry ← NEW[CmdEntryObject ← [service: service, package: Rope.Concat["Package for ", service], firstTime: FALSE, doQueueing: TRUE]];
packageEntry ← NEW[PackageEntryObject ← []];
};
sockets ← PupStream.AllocateSocket[Pup.nullAddress];
serverPupAddress ← PupStream.LocalAddress[sockets];
newItem ← AddPupAddress[serverPupAddress, procHandle, sockets];
newItem.clientMachineName ← clientMachineName;
newItem.packageEntry ← packageEntry;
newItem.commandEntry ← cmdEntry;
newItem.userName ← userName;
AddRequest[newItem, service, serverPupAddress, userName];
};
findCommand:
PROC[service:
ROPE, version:
RPC.ShortROPE]
RETURNS [procHandle: ComputeServerInternal.RegisteredProcHandle ←
NIL]= {
found: BOOL;
procRef: REF ANY;
listOfRegisteredProc: LIST OF ComputeServerInternal.RegisteredProcHandle;
[found: found, val: procRef] ← SymTab.Fetch[x: ComputeServerServer.Registry, key: service];
IF found
AND procRef #
NIL
THEN {
loopList: LIST OF ComputeServerInternal.RegisteredProcHandle;
listOfRegisteredProc ← NARROW[procRef];
FOR loopList ← listOfRegisteredProc, loopList.rest
UNTIL loopList =
NIL
DO
IF Rope.InlineIsEmpty[loopList.first.version] OR Rope.Equal[loopList.first.version, version, FALSE] THEN RETURN[loopList.first];
ENDLOOP;
};
};
loadPackage:
PROC [package:
ROPE, version:
ROPE]
RETURNS [ok:
BOOL ←
TRUE, errMsg: Rope.
ROPE ←
NIL] = {
parseStateType: TYPE = {sawName, sawLeft, sawGFI, sawRight, eof};
parseState: parseStateType ← sawRight;
packageLoad: ROPE ← Rope.Cat[LocalCommandDir, package, "/", package, ".summonerLoad"];
valPack: REF ANY;
foundPack: BOOL;
packageEntry: PackageEntry;
packageLoadStream: IO.STREAM;
runList: RunList ← NIL;
bcdName: ROPE ← NIL;
rememberBcdName: ROPE ← NIL;
runListTail: RunList ← NIL;
gfisNeeded: INT ← 0;
runs: RunList ← NIL;
ok: BOOL ← TRUE;
[found: foundPack, val: valPack] ← SymTab.Fetch[x: PackageTable, key: package];
packageEntry ← NARROW[valPack, PackageEntry];
IF ~foundPack OR (~Rope.InlineIsEmpty[version] AND ~Rope.Equal[packageEntry.latestVersion, version, FALSE]) THEN RETURN [FALSE, "package not found, or version requested not newest know to server"];
packageEntry.runVersion ← packageEntry.latestVersion;
packageLoadStream ← FS.StreamOpen[packageLoad ! FS.Error => GOTO fail];
WHILE parseState # eof
DO
token: ROPE ← NIL;
[token: token] ← packageLoadStream.GetTokenRope[IO.TokenProc
! IO.EndOfStream => {parseState ← eof; CONTINUE};];
IF parseState # eof
THEN {
IF token.Equal["-"]
AND packageLoadStream.PeekChar[] = '-
THEN {
[] ← packageLoadStream.GetLineRope[ ! IO.EndOfStream => {parseState ← eof; CONTINUE};];
LOOP;
};
};
SELECT parseState
FROM
sawName, sawRight => {
IF token.Equal["("] THEN { parseState ← sawLeft; LOOP;};
rememberBcdName ← bcdName;
bcdName ← token;
parseState ← sawName;
};
sawLeft => {
gfisNeeded ← Convert.IntFromRope[token ! Convert.Error => CONTINUE ];
parseState ← sawGFI;
LOOP;
};
sawGFI => {
IF token.Equal[")"] THEN { parseState ← sawRight; LOOP;};
parseState ← sawName;
};
eof => rememberBcdName ← bcdName;
ENDCASE;
IF parseState = eof
OR parseState = sawName
THEN {
IF rememberBcdName #
NIL
THEN {
shortName: ROPE = Rope.Substr[rememberBcdName, 0, Rope.Index[s1: rememberBcdName, s2: ".bcd"]];
IF gfisNeeded = 0
THEN {
IF Rope.Equal[shortName, "CompilerServer", FALSE] THEN gfisNeeded ← 109;
IF Rope.Equal[shortName, "TeX", FALSE] THEN gfisNeeded ← 53;
IF Rope.Equal[shortName, "RemoteTSetter", FALSE] THEN gfisNeeded ← 26;
};
IF runListTail = NIL
THEN runList ← runListTail ← CONS[NEW[RunListItem ← [rememberBcdName, gfisNeeded]], NIL]
ELSE runListTail ← (runListTail.rest ← CONS[NEW[RunListItem ← [rememberBcdName, gfisNeeded]], NIL]);
rememberBcdName ← NIL;
gfisNeeded ← 0;
};
};
ENDLOOP;
packageLoadStream.Close[! FS.Error => CONTINUE;];
[ok, errMsg] ← checkRunList[package, runList];
IF ok
THEN {
errMsg ← NIL;
FOR runs ← runList, runs.rest
UNTIL runs =
NIL
OR ~ok
DO
runItem: ROPE = runs.first.package;
noGFIs: INT = runs.first.gfi;
runError: BOOL ← FALSE;
tooManyGFIs: BOOL ← FALSE;
alreadyRun: BOOL;
configEntry: ConfigEntry ← NIL;
itemErrMsg: ROPE ← NIL;
localRunName:
ROPE = Rope.Cat[LocalCommandDir, package, "/", runItem];
do I really have to run it?
[alreadyRun: alreadyRun, tooManyGFIs: tooManyGFIs, msg: itemErrMsg] ← lookAtBcdAndLoadState[package: package, noGFIs: noGFIs, packageDFDate: packageEntry.dfCreate, runItem: runItem, fileName: localRunName];
If so, then run it with "runEvenIfAlreadyRun" as TRUE since we know it has to be run
IF tooManyGFIs
THEN {
errMsg ← Rope.Concat[errMsg, "Package needed too many GFIs.\n"];
ok ← FALSE;
EXIT;
};
IF ~alreadyRun
AND itemErrMsg =
NIL
THEN {
innerRun:
PROC [] = {
[errMsg: itemErrMsg, error: runError] ← CommandTool.Run[bcdName: localRunName, runEvenIfAlreadyRun: FALSE, runEvenIfUnbound: TRUE];
};
newPropertys: List.AList ← NIL;
newPropertys ← List.PutAssoc[key: $WorkingDirectory , val: Rope.Cat[LocalCommandDir, package, "/"], aList: NIL];
ProcessProps.AddPropList[propList: newPropertys, inner: innerRun];
IF runError
THEN { -- ignore Unbound imports errors
IF Rope.Find[itemErrMsg, "Unbound imports {"] > 0
THEN {
runError ← FALSE;
errMsg ← Rope.Cat[errMsg, runItem," Got an unbound error: ", itemErrMsg, "\n"];
};
};
IF ~alreadyRun AND errMsg = NIL THEN [errMsg: errMsg, error: runError] ← CommandTool.Run[bcdName: localRunName, runEvenIfAlreadyRun: TRUE, runEvenIfUnbound: FALSE];
This does not do the "Run" in the sub-directory, so LFBoundingBox blows up
};
IF runError
THEN
{
errMsg ← Rope.Cat[Rope.Cat[errMsg, "Got the following error trying to run ", runItem,": ", Rope.Cat[itemErrMsg, "\n"]]];
ok ← FALSE;
EXIT;
};
configEntry ← NEW [ConfigEntryObject ← [package, packageEntry.dfCreate, packageEntry.maintainer]];
[] ← SymTab.Store[x: ConfigTable, key: runItem, val: configEntry];
ENDLOOP;
};
};
checkRunList:
PROC [package:
ROPE, runList: RunList]
RETURNS [ok:
BOOL ←
TRUE, errMsg:
ROPE] = {
loopList: RunList;
FOR loopList ← runList, loopList.rest
UNTIL loopList =
NIL
OR ~ok
OR errMsg #
NIL
DO
runItem: ROPE = loopList.first.package;
shortBcdName: ROPE ← Rope.Concat[runItem.Substr[0, runItem.Index[s2: "."]] ,".bcd"];
bcdName: ROPE ← Rope.Cat[LocalCommandDir, package, "/", shortBcdName];
fullFName: ROPE;
desiredTime: BasicTime.GMT ← BasicTime.nullGMT ;
serverTime: BasicTime.GMT ← BasicTime.nullGMT ;
runOK: BOOL ← FALSE;
differentInStd: BOOL ← FALSE;
[fullFName: fullFName, created: desiredTime] ← FS.FileInfo[name: bcdName, remoteCheck: FALSE ! FS.Error => CONTINUE];
IF desiredTime = BasicTime.nullGMT
THEN {
ok ← FALSE;
errMsg ← Rope.Cat["BCD for ", runItem, " in ", package, " not in the df file."];
EXIT;
};
[created: serverTime] ← FS.FileInfo[name: fullFName, wantedCreatedTime: desiredTime, remoteCheck: TRUE ! FS.Error => CONTINUE];
IF serverTime = BasicTime.nullGMT
THEN {
ok ← FALSE;
errMsg ← Rope.Cat["No BCD for ", runItem, " in ", package, " not on the server."];
EXIT;
};
IF serverTime # desiredTime
THEN {
ok ← FALSE;
errMsg ← Rope.Cat["Wrong date for BCD for ", runItem, " in ", package, " missing on the server."];
EXIT;
};
ENDLOOP;
};
lookAtBcdAndLoadState:
PROC[package:
ROPE, noGFIs:
INT, packageDFDate: BasicTime.
GMT, runItem:
ROPE, fileName:
ROPE]
RETURNS [alreadyRun:
BOOL ←
FALSE, tooManyGFIs:
BOOL ←
FALSE, msg:
ROPE ←
NIL] = {
code stolen from Watch
countGFI:
PROC
RETURNS [free:
NAT] =
TRUSTED {
This procedure counts the free GFIs via a linear scan of the table.
free ← 0;
FOR i:
CARDINAL
DECREASING
IN [1..PrincOps.
SD[PrincOps.sGFTLength])
DO
item: PrincOps.GFTItem = PrincOps.GFT[i];
IF item.data = 0 THEN free ← free + 1;
ENDLOOP;
};
file: FS.OpenFile ← FS.nullOpenFile;
length: INT;
gfiFree: NAT;
gfiFree ← countGFI[];
IF (noGFIs + TryForFreeGFIs) > gfiFree THEN {tooManyGFIs ← TRUE; RETURN};
length ← Rope.Length[fileName];
IF length < 5 OR (Rope.Compare[Rope.Substr[fileName, length - 4, 4], ".bcd", FALSE] # equal AND Rope.Find[fileName, "!", MAX[0, length-6]] = -1) THEN fileName ← Rope.Concat[fileName, ".bcd"];
file ←
FS.Open[fileName !
FS.Error => {
msg ← error.explanation;
GOTO cantOpenBCD;
}
];
TRUSTED {
LoadState.local.Acquire[];
{
ENABLE UNWIND => LoadState.local.Release[];
BcdVersion:
SAFE
PROC[file:
FS.OpenFile]
RETURNS [version: BcdDefs.VersionStamp ← BcdDefs.NullVersion] = TRUSTED {
bcdSpace: VM.Interval = VM.Allocate[count: 1];
bcd: BcdDefs.BcdBase ← LOOPHOLE[VM.AddressForPageNumber[bcdSpace.page]];
FS.Read[file: file, from: 0, nPages: 1, to: LOOPHOLE[bcd]];
IF bcd.versionIdent = BcdDefs.VersionID
AND
NOT bcd.definitions
AND bcd.spare1
THEN version ← bcd.version; -- else error, which will be reported later
VM.Free[bcdSpace];
};
lookAtConfig:
SAFE
PROC [config: LoadState.ConfigID]
RETURNS [stop:
BOOL ←
FALSE] =
TRUSTED {
IF bcdVersion = LoadState.local.ConfigInfo[config].bcd.version THEN RETURN[TRUE];
};
bcdVersion: BcdDefs.VersionStamp = BcdVersion[file];
IF bcdVersion # BcdDefs.NullVersion
AND LoadState.local.EnumerateConfigs[newestFirst, lookAtConfig]
# LoadState.nullConfig
THEN alreadyRun ← TRUE;
}; -- end ENABLE UNWIND => LoadState.local.Release[];
LoadState.local.Release[];
IF ~alreadyRun
THEN {
context: AMModel.Context;
contextNames: LIST OF ROPE ← NIL;
enumContextChildren:
PROC[c: AMModel.Context]
RETURNS[stop:
BOOL ←
FALSE] =
TRUSTED {
contextName: ROPE = AMModel.ContextName[c];
contextNames ← CONS[contextName, contextNames];
IF Rope.Equal[contextName.Substr[0, contextName.Index[0, ":"]], runItem,
FALSE]
THEN {
sendGVMailAboutDupPackage[package, packageDFDate, runItem];
stop ← TRUE;
};
};
context ← AMModel.ContextChildren[AMModel.RootContext[WorldVM.LocalWorld[]], enumContextChildren];
contextNames ← NIL;
};
};
};
sendGVMailAboutDupPackage:
PROC [package:
ROPE, packageDFDate: BasicTime.
GMT, runItem:
ROPE] = {
foundConfig: BOOL;
valConfig: REF ANY;
[found: foundConfig, val: valConfig] ← SymTab.Fetch[x: ConfigTable, key: runItem];
IF foundConfig
THEN {
foundPack: BOOL;
valPack: REF ANY;
packageEntry: PackageEntry;
configEntry: ConfigEntry ← NARROW[valConfig];
[found: foundPack, val: valPack] ← SymTab.Fetch[x: PackageTable, key: configEntry.package];
IF ~foundPack THEN sendGVMailAboutBug[Rope.Concat["missing package table entry for ", package]]
ELSE {
packageEntry.maintainer is a LIST OF ROPE of the maintainters of the existing package, and configEntry.maintainer for package to be run
FOR try:
INT
IN [0..3)
DO
gvHandle: GVSend.Handle;
startSend: GVSend.StartSendInfo;
name, password: Rope.ROPE;
toRope: Rope.ROPE ← NIL;
recipients: INT ← 0;
packageEntry ← NARROW[valPack, PackageEntry];
gvHandle ← GVSend.Create[];
[name: name, password: password] ← UserCredentials.Get[];
startSend ← gvHandle.StartSend[senderPwd: password, sender: name, validate: TRUE ];
IF startSend = ok
THEN {
ENABLE GVSend.SendFailed => {
gvHandle.Abort[];
LOOP;
};
FOR toList:
LIST
OF
ROPE ← packageEntry.maintainer, toList.rest
WHILE toList #
NIL
DO
gvHandle.AddRecipient[toList.first];
IF toRope = NIL THEN toRope ← toList.first
ELSE toRope ← Rope.Cat[toRope, ", ", toList.first];
ENDLOOP;
FOR toList:
LIST
OF
ROPE ← configEntry.maintainer, toList.rest
WHILE toList #
NIL
DO
gvHandle.AddRecipient[toList.first];
IF toRope = NIL THEN toRope ← toList.first
ELSE toRope ← Rope.Cat[toRope, ", ", toList.first];
ENDLOOP;
recipients ← gvHandle.CheckValidity[notify: NIL];
IF recipients > 0
THEN {
rope0, rope1, rope1a, rope2, rope3, rope4: ROPE ← NIL;
gvHandle.StartItem[Text];
rope0 ← Rope.Cat["Date: ", Convert.RopeFromTime[from: BasicTime.Now[], start:years, end: seconds, includeDayOfWeek: TRUE, useAMPM: TRUE, includeZone: TRUE],"\n"];
rope1 ← Rope.Cat["From: ", ComputeServerInternal.myHostName, " Compute Server\nSubject: Multiple versions on ", ComputeServerInternal.myHostName, "\n"];
rope1a ← Rope.Cat["To: ", toRope, "\n\n"];
rope2 ← Rope.Cat["Compute Server had different versions of ", runItem, " run\n"];
rope3 ← Rope.Cat[" First package loaded was ", configEntry.package, " with df file date of ", Convert.RopeFromTime[from: configEntry.dfCreate, start:years, end: seconds, includeDayOfWeek: FALSE, useAMPM: TRUE, includeZone: TRUE], "\n"];
rope4 ← Rope.Cat[" Second package is ", package, " with df file date of ", Convert.RopeFromTime[from: packageDFDate, start: years, end: seconds, includeDayOfWeek: FALSE, useAMPM: TRUE, includeZone: TRUE], "\n"];
gvHandle.AddToItem[Rope.Cat[Rope.Cat[rope0, rope1, rope1a], rope2, rope3, rope4]];
gvHandle.StartItem[LastItem];
gvHandle.Send[];
EXIT;
}
ELSE {
gvHandle.Abort[];
EXIT;
};
};
ENDLOOP;
};
}
ELSE sendGVMailAboutBug[Rope.Concat["missing config table entry for ", package]];
};
sendGVMailAboutBug:
PROC [msg:
ROPE] = {
};
checkActives:
ENTRY
PROC[matchedItem: ActiveServicesItem]
RETURNS [ok:
BOOL ] = {
IF matchedItem.packageEntry.exclusive AND ActiveServices > 0 THEN RETURN [FALSE];
IF matchedItem.packageEntry.nowActive >= matchedItem.packageEntry.maxCountActive THEN RETURN [FALSE];
matchedItem.packageEntry.nowActive ← matchedItem.packageEntry.nowActive + 1;
ActiveServices ← ActiveServices + 1;
RETURN [TRUE];
};
inActive:
ENTRY
PROC[matchedItem: ActiveServicesItem] = {
matchedItem.packageEntry.nowActive ← matchedItem.packageEntry.nowActive - 1;
ActiveServices ← ActiveServices - 1;
};
DoService:
PUBLIC
PROC [serverPupAddress: Pup.Address, clientNetAddressRope:
RPC.ShortROPE, commandLine:
ROPE, WorkingDirectory: Rope.
ROPE, needRemoteInStream:
BOOL, needRemoteOutStream:
BOOL]
RETURNS [success: ComputeServerClient.RemoteSuccess ← true, msg:
ROPE ←
NIL] = {
matchedItem: ActiveServicesItem ;
interface: ComputeServerCallbacksRpcControl.InterfaceRecord ;
lastLoop: BOOL ← FALSE;
ok: BOOL;
in, out, err: STREAM ← NIL;
inData, outData: BufStreamData ;
serviceProcess: PROCESS;
matchOK, deleteOK: BOOL ← FALSE;
IF ~ComputeServerInternal.ServiceEnabled THEN RETURN [false, "Server is down"];
[found: matchOK, item: matchedItem] ← MatchPupAddress[serverPupAddress, TRUE];
IF ~matchOK THEN RETURN [false, "DoService call not matched by AskForService"];
ok ← checkActives[matchedItem];
IF ~ok THEN RETURN [serverTooBusy, "Server now to busy"];
ReportServerEvent[type: startService, command: matchedItem.commandEntry.service, startTime: matchedItem.startListenGMT, endTime: BasicTime.nullGMT, remoteMachineName: matchedItem.clientMachineName, userName: matchedItem.userName];
matchedItem.commandEntry.okToQueuePosted ← FALSE;
IF matchedItem.commandEntry.doQueueing
AND ~matchedItem.packageEntry.exclusive
AND matchedItem.packageEntry.nowActive < matchedItem.packageEntry.maxCountActive
THEN {
controllerInterface: ComputeServerControllerRpcControl.InterfaceRecord;
controllerInterface ← ComputeServerInternal.ControllerInterface;
IF controllerInterface #
NIL
THEN {
controllerInterface.MightAcceptQueuedCommand[serverMachineAddress: ComputeServerInternal.MyNetAddressRope, commandName: matchedItem.commandEntry.service ! RPC.CallFailed => CONTINUE;];
matchedItem.commandEntry.okToQueuePosted ← TRUE;
};
};
IF needRemoteInStream
OR needRemoteOutStream
THEN {
matchedItem.remoteStream ← PupStream.WaitForRendezvous[sockets: matchedItem.sockets, getTimeout: 1000, putTimeout: PupStream.waitForever, waitTimeout: PupStream.waitForever ! PupStream.StreamClosing => {
ok ← FALSE;
msg ← Rope.Concat["Failed to make a remote stream because ", text];
CONTINUE;
};
];
};
IF ~ok THEN RETURN [communicationFailure, msg];
IF needRemoteInStream
THEN {
in ← IO.CreateStream[streamProcs: ComputeServerInternal.inStreamProcs,
streamData: inData ← NEW[BufStreamDataObject ← [listenerItem: matchedItem]]];
}
ELSE {
in ← IO.noInputStream;
matchedItem.inEOF ← TRUE;
};
IF needRemoteOutStream
THEN {
out ← IO.CreateStream[streamProcs: ComputeServerInternal.outStreamProcs,
streamData: outData ← NEW[BufStreamDataObject ← [listenerItem: matchedItem]]];
}
ELSE {
out ← IO.noWhereStream;
matchedItem.outEOF ← true;
};
interface ← GetClientInterfaceFromCache[clientNetAddressRope];
interface ← ComputeServerCallbacksRpcControl.ImportNewInterface[
interfaceName: [ instance: clientNetAddressRope]
! RPC.ImportFailed => {
CONTINUE;
};
];
IF interface = NIL THEN {inActive[matchedItem]; RETURN[false, "Cannot import Client Callbacks"]};
matchedItem.callbacksInterface ← interface;
matchedItem.clientNetAddressRope ← clientNetAddressRope;
BumpRequests[];
serviceProcess ← FORK ServiceProcess[in, out, err, commandLine, matchedItem, WorkingDirectory];
WHILE ~matchedItem.inEOF
OR matchedItem.outEOF ~= true
OR ~matchedItem.callOver
DO
doneSomething: BOOL ← FALSE;
IF matchedItem.pleaseAbort
THEN
TRUSTED {
Process.Abort[serviceProcess];
matchedItem.pleaseAbort ← FALSE;
};
copy from the internal stream to the remote stream
IF matchedItem.outEOF ~= true
AND ComputeServerInternal.inCharsAvail[out,
FALSE] > 0
THEN {
DO
IF acquireOutStream[matchedItem] THEN EXIT;
Process.Pause[1];
ENDLOOP;
WHILE ComputeServerInternal.inCharsAvail[out,
FALSE] > 0
AND matchedItem.outEOF = false
DO
matchedItem.remoteStream.PutChar[ComputeServerInternal.inBufGetChar[out !
IO.EndOfStream => {matchedItem.outEOF ← pending;
CONTINUE;}] ! PupStream.StreamClosing => {
matchedItem.pleaseAbort ← TRUE;
matchedItem.outEOF ← true;
matchedItem.inEOF ← TRUE;
matchedItem.success ← communicationFailure;
CONTINUE;
};
];
ENDLOOP;
matchedItem.remoteStream.Flush[! PupStream.StreamClosing => {
matchedItem.pleaseAbort ← TRUE;
matchedItem.outEOF ← true;
matchedItem.inEOF ← TRUE;
matchedItem.success ← communicationFailure;
CONTINUE;
};
];
IF matchedItem.outEOF = pending
THEN {
PupStream.SendMark[matchedItem.remoteStream, 27B ! PupStream.StreamClosing => {CONTINUE;};];
matchedItem.outEOF ← true;
};
doneSomething ← TRUE;
freeOutStream[matchedItem];
};
copy from the remote stream to the internal stream
IF matchedItem.flushCounter > 0
THEN {
matchedItem.flushCounter ← matchedItem.flushCounter - 1;
IF matchedItem.flushCounter <= 0
THEN {
DO
IF acquireOutStream[matchedItem] THEN EXIT;
Process.Pause[1];
ENDLOOP;
matchedItem.remoteStream.Flush[! PupStream.StreamClosing => {
matchedItem.pleaseAbort ← TRUE;
matchedItem.outEOF ← true;
matchedItem.inEOF ← TRUE;
matchedItem.success ← communicationFailure;
CONTINUE;
};
];
IF matchedItem.outEOF = pending
THEN {
PupStream.SendMark[matchedItem.remoteStream, 27B ! PupStream.StreamClosing => {CONTINUE;};];
matchedItem.outEOF ← true;
};
doneSomething ← TRUE;
freeOutStream[matchedItem];
};
};
WHILE ~matchedItem.inEOF
AND matchedItem.remoteStream.CharsAvail[] > 0
AND (inData.inPointer - (inData.outPointer + 1))
MOD ComputeServerInternal.BufStreamBufferSize # 0
DO
doneSomething ← TRUE;
ComputeServerInternal.outBufPutChar[in, matchedItem.remoteStream.GetChar[!
IO.EndOfStream => {
inData.EOF ← pending;
matchedItem.inEOF ← TRUE;
CONTINUE;};
PupStream.StreamClosing => {
matchedItem.pleaseAbort ← TRUE;
matchedItem.outEOF ← true;
matchedItem.inEOF ← TRUE;
matchedItem.success ← communicationFailure;
CONTINUE;
};
]];
ENDLOOP;
IF lastLoop THEN EXIT;
IF matchedItem.callOver THEN { lastLoop ← TRUE; LOOP;};
IF ~doneSomething THEN Process.Pause[3];
ENDLOOP;
IF matchedItem.remoteStream # NIL THEN matchedItem.remoteStream.Close[TRUE ! IO.Error => CONTINUE;] ;
msg ← matchedItem.msg;
success ← matchedItem.success;
ReportServerEvent[type: doneService, command: matchedItem.commandEntry.service, startTime: matchedItem.startListenGMT, endTime: BasicTime.Now[], remoteMachineName: matchedItem.clientMachineName, userName: matchedItem.userName];
inActive[matchedItem];
ComputeServerInternal.LastActiveTime ← BasicTime.Now[];
deleteOK ← DeletePupAddress[serverPupAddress];
TRUSTED {JOIN serviceProcess;};
IF matchedItem.commandEntry.doQueueing
AND
matchedItem.packageEntry.nowActive < matchedItem.packageEntry.maxCountActive
AND ~matchedItem.commandEntry.okToQueuePosted
THEN {
controllerInterface: ComputeServerControllerRpcControl.InterfaceRecord;
controllerInterface ← ComputeServerInternal.ControllerInterface;
IF controllerInterface #
NIL
THEN {
controllerInterface.MightAcceptQueuedCommand[serverMachineAddress: ComputeServerInternal.MyNetAddressRope, commandName: matchedItem.commandEntry.service ! RPC.CallFailed => CONTINUE;];
matchedItem.commandEntry.okToQueuePosted ← TRUE;
};
};
};
ServiceProcess:
PROC [in, out, err:
STREAM, commandLine:
ROPE, matchedItem: ActiveServicesItem, WorkingDirectory:
ROPE] = {
newPropertys: List.AList ← NIL;
ServiceProcessInner:
PROC [] = {
ENABLE {
UNWIND => {};
FS.Error => {
IF ~((error.group = environment) AND (error.code = $serverInaccessible OR error.code = $serverUnmatchedComputation)) THEN REJECT;
matchedItem.success ← communicationFailure;
GOTO clientInaccessible;
};
RPC.CallFailed => {
matchedItem.success ← communicationFailure;
GOTO clientInaccessible;
};
RuntimeError.UNCAUGHT => {
MyCatcher[msg: parameters, signal: signal, frame: PrincOps.MyLocalFrame[]];
};
ABORTED => {
process: PROCESS = LOOPHOLE[Process.GetCurrent[]];
ComputeServerInternal.RemoveMarkProcessNotGuest[process];
GOTO aborted;
};
};
startPriority: CedarProcess.Priority ← normal;
result: REF ← NIL;
msg: Rope.ROPE ← NIL;
cmd: Commander.Handle;
cmd ← NEW[Commander.CommandObject ← [in, out, err, commandLine, matchedItem.procHandle.service, ProcessProps.GetPropList[], matchedItem.procHandle.commanderProcHandle]];
startPriority ← CedarProcess.GetPriority[];
CedarProcess.SetPriority[background];
[msg: matchedItem.msg] ← matchedItem.procHandle.commanderProcHandle.proc[cmd];
CedarProcess.SetPriority[startPriority];
in.Close[];
out.Close[];
EXITS
aborted => {
in.Close[];
out.Close[];
IF matchedItem.success # communicationFailure
THEN {
matchedItem.msg ← "call ABORTED";
matchedItem.success ← aborted;
};
};
clientInaccessible => {
in.Close[];
out.Close[];
matchedItem.msg ← "call ABORTED due to client becomming inaccessible";
matchedItem.success ← communicationFailure;
};
};
IF Rope.Length[WorkingDirectory] > 0 THEN newPropertys ← List.PutAssoc[key: $WorkingDirectory , val: WorkingDirectory, aList: NIL];
[] ← ComputeServerInternal.MarkGuestProcess[LOOPHOLE[Process.GetCurrent[]], LOOPHOLE[matchedItem]];
ProcessProps.AddPropList[propList: newPropertys, inner: ServiceProcessInner];
[] ← ComputeServerInternal.MarkGuestProcess[LOOPHOLE[Process.GetCurrent[]], NIL];
matchedItem.callOver ← TRUE;
};
AskForAbort:
PUBLIC
PROC [serverPupAddress: Pup.Address] = {
matchOK: BOOL ← FALSE;
matchedItem: ActiveServicesItem ;
[found: matchOK, item: matchedItem] ← MatchPupAddress[serverPupAddress, TRUE];
IF matchOK THEN matchedItem.pleaseAbort ← TRUE;
};
GenericClientToServer:
PUBLIC PROC [requestCode:
ATOM, requestString: Rope
.ROPE]
RETURNS [resultCode:
ATOM, resultString: Rope
.ROPE] = {
generic call to allow for expansion without RPC interface recompilation
RETURN [$notImplemented, NIL];
};
GetClientInterfaceFromCache:
PUBLIC
ENTRY
PROC [clientInstance:
RPC.ShortROPE, forceNewInterface:
BOOL ←
FALSE]
RETURNS [clientInterface: ComputeServerCallbacksRpcControl.InterfaceRecord ←
NIL] = {
newClientInterface: ComputeServerCallbacksRpcControl.InterfaceRecord ← NIL;
bestIndex: INT ← 0;
bestTime: BasicTime.GMT ← BasicTime.latestGMT;
now: BasicTime.GMT ← BasicTime.Now[];
FOR index:
INT
IN [0..clientInterfaceCacheSize)
DO
IF Rope.Equal[clientInstance, clientInterfaceCache[index].clientInstance]
THEN {
IF forceNewInterface
THEN {
clientInterfaceCache[index].lastUsed ← BasicTime.earliestGMT;
clientInterfaceCache[index].clientInstance ← NIL;
clientInterfaceCache[index].interface ← NIL;
bestIndex ← index;
}
ELSE {
clientInterfaceCache[index].lastUsed ← now;
RETURN[clientInterfaceCache[index].interface];
};
};
IF BasicTime.Period[bestTime, clientInterfaceCache[index].lastUsed] < 0
THEN {
bestTime ← clientInterfaceCache[index].lastUsed;
bestIndex ← index;
};
ENDLOOP;
newClientInterface ← ComputeServerCallbacksRpcControl.ImportNewInterface[
interfaceName: [ type: "ComputeServerCallbacks.summoner", instance: clientInstance, version: [1,1]]
!
RPC.ImportFailed => {
CONTINUE;
};
];
IF newClientInterface #
NIL
THEN {
clientInterfaceCache[bestIndex].lastUsed ← now;
clientInterfaceCache[bestIndex].clientInstance ← clientInstance;
clientInterfaceCache[bestIndex].interface ← newClientInterface;
};
RETURN[newClientInterface];
};
DeleteClientInterfaceFromCache:
PUBLIC
ENTRY
PROC [clientInterface: ComputeServerCallbacksRpcControl.InterfaceRecord]
RETURNS [gotIt:
BOOL ←
FALSE] = {
IF clientInterface = NIL THEN RETURN[FALSE];
FOR index:
INT
IN [0..clientInterfaceCacheSize)
DO
IF clientInterfaceCache[index].interface = clientInterface
THEN {
clientInterfaceCache[index].clientInstance ← NIL;
clientInterfaceCache[index].interface ← NIL;
clientInterfaceCache[index].lastUsed ← BasicTime.earliestGMT;
gotIt ← TRUE;
EXIT;
};
ENDLOOP;
};
Active Services List Maintence
AddPupAddress:
PUBLIC
ENTRY
PROC [serverPupAddress: Pup.Address, procHandle: ComputeServerInternal.RegisteredProcHandle, sockets: PupStream.Sockets]
RETURNS [newItem: ActiveServicesItem] = {
newItem ← NEW[ActiveServicesItemObject ← [next: ActiveServicesListBase, listenerPupAddress: serverPupAddress, sockets: sockets, startListenGMT: BasicTime.Now[], procHandle: procHandle, success: true]];
ActiveServicesListBase ← newItem;
};
AddRequest:
PUBLIC
ENTRY
PROC [item: ActiveServicesItem, service:
ROPE, serverPupAddress: Pup.Address, userName:
ROPE] = {
CurrentRequests ← CONS[[service, serverPupAddress, userName], CurrentRequests];
item.request ← CurrentRequests;
};
MatchPupAddress:
PUBLIC
ENTRY
PROC [serverPupAddress: Pup.Address, flagStarted:
BOOL]
RETURNS [found:
BOOL, item: ActiveServicesItem] = {
nowItem: ActiveServicesItem ← ActiveServicesListBase ;
WHILE nowItem #
NIL
DO
IF serverPupAddress = nowItem.listenerPupAddress
THEN
{
IF flagStarted THEN nowItem.heardDoService ← TRUE;
RETURN [TRUE, nowItem];
};
nowItem ← nowItem.next;
ENDLOOP;
RETURN[FALSE, NIL];
};
findDebuggerItemFromInterpreterHandle:
PUBLIC
ENTRY
PROC [h: InterpreterToolPrivate.Handle]
RETURNS [found:
BOOL, item: ActiveServicesItem ←
NIL] = {
nowItem: ActiveServicesItem ← ActiveServicesListBase ;
WHILE nowItem #
NIL
DO
IF h = nowItem.h THEN RETURN [TRUE, nowItem];
nowItem ← nowItem.next;
ENDLOOP;
RETURN[FALSE, NIL];
};
KillOldUnstartedServices:
PUBLIC
PROC
= {
findAnOldService:
ENTRY
PROC = {
nowItem: ActiveServicesItem ← ActiveServicesListBase ;
now: BasicTime.GMT ← BasicTime.Now[];
WHILE nowItem #
NIL
DO
IF ~nowItem.heardDoService
AND BasicTime.Period[nowItem.startListenGMT, now] > 77
THEN {
nowItem.sockets ← NIL;
oldServerPupAddress ← nowItem.listenerPupAddress;
RETURN;
};
nowItem ← nowItem.next;
ENDLOOP;
};
oldServerPupAddress: Pup.Address;
DO
oldServerPupAddress ← Pup.nullAddress;
findAnOldService[];
IF oldServerPupAddress = Pup.nullAddress THEN EXIT;
IF ~DeletePupAddress[oldServerPupAddress] THEN EXIT;
ENDLOOP;
};
DeletePupAddress:
PUBLIC
ENTRY
PROC [serverPupAddress: Pup.Address]
RETURNS [found:
BOOL] = {
nowItem: ActiveServicesItem ← ActiveServicesListBase ;
lastItem: ActiveServicesItem ← NIL;
WHILE nowItem #
NIL
DO
IF serverPupAddress = nowItem.listenerPupAddress
THEN {
IF lastItem = NIL THEN ActiveServicesListBase ← nowItem.next
ELSE lastItem.next ← nowItem.next;
IF nowItem.request #
NIL
THEN {
request: LIST OF ComputeServer.Request ← nowItem.request;
IF CurrentRequests = request THEN CurrentRequests ← request.rest
ELSE {
FOR cr:
LIST
OF ComputeServer.Request ← CurrentRequests, cr.rest
UNTIL cr =
NIL
DO
IF cr.rest = request
THEN {
cr.rest ← cr.rest.rest;
EXIT;
};
ENDLOOP;
};
};
RETURN[TRUE];
};
lastItem ← nowItem;
nowItem ← nowItem.next;
ENDLOOP;
RETURN[FALSE];
};