-- File: PupTimeServerCold.mesa,  Last Edit: BLyon  January 16, 1981  5:08 PM
-- Please don't forget to update the herald...

DIRECTORY
  Ascii USING [TAB, SP, CR],
  InlineDefs USING [BcplToMesaLongNumber],
  Process USING [Detach, Yield],
  Runtime USING [IsBound],
  Storage USING [FreeString],
  String USING [
    AppendChar, AppendString, AppendDecimal, AppendLongDecimal, EquivalentString,
    StringToDecimal, InvalidNumber],
  System USING [GetGreenwichMeanTime],
  Time USING [AppendCurrent],

  CmFile USING [OpenSection, NextItem, Close],
  Event USING [Item, Reason, AddNotifier],
  FormSW USING [
    ClientItemsProcType, ProcType, AllocateItemDescriptor, newLine, Display,
    FindItem, CommandItem, BooleanItem, StringItem, NumberItem],
  Put USING [Line],
  Tool USING [Create, MakeSWsProc, MakeMsgSW, MakeFormSW],
  ToolWindow USING [TransitionProcType],
  Window USING [Handle],

  Clock USING [
    SetCorrection, TimeParameters, GetTimeParms, SetTimeParms, SetTime,
    SetTimeResetter],
  Indirect USING [GetParmFileName],
  MiscServerDefs USING [
    PupMiscServerOn, PupMiscServerOff, IgnoreThisPacket, SetTimeServer],
  TimeServerDefs USING [
    PupTimeServer, PupTimeFormat, parmsOk, resetAddress, correction],

  StatsDefs USING [
    StatCounterIndex, StatUpdate, StatsGetCounters, StatsStringToIndex],
  DriverDefs USING [Network],
  PupDefs USING [
    PupBuffer, PupSocketID, UniqueLocalPupSocketID, PupSocket, PupSocketMake,
    PupSocketDestroy, SecondsToTocks, GetFreePupBuffer, ReturnFreePupBuffer,
    AppendHostName, PupRouterBroadcastThis, SetPupContentsWords],
  PupTypes USING [PupAddress, fillInPupAddress, miscSrvSoc],
  BufferDefs;

PupTimeServerCold: PROGRAM
  IMPORTS
    InlineDefs, Process, Runtime, Storage, String, System, Time, CmFile, Event,
    FormSW, Put, Tool, Clock, Indirect, MiscServerDefs, TimeServerDefs, StatsDefs,
    PupDefs
  EXPORTS BufferDefs, TimeServerDefs
  SHARES BufferDefs =
  BEGIN OPEN StatsDefs, PupDefs, TimeServerDefs;

  -- EXPORTed TYPEs
  Network: PUBLIC TYPE = DriverDefs.Network;

  msg, form: PUBLIC Window.Handle _ NIL;
  eventItem: Event.Item _ [eventMask: 177777B, eventProc: Broom];

  useCount: CARDINAL _ 0;
  resetting, pleaseStop, running: BOOLEAN _ FALSE;

  resetText: STRING _ [30];

  stats: POINTER TO ARRAY StatCounterIndex OF LONG CARDINAL _ StatsGetCounters[];
  statText, statTenex, statAlto: PUBLIC StatCounterIndex;


  Init: PROCEDURE =
    BEGIN
    [] _ Tool.Create[
      name: "Time Server of November 16, 1980"L, makeSWsProc: MakeSWs,
      clientTransition: ClientTransition, initialState: inactive];
    Event.AddNotifier[@eventItem];
    END;

  PupTimeServerOn: PUBLIC PROCEDURE =
    BEGIN
    IF (useCount _ useCount + 1) = 1 THEN BEGIN running _ TRUE; Starter[]; END;
    UpdatePicture[];
    END;

  Starter: PROCEDURE =
    BEGIN
    MiscServerDefs.PupMiscServerOn[];
    parmsOk _ FindParameters[];
    MiscServerDefs.SetTimeServer[TimeServerDefs.PupTimeServer];
    pleaseStop _ FALSE;
    Process.Detach[FORK ResetFromAnywhere[]];
    Clock.SetTimeResetter[ResetFromAnywhere];
    END;

  PupTimeServerOff: PUBLIC PROCEDURE =
    BEGIN
    IF useCount # 0 AND (useCount _ useCount - 1) = 0 THEN
      BEGIN running _ FALSE; Stopper[]; END;
    UpdatePicture[];
    END;

  Stopper: PROCEDURE =
    BEGIN
    MiscServerDefs.PupMiscServerOff[];
    MiscServerDefs.SetTimeServer[MiscServerDefs.IgnoreThisPacket];
    pleaseStop _ TRUE;
    WHILE resetting DO Process.Yield[]; ENDLOOP;
    END;

  UpdatePicture: PROCEDURE =
    BEGIN
    IF form = NIL THEN RETURN;
    FormSW.FindItem[form, startIX].flags.invisible _ running;
    FormSW.FindItem[form, stopIX].flags.invisible _ ~running;
    FormSW.Display[form];
    END;

  ResetFromAnywhere: PROCEDURE = BEGIN ResetTime[PupTypes.fillInPupAddress]; END;

  ResetTime: PUBLIC PROCEDURE [where: PupTypes.PupAddress] =
    BEGIN
    broadcast: BOOLEAN _ where = PupTypes.fillInPupAddress;
    b: PupBuffer;
    me: PupSocketID _ UniqueLocalPupSocketID[];
    socket: PupSocket _ PupSocketMake[me, where, SecondsToTocks[2]];
    i: CARDINAL _ 0;
    delta: LONG INTEGER;
    time: LONG CARDINAL _ System.GetGreenwichMeanTime[] - 99;
    since: LONG CARDINAL;
    -- smash resetAddress even if we are already resetting to avoid getting stuck trying to reset from nowhere
    resetAddress _ where;
    IF broadcast THEN where.socket _ PupTypes.miscSrvSoc;
    resetText.length _ 0;
    IF broadcast THEN String.AppendString[resetText, "Anywhere"L]
    ELSE AppendHostName[resetText, resetAddress];
    UpdatePicture[];
    IF resetting THEN RETURN;
    resetting _ TRUE;
    UpdatePicture[];
    DO
      IF pleaseStop THEN BEGIN resetting _ FALSE; RETURN; END;
      since _ System.GetGreenwichMeanTime[] - time;
      IF since > 60*10 OR (i < 10 AND since > 5) THEN
	BEGIN
	-- Poke every few seconds for a while, then back way off.
	i _ i + 1;
	b _ GetFreePupBuffer[];
	b.pupID _ [0, i];
	b.source.socket _ me;
	b.dest _ where;
	b.pupType _ dateAltoRequest;
	SetPupContentsWords[b, 0];
	socket.setRemoteAddress[resetAddress];
	IF broadcast THEN PupRouterBroadcastThis[b] ELSE socket.put[b];
	time _ System.GetGreenwichMeanTime[];
	END;
      b _ socket.get[];
      IF b # NIL THEN
	BEGIN
	IF b.pupType = dateAltoIs THEN
	  BEGIN
	  network: Network = b.network;
	  info: LONG POINTER TO TimeServerDefs.PupTimeFormat _
	    LOOPHOLE[@b.pupBody];
	  before, after: LONG CARDINAL;
	  oldSeconds, oldHours: LONG INTEGER;
	  IF broadcast AND network.netNumber.b = b.source.net AND
	    network.hostNumber = b.source.host THEN
	    BEGIN -- From ME
	    ReturnFreePupBuffer[b];
	    LOOP;
	    END;
	  before _ System.GetGreenwichMeanTime[];
	  StatUpdate[]; -- hackery to keep stats from getting confused
	  oldSeconds _ stats[statSeconds];
	  oldHours _ stats[statHours];
	  Clock.SetTime[LOOPHOLE[InlineDefs.BcplToMesaLongNumber[info.time]]];
	  StatUpdate[]; -- we could loose a tick or so, but that's tough
	  stats[statSeconds] _ oldSeconds;
	  stats[statHours] _ oldHours;
	  after _ System.GetGreenwichMeanTime[];
	  delta _ LOOPHOLE[after, LONG INTEGER] - LOOPHOLE[before, LONG INTEGER];
	  EXIT;
	  END;
	ReturnFreePupBuffer[b];
	END;
      ENDLOOP;
    resetAddress _ b.source;
    ReturnFreePupBuffer[b];
    IF TRUE THEN
      BEGIN
      text: STRING = [100];
      Time.AppendCurrent[text];
      String.AppendString[text, "  Time Reset from "L];
      AppendHostName[text, resetAddress];
      String.AppendString[text, ".  Correction was "L];
      String.AppendLongDecimal[text, delta];
      String.AppendChar[text, '.];
      LogString[text];
      END;
    PupSocketDestroy[socket];
    resetting _ FALSE;
    resetText.length _ 0;
    AppendHostName[resetText, resetAddress];
    UpdatePicture[];
    END;

  SetupTimeServerThings: PUBLIC PROCEDURE =
    BEGIN
    statText _ StatsStringToIndex["Text Date Requests"];
    statTenex _ StatsStringToIndex["Tenex Date Requests"];
    statAlto _ StatsStringToIndex["Alto Date Requests"];
    END;

  FindParameters: PROCEDURE RETURNS [ok: BOOLEAN] =
    BEGIN
    parmFileName: STRING _ NIL;
    dstSpecified, zoneSpecified, correctionSpecified: BOOLEAN _ FALSE;
    sectionName: STRING = "TimeServer"L;
    token, arg: STRING _ NIL;
    finger: CARDINAL;
    parms: Clock.TimeParameters _ Clock.GetTimeParms[];
    text: STRING = [100];
    GetNextToken: PROCEDURE =
      BEGIN
      c: CHARACTER;
      -- Borrow token
      token.length _ 0;
      FOR finger IN [finger..arg.length) DO
	c _ arg[finger];
	SELECT c FROM
	  Ascii.TAB, Ascii.SP => IF (token.length # 0) THEN RETURN;
	  -- flush leading blanks

	  Ascii.CR, ',, ': => BEGIN finger _ finger + 1; RETURN; END;
	  ENDCASE => String.AppendChar[token, c];
	ENDLOOP;
      END;
    GetDecimal: PROCEDURE RETURNS [n: INTEGER] =
      BEGIN
      GetNextToken[];
      -- StringToNumber dies on leading +, so flush it here
      IF token.length > 1 AND token[0] = '+ THEN
	BEGIN
	FOR i: CARDINAL IN [0..token.length - 1) DO
	  token[i] _ token[i + 1]; ENDLOOP;
	token.length _ token.length - 1;
	END;
      RETURN[
	String.StringToDecimal[
	  token !
	  String.InvalidNumber =>
	    BEGIN
	    Problem["Decimal number expected: "L, token];
	    ok _ FALSE;
	    n _ 0;
	    CONTINUE;
	    END]];
      END;
    IF Runtime.IsBound[Indirect.GetParmFileName] THEN
      parmFileName _ Indirect.GetParmFileName[];
    IF parmFileName = NIL THEN parmFileName _ "TimeServer.txt";
    ok _ TRUE;
    IF ~CmFile.OpenSection[parmFileName, sectionName] THEN
      BEGIN
      Problem["Can't find [TimeServer] section in "L, parmFileName];
      RETURN[FALSE];
      END;
    DO
      finger _ 0;
      text.length _ 0;
      [token, arg] _ CmFile.NextItem[];
      SELECT TRUE FROM
	token = NIL => EXIT;
	(token.length > 0 AND token[0] = ';) => NULL;
	String.EquivalentString[token, "CORRECTION"L] => -- <seconds per day>
	  BEGIN
	  correction _ GetDecimal[];
	  String.AppendDecimal[text, correction];
	  Problem["The clock correction is "L, text, " seconds per day"L];
	  Clock.SetCorrection[correction];
	  correctionSpecified _ TRUE;
	  END;
	String.EquivalentString[token, "DST"L] => -- <begin day> <end day>
	  BEGIN
	  first: CARDINAL _ GetDecimal[];
	  last: CARDINAL _ GetDecimal[];
	  IF first # parms.beginDst OR last # parms.endDst THEN
	    BEGIN
	    Problem["The DST info on this disk is wrong"L];
	    parms.beginDst _ first;
	    parms.endDst _ last;
	    END;
	  String.AppendString[text, "DST: begin="L];
	  String.AppendDecimal[text, first];
	  String.AppendString[text, ", last="L];
	  String.AppendDecimal[text, last];
	  Problem[text];
	  dstSpecified _ TRUE;
	  END;
	String.EquivalentString[token, "ZONE"L] => -- <sign> <hours>:<minutes>
	  BEGIN
	  hours: INTEGER _ GetDecimal[];
	  minutes: CARDINAL _ GetDecimal[];
	  IF hours # parms.zone OR minutes # parms.minutes THEN
	    BEGIN
	    Problem["The time zone info on this disk is wrong"L];
	    parms.zone _ hours;
	    parms.minutes _ minutes;
	    END;
	  String.AppendString[text, "ZONE: hours="L];
	  String.AppendDecimal[text, hours];
	  String.AppendString[text, ", minutes="L];
	  String.AppendDecimal[text, minutes];
	  Problem[text];
	  zoneSpecified _ TRUE;
	  END;
	ENDCASE => Problem["Unknown parameter: "L, token];
      Storage.FreeString[token];
      Storage.FreeString[arg];
      ENDLOOP;
    Clock.SetTimeParms[parms];
    CmFile.Close[parmFileName];
    RETURN[ok AND dstSpecified AND zoneSpecified AND correctionSpecified];
    END;

  Problem: PROCEDURE [one, two, three: STRING _ NIL] =
    BEGIN
    text: STRING = [100];
    Time.AppendCurrent[text];
    String.AppendString[text, "  TimeServer: "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;

  Start: FormSW.ProcType = BEGIN PupTimeServerOn[]; END;

  Stop: FormSW.ProcType = BEGIN PupTimeServerOff[]; END;

  ResetCommand: FormSW.ProcType =
    BEGIN Process.Detach[FORK ResetTime[PupTypes.fillInPupAddress]]; END;

  UseCurrentTime: FormSW.ProcType =
    BEGIN
    Clock.SetTime[System.GetGreenwichMeanTime[]];
    LogString["Using current time."L];
    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];
    form _ Tool.MakeFormSW[window: window, formProc: MakeForm];
    END;

  startIX: CARDINAL = 0;
  stopIX: CARDINAL = 1;
  MakeForm: FormSW.ClientItemsProcType =
    BEGIN
    nParams: CARDINAL = 7;
    items _ FormSW.AllocateItemDescriptor[nParams];
    items[0] _ FormSW.CommandItem[
      tag: "Start"L, proc: Start, place: FormSW.newLine];
    items[1] _ FormSW.CommandItem[
      tag: "Stop"L, proc: Stop, invisible: TRUE, place: FormSW.newLine];
    items[2] _ FormSW.CommandItem[
      tag: "UseCurrent"L, proc: UseCurrentTime, place: FormSW.newLine];
    items[3] _ FormSW.NumberItem[
      tag: "Correction"L, value: @correction, boxWidth: 50, readOnly: TRUE];
    items[4] _ FormSW.CommandItem[tag: "Reset"L, proc: ResetCommand];
    items[5] _ FormSW.BooleanItem[
      tag: "Resetting"L, switch: @resetting, readOnly: TRUE];
    items[6] _ FormSW.StringItem[
      tag: "ResetFrom"L, string: @resetText, readOnly: TRUE];
    RETURN[items, TRUE];
    END;

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


  Broom: PROCEDURE [why: Event.Reason] =
    BEGIN
    IF useCount = 0 THEN RETURN;
    SELECT why FROM
      makeImage, makeCheck => IF running THEN Stopper[];
      startImage, restartCheck, continueCheck => IF running THEN Starter[];
      ENDCASE => NULL;
    END;



  -- Initialization

  Init[];
  SetupTimeServerThings[];
  PupTimeServerOn[]; -- This may be undesirable

  END.