-- File: TimeChecker.mesa,  Last Edit: HGM  December 4, 1980  6:55 PM
-- Please don't forget to update the herald....

DIRECTORY
  InlineDefs USING [BcplToMesaLongNumber],
  Process USING [Detach, SetTimeout, SecondsToTicks],
  Runtime USING [IsBound],
  Storage USING [FreeString],
  String USING [
    AppendChar, AppendString, AppendDecimal, AppendLongDecimal, EquivalentString],
  Time USING [AppendCurrent, Current],

  CmFile USING [OpenSection, NextItem, Close],
  Put USING [Line],
  Tool USING [Create, MakeSWsProc, MakeMsgSW],
  ToolWindow USING [TransitionProcType],
  Window USING [Handle],

  Indirect USING [GetParmFileName],
  TimeServerDefs USING [PupTimeFormat],
  PupDefs USING [
    PupBuffer, GetFreePupBuffer, ReturnFreePupBuffer, PupAddress, GetPupAddress,
    PupNameTrouble, PupSocket, PupSocketDestroy, PupSocketMake, PupPackageDestroy,
    PupPackageMake, SecondsToTocks, SetPupContentsWords],
  PupTypes USING [fillInSocketID, miscSrvSoc];

TimeChecker: MONITOR
  IMPORTS
    InlineDefs, Process, Runtime, Storage, String, Time, CmFile, Put, Tool,
    Indirect, PupDefs =
  BEGIN OPEN PupDefs;

  target: STRING;
  timesAround: CARDINAL _ 0;
  msg: Window.Handle _ NIL;
  pleaseStop, running: BOOLEAN _ FALSE;

  Init: PROCEDURE =
    BEGIN
    IF ~FindParameters[] THEN RETURN;
    [] _ Tool.Create[
      name: "Time Checker of December 4, 1980"L, makeSWsProc: MakeSWs,
      clientTransition: ClientTransition];
    Process.Detach[FORK ClockWatcher[]];
    END;

  FindParameters: PROCEDURE RETURNS [ok: BOOLEAN] =
    BEGIN
    parmFileName: STRING _ NIL;
    sectionName: STRING = "TimeChecker"L;
    token, arg: STRING _ NIL;
    IF Runtime.IsBound[Indirect.GetParmFileName] THEN
      parmFileName _ Indirect.GetParmFileName[];
    IF parmFileName = NIL THEN parmFileName _ "TimeChecker.txt";
    IF ~CmFile.OpenSection[parmFileName, sectionName] THEN
      BEGIN
      Problem["Can't find [TimeChecker] section in "L, parmFileName];
      RETURN[FALSE];
      END;
    ok _ FALSE;
    DO
      [token, arg] _ CmFile.NextItem[];
      SELECT TRUE FROM
	token = NIL => EXIT;
	(token.length > 0 AND token[0] = ';) => NULL;
	String.EquivalentString[token, "Target"L] =>
	  BEGIN
	  target _ arg;
	  arg _ NIL;
	  ok _ TRUE;
	  Problem["Target is "L, target];
	  END;
	ENDCASE => Problem["Unknown parameter: "L, token];
      Storage.FreeString[token];
      Storage.FreeString[arg];
      ENDLOOP;
    CmFile.Close[parmFileName];
    RETURN[ok];
    END;

  Problem: PROCEDURE [one, two, three: STRING _ NIL] =
    BEGIN
    text: STRING = [100];
    Time.AppendCurrent[text];
    String.AppendString[text, "  TimeChecker: "L];
    String.AppendString[text, one];
    IF two # NIL THEN String.AppendString[text, two];
    IF three # NIL THEN String.AppendString[text, three];
    String.AppendChar[text, '.];
    LogString[text];
    END;

  ClockWatcher: ENTRY PROCEDURE =
    BEGIN
    pause: CONDITION; -- One minute
    who: PupAddress;
    when: LONG CARDINAL;
    running _ TRUE;
    Process.SetTimeout[@pause, Process.SecondsToTicks[60]];
    THROUGH [0..5) DO WAIT pause; ENDLOOP; -- let time get set
    PupPackageMake[];
    who _ FindAddress[];
    when _ Time.Current[];
    UNTIL pleaseStop DO
      Probe[who]; -- save frame space
      when _ when + 3600;
      THROUGH [0..120) UNTIL Time.Current[] > when DO WAIT pause; ENDLOOP;
      timesAround _ timesAround + 1;
      ENDLOOP;
    PupPackageDestroy[];
    running _ FALSE;
    END;

  FindAddress: INTERNAL PROCEDURE RETURNS [who: PupAddress] =
    BEGIN
    pause: CONDITION; -- one hour
    error: BOOLEAN _ FALSE;
    Process.SetTimeout[@pause, Process.SecondsToTicks[60*60]];
    who.socket _ PupTypes.miscSrvSoc;
    BEGIN
    ENABLE
      PupDefs.PupNameTrouble =>
	BEGIN
	text: STRING = [150];
	Time.AppendCurrent[text];
	String.AppendString[
	  text, "  TimeChecker: Troubles finding address for "L];
	String.AppendString[text, target];
	String.AppendString[text, ", "L];
	String.AppendString[text, e];
	String.AppendChar[text, '.];
	LogString[text];
	error _ TRUE;
	RETRY;
	END;
    IF error THEN WAIT pause;
    GetPupAddress[@who, target];
    END;
    END;

  Probe: PROCEDURE [who: PupAddress] =
    BEGIN
    soc: PupSocket _ PupSocketMake[
      PupTypes.fillInSocketID, who, SecondsToTocks[1]];
    b: PupBuffer;
    diff: LONG INTEGER _ 99999;
    hits: CARDINAL _ 0;
    THROUGH [0..10) DO
      b _ GetFreePupBuffer[];
      b.pupType _ dateAltoRequest;
      SetPupContentsWords[b, 0];
      soc.put[b];
      IF (b _ soc.get[]) # NIL THEN -- one sec timeout
	BEGIN
	-- maybe we should include 1/2 of the response time
	IF b.pupType = dateAltoIs THEN
	  BEGIN
	  info: LONG POINTER TO TimeServerDefs.PupTimeFormat;
	  me, him: LONG INTEGER; -- NB: not LONG CARDINAL
	  info _ LOOPHOLE[@b.pupWords];
	  me _ Time.Current[];
	  him _ InlineDefs.BcplToMesaLongNumber[info.time];
	  diff _ MIN[diff, (him - me)];
	  hits _ hits + 1;
	  END;
	ReturnFreePupBuffer[b];
	END;
      ENDLOOP;
    PupSocketDestroy[soc];
    IF hits # 0 THEN
      BEGIN
      text: STRING = [100];
      Time.AppendCurrent[text];
      SELECT TRUE FROM
	(timesAround = 0) =>
	  BEGIN String.AppendString[text, "  At the start of this run, "L]; END;
	(timesAround = 1) =>
	  BEGIN String.AppendString[text, "  After one hour, "L]; END;
	(timesAround = 24) =>
	  BEGIN String.AppendString[text, "  After one day, "L]; END;
	(timesAround = 168) =>
	  BEGIN String.AppendString[text, "  After one week, "L]; END;
	(timesAround MOD 24) = 0 =>
	  BEGIN
	  String.AppendString[text, "  After "L];
	  String.AppendDecimal[text, timesAround/24];
	  String.AppendString[text, " days, "L];
	  END;
	ENDCASE =>
	  BEGIN
	  String.AppendString[text, "  After "L];
	  String.AppendDecimal[text, timesAround];
	  String.AppendString[text, " hours, "L];
	  END;
      String.AppendString[text, target];
      String.AppendString[text, "'s clock is "L];
      String.AppendLongDecimal[text, diff];
      String.AppendString[text, " seconds faster than ours."L];
      LogString[text];
      END;
    END;

  LogString: PROCEDURE [text: STRING] =
    BEGIN IF msg # NIL THEN Put.Line[msg, text]; Put.Line[NIL, text]; END;

  MakeSWs: Tool.MakeSWsProc =
    BEGIN msg _ Tool.MakeMsgSW[window: window, lines: 5]; END;

  ClientTransition: ToolWindow.TransitionProcType =
    BEGIN IF new = inactive THEN msg _ NIL; END;

  -- initialization

  Init[];
  END.