-- Copyright (C) 1981, 1982, 1984, 1985  by Xerox Corporation. All rights reserved. 
-- Policy.mesa, Transport Mechanism Mail Server - policy module

-- HGM, 21-May-85 21:13:21
-- 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;


  PendingAllowed: PROC RETURNS [BOOLEAN] =
    BEGIN
    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 => (freeHeap > minFreeHeap / 2 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.