-- Transport Mechanism Mail Server - policy module --

-- [Indigo]<Grapevine>MS>Policy.mesa --

-- Randy Gobbel		20-May-81 12:58:17 --
-- Andrew Birrell	20-Sep-82  9:16:26 --
-- Mike Schroeder	25-Jan-83 13:41:07F  --

DIRECTORY
Ascii		USING[ CR ],
EnquiryDefs	USING[ ],
GlassDefs	USING[ Handle ],
LogDefs		USING[ DisplayNumber, WriteLogEntry ],
PolicyDefs	-- using everything --,
Process		USING[ DisableTimeout, GetPriority, InitializeCondition,
		       MsecToTicks, Priority, SetPriority, SetTimeout,
		       Ticks ],
String		USING[ AppendChar, AppendDecimal, AppendString ],
Time		USING[ Current, Pack, Packed, Unpack, Unpacked ];

Policy: MONITOR
   IMPORTS LogDefs, Process, String, 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
   UNTIL compactorEnabled AND compactorWanted 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 PROC =
   BEGIN
   s: STRING = [14]; -- 100% free heap --
   String.AppendString[s, "Free heap: "L];
   String.AppendDecimal[s, freeHeap];
   String.AppendChar[s, '%];
   LogDefs.WriteLogEntry[s];
   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 --
regPurgerHour:    [0..24) _ 23; -- time of day --

PeriodicWait: PUBLIC ENTRY PROC[process: PolicyDefs.PeriodicProcess] =
   BEGIN
   limit: LONG CARDINAL = SELECT process FROM
       readPending => Time.Current[] + readPendingDelay*60,
       prodServers => 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;

expressThreshold: CARDINAL _ 1;

ExpressAllowed: PUBLIC ENTRY PROC[inputLength: CARDINAL] RETURNS[BOOLEAN] =
   BEGIN
   RETURN[inputLength < expressThreshold]
   END;

SetExpressThreshold: PUBLIC ENTRY PROC[thresh: CARDINAL] =
  { expressThreshold _ thresh };

-- 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] DO WAIT opWait ENDLOOP };

CheckOperation: PUBLIC ENTRY PROCEDURE[ op: PolicyDefs.Operation ]
                               RETURNS[ BOOLEAN ] =
   { RETURN[ CheckOp[op] ] };

CheckOp: INTERNAL PROCEDURE[ op: PolicyDefs.Operation ]
                    RETURNS[ BOOLEAN ] =
   BEGIN
   IF current[op] < control[op].limit AND control[op].allowed
   AND( SELECT op FROM
          clientInput, serverInput, MTP =>
             (freeHeap > minFreeHeap/2 AND CheckOp[connection]),
          readMail, regExpand, lily, FTP => CheckOp[connection],
          readExpress, readInput, readPending, readForward, readMailbox => CheckOp[mainLine],
          remailing =>
             (freeHeap > minFreeHeap/2 AND CheckOp[mainLine]),
          RSReadMail, MSReadMail, archiver,
                      regPurger => CheckOp[background],
          connection, telnet, mainLine, background => CheckOp[work],
          work => TRUE,
        ENDCASE => ERROR )
   THEN BEGIN
        current[op] _ current[op] + 1;
        IF current[op] > high[op] THEN high[op] _ current[op];
        total[op] _ total[op] + 1;
        RETURN[ TRUE ]
        END
   ELSE BEGIN
        reject[op] _ reject[op] + 1;
        RETURN[ FALSE ]
        END;
   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, lily, MTP, FTP => EndOp[connection];
          readExpress, readInput, readPending, readForward, readMailbox,
          remailing => EndOp[mainLine];
          RSReadMail, MSReadMail, archiver,
                      regPurger => EndOp[background];
          connection, telnet, mainLine, background, lily => 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,
          lily =>         "  Lily        "L,
          MTP =>          "  MTP         "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[     lily		] _ [limit:4,   allowed:TRUE];
      control[     MTP  	] _ [limit:7,   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];

   -- statistics --
   LogDefs.DisplayNumber["Free heap"L, [percent[@freeHeap]] ];
   LogDefs.DisplayNumber["Connections"L, [short[@(current[connection])]] ];

   END;


Init[];



END.