-- Copyright (C) 1981, 1982, 1984, 1985 by Xerox Corporation. All rights reserved.
-- Policy.mesa, Transport Mechanism Mail Server - policy module
-- HGM, 10-Dec-85 23:00:29
-- Al Hall 8-Jul-82 11:38:07 --
-- Randy Gobbel 20-May-81 12:58:17 --
-- Andrew Birrell 4-Mar-82 14:44:48 --
-- Ted Wobber 29-Aug-84 10:58:45 --
-- Brenda Hankins 24-Aug-84 16:32:05
DIRECTORY
Ascii USING [CR],
EnquiryDefs USING [],
GlassDefs USING [Handle],
LogDefs USING [DisplayNumber, ShowNumber],
PolicyDefs -- using everything -- ,
Process USING [
DisableTimeout, GetPriority, InitializeCondition, MsecToTicks, Priority,
SetPriority, SetTimeout, Ticks],
PupDefs USING [GetPupAddress, PupAddress, PupPackageDestroy, PupPackageMake],
SLDefs USING [GetCount],
Time USING [Current, Pack, Packed, Unpack, Unpacked];
Policy: MONITOR
IMPORTS LogDefs, Process, PupDefs, SLDefs, Time EXPORTS EnquiryDefs, PolicyDefs =
BEGIN
-- Egg-timer --
minsCond: CONDITION;
secsCond: CONDITION;
Wait: PUBLIC PROCEDURE [
days: CARDINAL ← 0, hrs: [0..24) ← 0, mins: [0..60) ← 0, secs: [0..60) ← 0] =
BEGIN
limit: Time.Packed =
LOOPHOLE[Time.Current[] + days * (LONG[24] * 60 * 60) +
hrs * (LONG[60] * 60) + mins * LONG[60] + LONG[secs]];
WaitUntil[limit];
END;
WaitUntil: PUBLIC ENTRY PROC [time: Time.Packed] =
BEGIN
UNTIL Time.Current[] + 60 >= time DO WAIT minsCond ENDLOOP;
UNTIL Time.Current[] >= time DO WAIT secsCond ENDLOOP;
END;
-- Compactor scheduling strategy --
compactorEnabled: BOOLEAN; -- whether compactor should run at all --
compactorWanted: BOOLEAN; -- whether compactor should start another cycle --
compactorDelay: CARDINAL; -- max delay in milliseconds --
compactorStart: CONDITION;
gapsNotified: CARDINAL ← 0; -- number of calls on "GapExists" --
CompactorStart: PUBLIC ENTRY PROCEDURE =
BEGIN
waitFor: CARDINAL ← MAX[25, freeHeap-10];
UNTIL compactorEnabled AND compactorWanted DO WAIT compactorStart ENDLOOP;
UNTIL freeHeap < waitFor DO WAIT compactorStart ENDLOOP;
compactorWanted ← FALSE;
END;
compactorPause: CONDITION;
CompactorPause: PUBLIC ENTRY PROCEDURE =
BEGIN
delay: Process.Ticks = Process.MsecToTicks[
(compactorDelay / (100 - minFreeHeap)) * --beware of overflow!--
(IF freeHeap < minFreeHeap THEN 0 ELSE freeHeap - minFreeHeap)];
UNTIL compactorEnabled DO WAIT compactorPause ENDLOOP;
IF current[work] = 0 THEN RETURN;
IF gapsNotified > 0 THEN {gapsNotified ← gapsNotified - 1; RETURN};
IF delay = 0 THEN RETURN;
Process.SetTimeout[@compactorPause, delay];
WAIT compactorPause;
END;
freeHeap: [0..100];
minFreeHeap: [0..100]; -- min free heap for running compactor with pauses --
loggedHeap: [0..100] ← 100; -- Free heap recorded in log
AmountOfFreeHeap: PUBLIC ENTRY PROCEDURE [given: [0..100]] =
BEGIN
freeHeap ← given;
IF given # loggedHeap
AND
(given < minFreeHeap OR loggedHeap < minFreeHeap
OR given NOT IN (loggedHeap - 5..loggedHeap + 5)) THEN LogFreeHeap[];
END;
LogFreeHeap: INTERNAL PROCEDURE =
BEGIN
LogDefs.ShowNumber["Free heap: "L, freeHeap, "%"L];
loggedHeap ← freeHeap;
END;
GapExists: PUBLIC ENTRY PROCEDURE =
BEGIN
compactorWanted ← TRUE;
NOTIFY compactorStart;
IF gapsNotified = 0 THEN NOTIFY compactorPause;
gapsNotified ← gapsNotified + 1;
END;
-- Other time delays --
periodicWantedNow: PACKED ARRAY PolicyDefs.PeriodicProcess OF BOOLEAN ← ALL[
FALSE];
readPendingDelay: CARDINAL ← 15; -- minutes --
prodServersDelay: CARDINAL ← 15; -- minutes --
archiverHour: [0..24) ← 23; -- time of day, before IFS Archiver
regPurgerHour: [0..24) ← 0; -- [0..56) - see Init
PeriodicWait: PUBLIC ENTRY PROC [process: PolicyDefs.PeriodicProcess] =
BEGIN
limit: LONG CARDINAL =
SELECT process FROM
readPending => LOOPHOLE[Time.Current[] + readPendingDelay * 60],
prodServers => LOOPHOLE[Time.Current[] + prodServersDelay * 60],
archiver => CalculateNextTime[archiverHour],
regPurger => CalculateNextTime[regPurgerHour],
ENDCASE => ERROR;
UNTIL Time.Current[] >= limit OR periodicWantedNow[process] DO
WAIT minsCond ENDLOOP;
periodicWantedNow[process] ← FALSE;
END;
Activate: PUBLIC ENTRY PROC [process: PolicyDefs.PeriodicProcess] =
BEGIN periodicWantedNow[process] ← TRUE; BROADCAST minsCond; END;
CalculateNextTime: PROC [wantedHour: [0..24)] RETURNS [Time.Packed] =
BEGIN
unpacked: Time.Unpacked ← Time.Unpack[Time.Current[]];
IF unpacked.hour >= wantedHour THEN -- move to next day --
unpacked ← Time.Unpack[LOOPHOLE[Time.Current[] + 24 * 60 * LONG[60]]];
unpacked.minute ← 0;
unpacked.second ← 0;
unpacked.hour ← wantedHour;
RETURN[Time.Pack[unpacked, FALSE]]
END;
RemailingAllowed: PROC RETURNS [BOOLEAN] =
BEGIN
IF freeHeap < minFreeHeap/2 THEN RETURN[FALSE];
IF SLDefs.GetCount[forward] > 10 THEN RETURN[FALSE];
IF SLDefs.GetCount[input] > 20 THEN RETURN[FALSE];
RETURN[TRUE];
END;
PendingAllowed: PROC RETURNS [BOOLEAN] =
BEGIN
IF SLDefs.GetCount[input] > 0 THEN RETURN[FALSE];
IF SLDefs.GetCount[forward] > 10 THEN RETURN[FALSE];
RETURN[TRUE];
END;
ExpressAllowed: PROC RETURNS [BOOLEAN] =
BEGIN
IF SLDefs.GetCount[input] > 0 THEN RETURN[FALSE];
IF SLDefs.GetCount[forward] > 5 THEN RETURN[FALSE];
RETURN[TRUE];
END;
-- Control on operations --
control: PACKED ARRAY PolicyDefs.Operation OF PolicyDefs.Control;
current: ARRAY PolicyDefs.Operation OF PolicyDefs.OpLimit;
high: ARRAY PolicyDefs.Operation OF PolicyDefs.OpLimit;
reject: ARRAY PolicyDefs.Operation OF LONG CARDINAL;
total: ARRAY PolicyDefs.Operation OF LONG CARDINAL;
opWait: CONDITION;
WaitOperation: PUBLIC ENTRY PROCEDURE [op: PolicyDefs.Operation] = {
UNTIL CheckOp[op, TRUE] DO WAIT opWait ENDLOOP};
CheckOperation: PUBLIC ENTRY PROC [
op: PolicyDefs.Operation, set: BOOLEAN ← TRUE] RETURNS [BOOLEAN] = {
RETURN[CheckOp[op, set]]};
CheckOp: INTERNAL PROCEDURE [op: PolicyDefs.Operation, set: BOOLEAN]
RETURNS [BOOLEAN] =
BEGIN
IF current[op] < control[op].limit AND control[op].allowed
AND
(SELECT op FROM
clientInput, serverInput =>
(freeHeap > minFreeHeap / 2 AND CheckOp[connection, set]),
readMail, regExpand, FTP => CheckOp[connection, set],
readExpress => ExpressAllowed [] AND CheckOp[mainLine, set],
readPending => PendingAllowed[] AND CheckOp[mainLine, set],
readInput, readForward, readMailbox => CheckOp[mainLine, set],
remailing => RemailingAllowed[] AND CheckOp[mainLine, set],
RSReadMail, MSReadMail, archiver, regPurger => CheckOp[background, set],
connection, telnet, mainLine, background => CheckOp[work, set],
work => TRUE,
ENDCASE => ERROR) THEN
BEGIN
IF set THEN {
current[op] ← current[op] + 1;
IF current[op] > high[op] THEN high[op] ← current[op];
total[op] ← total[op] + 1};
RETURN[TRUE]
END
ELSE {IF set THEN reject[op] ← reject[op] + 1; RETURN[FALSE]};
END;
EndOperation: PUBLIC ENTRY PROCEDURE [op: PolicyDefs.Operation] = {EndOp[op]};
EndOp: INTERNAL PROCEDURE [op: PolicyDefs.Operation] =
BEGIN
current[op] ← current[op] - 1;
SELECT op FROM
clientInput, serverInput, readMail, regExpand, FTP =>
EndOp[connection];
readExpress, readInput, readPending, readForward, readMailbox, remailing =>
EndOp[mainLine];
RSReadMail, MSReadMail, archiver, regPurger => EndOp[background];
connection, telnet, mainLine, background => EndOp[work];
work => NULL;
ENDCASE => ERROR;
BROADCAST opWait;
END;
ReadOperationCurrent: PUBLIC ENTRY PROC [op: PolicyDefs.Operation]
RETURNS [PolicyDefs.OpLimit] = {RETURN[current[op]]};
ReadOperationControl: PUBLIC ENTRY PROCEDURE [op: PolicyDefs.Operation]
RETURNS [PolicyDefs.Control] = BEGIN RETURN[control[op]] END;
SetOperationLimit: PUBLIC ENTRY PROCEDURE [
op: PolicyDefs.Operation, limit: PolicyDefs.OpLimit] =
BEGIN control[op].limit ← limit; BROADCAST opWait; END;
SetOperationAllowed: PUBLIC ENTRY PROCEDURE [
op: PolicyDefs.Operation, allowed: BOOLEAN] =
BEGIN control[op].allowed ← allowed; BROADCAST opWait; END;
SetTelnetAllowed: PUBLIC ENTRY PROCEDURE =
BEGIN control[work].allowed ← control[telnet].allowed ← TRUE; END;
PolicyControls: PUBLIC PROC [str: GlassDefs.Handle] =
BEGIN OPEN str;
WriteChar[Ascii.CR];
WriteString["Operation: Allowed Limit Current High Reject Accepted"L];
-- clientInput yes 127 127 127 65535 655355555 --
FOR op: PolicyDefs.Operation IN PolicyDefs.Operation DO
control: PolicyDefs.Control = ReadOperationControl[op];
gap: STRING = " "L;
WriteChar[Ascii.CR];
WriteString[
SELECT op FROM
work => "work "L,
connection => " connection "L,
clientInput => " clientInput "L,
serverInput => " serverInput "L,
readMail => " readMail "L,
regExpand => " regExpand "L,
FTP => " FTP "L,
telnet => " Telnet "L,
mainLine => " mainLine "L,
readExpress => " readExpress "L,
readInput => " readInput "L,
readPending => " readPending "L,
readForward => " readForward "L,
readMailbox => " readMailbox "L,
remailing => " remailing "L,
background => " background "L,
RSReadMail => " RSReadMail "L,
MSReadMail => " MSReadMail "L,
archiver => " archiver "L,
regPurger => " RegPurger "L,
ENDCASE => ERROR];
WriteString[gap];
WriteString[IF control.allowed THEN "yes"L ELSE "no"L];
WriteString[gap];
WriteDecimal[control.limit];
WriteString[gap];
WriteDecimal[current[op]];
WriteString[gap];
WriteDecimal[high[op]];
WriteString[gap];
WriteLongDecimal[reject[op]];
WriteString[gap];
WriteLongDecimal[total[op]];
WriteString[gap];
ENDLOOP;
WriteChar[Ascii.CR];
WriteString["readPendingDelay="L];
WriteDecimal[readPendingDelay];
WriteString[" mins"L];
WriteChar[Ascii.CR];
WriteString["prodServersDelay="L];
WriteDecimal[prodServersDelay];
WriteString[" mins"L];
END;
-- misc procedures for use from the debugger: use with care! --
BroadcastCondition: ENTRY PROC [cond: POINTER TO CONDITION] = {BROADCAST cond↑};
forever: CONDITION; -- time-out is disabled --
WaitOnCondition: ENTRY PROC [cond: POINTER TO CONDITION] = {WAIT cond↑};
Ready: SIGNAL = CODE;
SignalAtPriority: PROC [new: Process.Priority] =
BEGIN
old: Process.Priority = Process.GetPriority[];
Process.SetPriority[new];
SIGNAL Ready[];
Process.SetPriority[old];
END;
-- Initialisation --
Init: ENTRY PROCEDURE =
BEGIN OPEN Process;
-- Egg-timer --
InitializeCondition[@minsCond, MsecToTicks[60000]];
InitializeCondition[@secsCond, MsecToTicks[1000]];
-- Compactor scheduling --
compactorEnabled ← TRUE;
compactorWanted ← TRUE;
InitializeCondition[@compactorStart, 0];
DisableTimeout[@compactorStart];
compactorDelay ← 1000;
InitializeCondition[@compactorPause, MsecToTicks[compactorDelay]];
minFreeHeap ← 10;
freeHeap ← (minFreeHeap + 100) / 2;
-- Operation controls --
BEGIN
max: PolicyDefs.OpLimit = LAST[PolicyDefs.OpLimit];
control[work] ← [limit: max, allowed: TRUE];
control[connection] ← [limit: 12, allowed: TRUE];
control[clientInput] ← [limit: 5, allowed: TRUE];
control[serverInput] ← [limit: 5, allowed: TRUE];
control[readMail] ← [limit: 8, allowed: TRUE];
control[regExpand] ← [limit: 9, allowed: TRUE];
control[FTP] ← [limit: 2, allowed: TRUE];
control[telnet] ← [limit: 3, allowed: TRUE];
control[mainLine] ← [limit: max, allowed: TRUE];
control[readExpress] ← [limit: 1, allowed: TRUE];
control[readInput] ← [limit: 1, allowed: TRUE];
control[readPending] ← [limit: 1, allowed: TRUE];
control[readForward] ← [limit: 2, allowed: TRUE];
control[readMailbox] ← [limit: 1, allowed: TRUE];
control[background] ← [limit: 1, allowed: TRUE];
control[RSReadMail] ← [limit: 1, allowed: TRUE];
control[MSReadMail] ← [limit: 1, allowed: TRUE];
control[remailing] ← [limit: 1, allowed: TRUE];
control[archiver] ← [limit: 1, allowed: TRUE];
control[regPurger] ← [limit: 1, allowed: TRUE];
END;
current ← high ← ALL[0];
reject ← total ← ALL[LONG[0]];
InitializeCondition[@opWait, 0];
DisableTimeout[@opWait];
DisableTimeout[@forever];
BEGIN
-- RegPurger takes a LONG LONG LONG time, and it clogs up the R Server.
-- This is a hack to prevent all of them in one area running at the same time.
me: PupDefs.PupAddress;
[] ← PupDefs.PupPackageMake[];
PupDefs.GetPupAddress[@me, "ME"L];
PupDefs.PupPackageDestroy[];
regPurgerHour ← me.host MOD 6;
END;
-- statistics --
LogDefs.DisplayNumber["Free heap"L, [percent[@freeHeap]]];
LogDefs.DisplayNumber["Connections"L, [short[@(current[connection])]]];
END;
Init[];
END.