> 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]; <> [alreadyRun: alreadyRun, tooManyGFIs: tooManyGFIs, msg: itemErrMsg] _ lookAtBcdAndLoadState[package: package, noGFIs: noGFIs, packageDFDate: packageEntry.dfCreate, runItem: runItem, fileName: localRunName]; <> 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 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; }; EXITS fail => {}; }; 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] = { <> countGFI: PROC RETURNS [free: NAT] = TRUSTED { <> 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; }; }; EXITS cantOpenBCD => {}; }; 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 { <> 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]; <> <> << ! RPC.ImportFailed => {>> <> <<};>> <<];>> 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; }; <> 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]; }; <> 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; }; < {>> <> <<};>> 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; }; <> Register: PUBLIC PROC [key: ROPE, version: ROPE _ NIL, proc: Commander.CommandProc, doc: ROPE _ NIL, clientData: REF ANY _ NIL] = { found: BOOL; val: REF ANY; foundCmdTab: BOOL; tempControllerInterface: ComputeServerControllerRpcControl.InterfaceRecord _ NIL; IF key.IsEmpty[] THEN RETURN; IF proc = NIL THEN [] _ SymTab.Delete[x: ComputeServerServer.Registry, key: key] ELSE { regList: LIST OF ComputeServerInternal.RegisteredProcHandle; regProc: ComputeServerInternal.RegisteredProcHandle _ NEW[ComputeServerInternal.RegisteredProcObject _ [version: version, service: key, commanderProcHandle: NEW[Commander.CommandProcObject _ [proc: proc, doc: doc, clientData: clientData]]]]; [found: found, val: val] _ SymTab.Fetch[x: ComputeServerServer.Registry, key: key]; regList _ NARROW[val]; regList _ CONS[regProc, regList]; [] _ SymTab.Store[ x: ComputeServerServer.Registry, key: key, val: regList ]; [found: foundCmdTab] _ SymTab.Fetch[x: CommandTable, key: key]; IF ~foundCmdTab AND (tempControllerInterface _ ControllerInterface) # NIL THEN { tempControllerInterface.ExtraCommandAvailable[serverMachineName: ComputeServerInternal.MyNetAddressRope, commandName: key, version: version ! RPC.CallFailed => { SummonerControllerControl.ControllerCallFailed[why]; ControllerInterface _ NIL ; CONTINUE; }; ]; }; }; }; <> <> inBufGetChar: PUBLIC PROC [self: STREAM] RETURNS [ch: CHAR] = { data: BufStreamData = NARROW[self.streamData]; DO IF data.EOF = true THEN ERROR IO.EndOfStream[self]; IF data.EOF = pending AND data.inPointer = data.outPointer THEN { data.EOF _ true; ERROR IO.EndOfStream[self]; }; IF data.backUpChars # NIL THEN { ch _ data.backUpChars.first; data.backUpChars _ data.backUpChars.rest; RETURN; }; IF data.inPointer # data.outPointer THEN { ch _ data.buffer[LOOPHOLE[Basics.DoubleAnd[LOOPHOLE[data.inPointer], LOOPHOLE[ComputeServerInternal.BufStreamBufferSizeMask]], INT]]; data.inPointer _ data.inPointer + 1; RETURN; } ELSE IF data.listenerItem.success = communicationFailure THEN { Process.CheckForAbort[]; ERROR IO.Error[ec: Failure, stream: self]; }; Process.Pause[5]; ENDLOOP; }; inBackup: PROC [self: STREAM, char: CHAR] = { data: BufStreamData = NARROW[self.streamData]; data.backUpChars _ CONS[char, data.backUpChars]; }; inBufEndOf: PROC [self: STREAM] RETURNS [BOOL] = { data: BufStreamData = NARROW[self.streamData]; WHILE data.EOF = false AND data.inPointer = data.outPointer DO Process.Pause[5]; ENDLOOP; IF data.EOF = true OR data.inPointer = data.outPointer THEN RETURN[TRUE] ELSE RETURN[FALSE]; }; inCharsAvail: PUBLIC PROC [self: STREAM, wait: BOOL] RETURNS [INT] = { data: BufStreamData = NARROW[self.streamData]; RETURN[(IF data.EOF # false THEN 1 ELSE 0) + data.outPointer - data.inPointer]; }; inBufGetIndex: PROC [self: STREAM] RETURNS [INT] = { data: BufStreamData = NARROW[self.streamData]; RETURN[data.inPointer]; }; inBufClose: PROC [self: STREAM, abort: BOOL] = { data: BufStreamData = NARROW[self.streamData]; data.EOF _ true; }; <

> acquireOutStream: ENTRY PROC [asi: ActiveServicesItem] RETURNS [gotIt: BOOL] = { IF asi.outStreamBusy THEN RETURN [FALSE] ELSE { asi.outStreamBusy _ TRUE; RETURN [TRUE]; }; }; freeOutStream: ENTRY PROC [asi: ActiveServicesItem] = { asi.outStreamBusy _ FALSE; }; outBufPutChar: PUBLIC PROC [self: STREAM, char: CHAR] = { data: BufStreamData = NARROW[self.streamData]; WHILE (data.inPointer - (data.outPointer + 1)) MOD ComputeServerInternal.BufStreamBufferSize = 0 DO IF data.listenerItem.success = communicationFailure THEN RETURN; -- ignore output once communications fails Process.Pause[2]; ENDLOOP; data.buffer[LOOPHOLE[Basics.DoubleAnd[LOOPHOLE[data.outPointer], LOOPHOLE[ComputeServerInternal.BufStreamBufferSizeMask]], INT]] _ char; data.outPointer _ data.outPointer + 1; }; outBufUnsafePutBlock: PUBLIC PROC [self: STREAM, block: IO.UnsafeBlock] = { data: BufStreamData = NARROW[self.streamData]; doPutChars: BOOL _ TRUE; IF data.inPointer = data.outPointer THEN { asi: ActiveServicesItem = data.listenerItem; stream: IO.STREAM = asi.remoteStream; buffer: REF TEXT; DO IF acquireOutStream[asi] THEN EXIT; Process.Pause[1]; ENDLOOP; doPutChars _ FALSE; <> buffer _ RefText.ObtainScratch[block.count]; TRUSTED { [] _ PrincOpsUtils.ByteBlt[ to: [blockPointer: LOOPHOLE[buffer, LONG POINTER]+TEXT[0].SIZE, startIndex: 0, stopIndexPlusOne: block.count], from: [blockPointer: block.base, startIndex: block.startIndex, stopIndexPlusOne: block.startIndex + block.count]]; }; buffer.length _ block.count; stream.PutBlock[buffer, 0 , block.count ! PupStream.StreamClosing => { doPutChars _ TRUE; CONTINUE}; ]; < {>> <> <> << ];>> RefText.ReleaseScratch[buffer]; IF ~doPutChars THEN data.listenerItem.flushCounter _ 5; freeOutStream[asi]; }; IF doPutChars THEN { FOR i: INT IN [block.startIndex .. block.startIndex + block.count) DO TRUSTED {self.PutChar[LOOPHOLE[block.base[i]]];}; ENDLOOP; }; }; outBufFlush: PROC [self: STREAM] = { data: BufStreamData = NARROW[self.streamData]; asi: ActiveServicesItem = data.listenerItem; stream: IO.STREAM = asi.remoteStream; DO IF acquireOutStream[asi] THEN EXIT; Process.Pause[1]; ENDLOOP; stream.Flush[]; freeOutStream[asi]; }; outBufGetIndex: PROC [self: STREAM] RETURNS [INT] = { data: BufStreamData = NARROW[self.streamData]; RETURN[data.outPointer]; }; outBufClose: PROC [self: STREAM, abort: BOOL] = { data: BufStreamData = NARROW[self.streamData]; IF data.EOF = false THEN data.EOF _ pending; }; <> BumpRequests: ENTRY PROC = { ComputeServerStatistics.RequestesThisIncarnation _ ComputeServerStatistics.RequestesThisIncarnation + 1; ComputeServerStatistics.TotalRequestes _ ComputeServerStatistics.TotalRequestes + 1; }; NextServerEvent: PUBLIC ENTRY PROC [last: REF READONLY ComputeServerStatistics.ServerEvent _ NIL] RETURNS [REF ComputeServerStatistics.ServerEvent] = { IF last = NIL THEN { <> IF serverEventListTail = NIL THEN { <> watchingServer _ TRUE; UNTIL serverEventListTail # NIL DO WAIT anotherServerEvent ENDLOOP; RETURN [serverEventListTail]; } ELSE last _ serverEventListTail; }; UNTIL last.chain # NIL DO WAIT anotherServerEvent ENDLOOP; -- wait for next event RETURN [last.chain]; }; ReportServerEvent: PUBLIC ENTRY PROC [type: ComputeServerStatistics.ServerEventType, command: Rope.ROPE, startTime: BasicTime.GMT, endTime: BasicTime.GMT, remoteMachineName: Rope.ROPE, userName: Rope.ROPE] = { IF watchingServer THEN { eventREF: REF ComputeServerStatistics.ServerEvent = NEW [ ComputeServerStatistics.ServerEvent _ [type, command, startTime, endTime, remoteMachineName, userName, NIL] ]; IF serverEventListTail # NIL THEN serverEventListTail.chain _ eventREF; serverEventListTail _ eventREF; BROADCAST anotherServerEvent; }; }; <> ProfileChanged: UserProfile.ProfileChangedProc = { <> SELECT reason FROM firstTime => { }; rollBack => { }; edit => { GetProfileConstants[]; }; ENDCASE; }; GetProfileConstants: PROC = { OKToRunBCDs _ UserProfile.Boolean[key: "Summoner.OKToRunBCDs", default: TRUE]; PackagesOKToRun _ UserProfile.ListOfTokens[key: "Summoner.PackagesOKToRun", default: NIL]; PackagesNotOKToRun _ UserProfile.ListOfTokens[key: "Summoner.PackagesNotOKToRun", default: NIL]; TryForFreeGFIs _ UserProfile.Number[key: "Summoner.FreeGFIs", default: 10]; OKToUseLocalDisk _ UserProfile.Boolean[key: "Summoner.OKToUseLocalDisk", default: FALSE]; DisableIFIdle _ UserProfile.Boolean[key: "Summoner.ServerOffIfIdle", default: FALSE] AND ~UserProfile.Boolean["Watch.powerOffInhibit", FALSE]; DisableIFIdleAfter _ UserProfile.Number["Watch.powerOffAfter", 1900]; SELECT DisableIFIdleAfter FROM < 0 => DisableIFIdleAfter _ 0; > 2400 => DisableIFIdleAfter _ 2400; ENDCASE; DisableIFIdleBefore _ UserProfile.Number["Watch.powerOffBefore", 700]; SELECT DisableIFIdleBefore FROM < 0 => DisableIFIdleBefore _ 0; > 2400 => DisableIFIdleBefore _ 2400; ENDCASE; }; <> 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]; }; <> Init: PROC = { clientInterfaceCache _ NEW[clientInterfaceArray]; CommandTable _ SymTab.Create[mod: 59, case: FALSE]; ComputeServerServer.RegisterRealRegistration[Register]; UserProfile.CallWhenProfileChanges[proc: ProfileChanged]; }; Init[]; END. <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <<, DoService>> <<>> <<>>