-- Copyright (C) 1983, 1985 by Xerox Corporation. All rights reserved.
-- FixTimeServers.mesa, HGM, 25-Jun-85 3:21:50
DIRECTORY
Display USING [Bitmap, Invert, replaceFlags, White],
Format USING [], -- Needed by Put.Number and Put.Date
FormSW USING [
AllocateItemDescriptor, ClientItemsProcType, CommandItem, Display, FindItem,
ItemHandle, LongNumberItem, ModifyEditable, newLine, NumberItem, ProcType, StringItem],
Heap USING [systemZone],
MsgSW USING [Post],
Profile USING [GetUser],
Process USING [Detach, MsecToTicks, Pause],
Put USING [Char, CR, Decimal, Text, Line, Number, LongDecimal, LongNumber],
Runtime USING [GetBcdTime, IsBound],
SpecialSystem USING [AdjustClock],
String USING [AppendString, AppendNumber],
System USING [
GreenwichMeanTime, GetClockPulses,
GetGreenwichMeanTime, Pulses, PulsesToMicroseconds],
Time USING [Append, AppendCurrent, Unpack],
Tool USING [
Create, MakeSWsProc, UnusedLogName, MakeMsgSW, MakeFormSW, MakeFileSW,
AddThisSW],
ToolWindow USING [CreateSubwindow, DisplayProcType, nullBox, TransitionProcType],
UserInput USING [
CreateIndirectStringOut, DestroyIndirectStringOut, GetDefaultWindow, SetUserAbort, UserAbort],
Window USING [Handle, Box],
Buffer USING [AccessHandle, DestroyPool, GetBuffer, MakePool, ReturnBuffer],
GateDefs USING [typescript],
Password USING [Status, ValidMemberOfGroup],
PupDefs USING [
PupPackageMake, PupPackageDestroy, GetLocalPupAddress,
PupBuffer, PupSocket, PupSocketDestroy, PupSocketMake,
defaultNumberOfNetworks, GetHopsToNetwork, SecondsToTocks,
SetPupContentsWords, AppendPupAddress, AppendHostName, AppendErrorPup,
GetPupAddress, PupNameTrouble],
PupTimeServerFormat USING [
PupTimeFormat, resetTimeReply, resetTimeRequest, timeStatsRequest,
timeStatsReply],
PupTypes USING [PupAddress, fillInSocketID, miscSrvSoc],
PupWireFormat USING [BcplLongNumber, BcplToMesaLongNumber],
TimeServerOps USING [InsertTime, SetClockError];
FixTimeServers: PROGRAM
IMPORTS
Display, FormSW, Heap, MsgSW, Process, Profile, Put, Runtime, SpecialSystem, String,
System, Time, Tool, ToolWindow, UserInput,
Buffer, GateDefs, PupWireFormat, Password, PupDefs, TimeServerOps =
BEGIN OPEN PupDefs, PupTypes;
z: UNCOUNTED ZONE = Heap.systemZone;
msg, form, boxes, log: Window.Handle ← NIL;
defaultMaxHops: CARDINAL = 3;
defaultStartingError: LONG CARDINAL = 30000;
stopUpdating: BOOLEAN ← FALSE;
running: BOOLEAN ← FALSE;
indicator: {left, right, off} ← off;
first: Handle ← NIL;
maxHops: CARDINAL ← defaultMaxHops;
startingError: LONG CARDINAL ← defaultStartingError;
where: PupAddress ← [[0], [0], PupTypes.miscSrvSoc];
now, target: LONG STRING ← NIL;
Handle: TYPE = LONG POINTER TO Object;
Object: TYPE = RECORD [
next: Handle,
where: PupTypes.PupAddress,
on: BOOLEAN,
known: BOOLEAN,
offset: LONG INTEGER,
delay: System.Pulses];
ScanCircle: FormSW.ProcType =
BEGIN
IF running THEN
BEGIN MsgSW.Post[msg, "Somebody is already running..."L]; RETURN; END;
WriteCR[];
WriteCurrentDateAndTime[];
running ← TRUE;
Process.Detach[FORK ScanSeveral[]];
END;
ScanTarget: FormSW.ProcType =
BEGIN
IF running THEN
BEGIN MsgSW.Post[msg, "Somebody is already running..."L]; RETURN; END;
WriteCR[];
WriteCurrentDateAndTime[];
WriteString[" Finding time on "L];
IF ~FindPath[] THEN RETURN;
running ← TRUE;
Process.Detach[FORK ScanOne[]];
END;
ResetLocalTimeFromTarget: FormSW.ProcType =
BEGIN
IF running THEN
BEGIN MsgSW.Post[msg, "Somebody is already running..."L]; RETURN; END;
WriteCR[];
WriteCurrentDateAndTime[];
WriteString[" Resetting time from "L];
IF ~FindPath[] THEN RETURN;
running ← TRUE;
Process.Detach[FORK ResetLocalFromTarget[]];
END;
FixupCircle: FormSW.ProcType =
BEGIN
IF running THEN
BEGIN MsgSW.Post[msg, "Somebody is already running..."L]; RETURN; END;
WriteCR[];
WriteCurrentDateAndTime[];
running ← TRUE;
Process.Detach[FORK FixupSeveral[]];
END;
FixupTarget: FormSW.ProcType =
BEGIN
IF running THEN
BEGIN MsgSW.Post[msg, "Somebody is already running..."L]; RETURN; END;
WriteCR[];
WriteCurrentDateAndTime[];
WriteString[" Finding time servers on "L];
IF ~FindPath[] THEN RETURN;
running ← TRUE;
Process.Detach[FORK FixupOne[]];
END;
Off: PROCEDURE =
BEGIN
IF ~running THEN RETURN;
UserInput.SetUserAbort[log];
WHILE running DO Process.Pause[1]; ENDLOOP;
END;
FindPath: PROCEDURE RETURNS [BOOLEAN] =
BEGIN
WriteString[target];
WriteChar['=];
GetPupAddress[
@where, target !
PupNameTrouble =>
BEGIN MsgSW.Post[msg, e]; WriteLine[e]; GOTO Trouble; END];
PrintPupAddress[where];
WriteLine["."L];
RETURN[TRUE];
EXITS Trouble => RETURN[FALSE];
END;
ResetLocalFromTarget: PROCEDURE =
BEGIN
pool: Buffer.AccessHandle ← Buffer.MakePool[send: 1, receive: 10];
soc: PupSocket ← PupSocketMake[fillInSocketID, where, SecondsToTocks[5]];
sequenceNumber: CARDINAL ← GetNextSequenceNumber[];
hit: BOOLEAN ← FALSE;
FOR i: CARDINAL IN [0..5) UNTIL hit OR UserInput.UserAbort[log] DO
b: PupBuffer ← Buffer.GetBuffer[pup, pool, send];
b.pup.pupID.a ← b.pup.pupID.b ← sequenceNumber;
b.pup.pupType ← dateAltoRequest;
SetPupContentsWords[b, 0];
soc.put[b];
UNTIL hit OR (b ← soc.get[]) = NIL DO
SELECT TRUE FROM
((b.pup.pupType # dateAltoIs) OR (b.pup.pupID.a # sequenceNumber)
OR (b.pup.pupID.b # sequenceNumber)) =>
BEGIN
temp: STRING = [100];
PupDefs.AppendErrorPup[temp, b];
MsgSW.Post[msg, temp];
END;
ENDCASE =>
BEGIN
old: System.GreenwichMeanTime = System.GetGreenwichMeanTime[];
new: System.GreenwichMeanTime;
timeInfo: LONG POINTER TO PupTimeServerFormat.PupTimeFormat;
timeInfo ← LOOPHOLE[@b.pup.pupWords[0]];
new ← LOOPHOLE[PupWireFormat.BcplToMesaLongNumber[timeInfo.time]];
TimeServerOps.InsertTime[new, TRUE, startingError];
WriteCurrentDateAndTime[];
Put.Text[log, " Time reset from "L];
PrintPupAddress[where];
Put.Text[log, ", correction was "L];
Put.LongDecimal[log, new - old];
Put.Line[log, "."L];
hit ← TRUE;
UpdateNow[];
EXIT;
END;
Buffer.ReturnBuffer[b];
b ← NIL;
ENDLOOP;
IF b # NIL THEN Buffer.ReturnBuffer[b];
ENDLOOP;
PupSocketDestroy[soc];
Buffer.DestroyPool[pool];
running ← FALSE;
END;
ScanSeveral: PROCEDURE =
BEGIN
first: BOOLEAN ← TRUE;
SetupBoxes[];
FOR net: CARDINAL IN [1..PupDefs.defaultNumberOfNetworks) UNTIL UserInput.UserAbort[log] DO
IF GetHopsToNetwork[[net]] > maxHops THEN LOOP;
where ← [[net], [0], miscSrvSoc];
IF first THEN Put.Text[log, " Searching network "]
ELSE Put.Text[log, ", "];
Put.Number[log, net, [8, FALSE, TRUE, 0]];
Put.Char[log, '(];
Put.Decimal[log, GetHopsToNetwork[[net]]];
Put.Char[log, ')];
ScanSingle[];
first ← FALSE;
ENDLOOP;
Put.CR[log];
FindHiddenServers[];
SetDownBoxes[];
PrintTimeServerList[];
DeleteList[];
running ← FALSE;
END;
ScanOne: PROCEDURE =
BEGIN
SetupBoxes[];
ScanSingle[];
FindHiddenServers[];
SetDownBoxes[];
PrintTimeServerList[];
DeleteList[];
running ← FALSE;
END;
ScanSingle: PROCEDURE =
BEGIN
pool: Buffer.AccessHandle ← Buffer.MakePool[send: 1, receive: 10];
soc: PupSocket ← PupSocketMake[fillInSocketID, where, SecondsToTocks[5]];
sequenceNumber: CARDINAL ← GetNextSequenceNumber[];
launch: System.GreenwichMeanTime;
pulses: System.Pulses;
FOR i: CARDINAL IN [0..5) DO
b: PupBuffer ← Buffer.GetBuffer[pup, pool, send];
b.pup.pupID.a ← b.pup.pupID.b ← sequenceNumber;
b.pup.pupType ← PupTimeServerFormat.timeStatsRequest;
SetPupContentsWords[b, 0];
soc.put[b];
b ← Buffer.GetBuffer[pup, pool, send];
b.pup.pupID.a ← b.pup.pupID.b ← sequenceNumber;
b.pup.pupType ← dateAltoRequest;
SetPupContentsWords[b, 0];
launch ← System.GetGreenwichMeanTime[];
pulses ← System.GetClockPulses[];
soc.put[b];
UNTIL (b ← soc.get[]) = NIL DO
delay: System.Pulses = System.Pulses[System.GetClockPulses[] - pulses];
SELECT TRUE FROM
(b.pup.pupType = PupTimeServerFormat.timeStatsReply
AND (b.pup.pupID.a = sequenceNumber) AND (b.pup.pupID.b = sequenceNumber)) =>
BEGIN
FlipBoxes[];
AddToList[b.pup.source, FALSE, LAST[LONG INTEGER], delay];
END;
((b.pup.pupType = dateAltoIs) AND (b.pup.pupID.a = sequenceNumber)
AND (b.pup.pupID.b = sequenceNumber)) =>
BEGIN FlipBoxes[]; LookAtTimeResponse[b, launch, delay]; END;
ENDCASE =>
BEGIN
temp: STRING = [100];
PupDefs.AppendErrorPup[temp, b];
MsgSW.Post[msg, temp];
END;
Buffer.ReturnBuffer[b];
ENDLOOP;
IF b # NIL THEN Buffer.ReturnBuffer[b];
ENDLOOP;
PupSocketDestroy[soc];
Buffer.DestroyPool[pool];
END;
FindHiddenServers: PROCEDURE =
BEGIN
once: BOOLEAN ← FALSE;
FOR ts: Handle ← first, ts.next UNTIL ts = NIL DO
IF ts.on THEN LOOP;
IF ~once THEN
BEGIN
WriteCurrentDateAndTime[];
WriteString[" Checking on Servers that appear to be off: "L];
once ← TRUE;
END
ELSE Put.Text[log, ", "L];
PrintPupAddress[ts.where];
FindHiddenServer[ts];
ENDLOOP;
IF once THEN Put.Line[log, "."L];
END;
FindHiddenServer: PROCEDURE [ts: Handle] =
BEGIN
pool: Buffer.AccessHandle ← Buffer.MakePool[send: 1, receive: 10];
soc: PupSocket ← PupSocketMake[fillInSocketID, ts.where, SecondsToTocks[2]];
sequenceNumber: CARDINAL ← GetNextSequenceNumber[];
launch: System.GreenwichMeanTime;
pulses: System.Pulses;
FOR i: CARDINAL IN [0..5) DO
b: PupBuffer ← Buffer.GetBuffer[pup, pool, send];
b.pup.pupID.a ← b.pup.pupID.b ← sequenceNumber;
b.pup.pupType ← dateAltoRequest;
SetPupContentsWords[b, 0];
launch ← System.GetGreenwichMeanTime[];
pulses ← System.GetClockPulses[];
soc.put[b];
UNTIL (b ← soc.get[]) = NIL DO
delay: System.Pulses = System.Pulses[System.GetClockPulses[] - pulses];
SELECT TRUE FROM
((b.pup.pupType = dateAltoIs) AND (b.pup.pupID.a = sequenceNumber)
AND (b.pup.pupID.b = sequenceNumber)) =>
BEGIN
FlipBoxes[];
LookAtSpecificTimeResponse[ts, b, launch, delay];
END;
ENDCASE =>
BEGIN
temp: STRING = [100];
PupDefs.AppendErrorPup[temp, b];
MsgSW.Post[msg, temp];
END;
Buffer.ReturnBuffer[b];
ENDLOOP;
IF b # NIL THEN Buffer.ReturnBuffer[b];
ENDLOOP;
PupSocketDestroy[soc];
Buffer.DestroyPool[pool];
END;
FixupSeveral: PROCEDURE =
BEGIN
first: BOOLEAN ← TRUE;
SetupBoxes[];
FOR net: CARDINAL IN [1..PupDefs.defaultNumberOfNetworks)
UNTIL UserInput.UserAbort[log] DO
IF GetHopsToNetwork[[net]] > maxHops THEN LOOP;
where ← [[net], [0], miscSrvSoc];
IF first THEN Put.Text[log, " Finding time servers on network "]
ELSE Put.Text[log, ", "];
Put.Number[log, net, [8, FALSE, TRUE, 0]];
Put.Char[log, '(];
Put.Decimal[log, GetHopsToNetwork[[net]]];
Put.Char[log, ')];
ScanSingle[];
first ← FALSE;
ENDLOOP;
Put.CR[log];
FixupList[];
DeleteList[];
SetDownBoxes[];
running ← FALSE;
END;
FixupOne: PROCEDURE =
BEGIN
SetupBoxes[];
ScanSingle[];
FixupList[];
DeleteList[];
SetDownBoxes[];
running ← FALSE;
END;
FixupList: PROCEDURE =
BEGIN
FOR ts: Handle ← first, ts.next UNTIL ts = NIL DO
IF ~ts.on THEN LOOP; -- don't muck with IFSs
WriteCurrentDateAndTime[];
Put.Text[log, " Resetting time on "L];
PrintPupAddress[ts.where];
Put.Text[log, "..."L];
IF ResetOne[ts.where] THEN Put.Line[log, "ok."L]
ELSE Put.Line[log, "no response."L];
ENDLOOP;
END;
ResetOne: PROCEDURE [where: PupAddress] RETURNS [worked: BOOLEAN] =
BEGIN
pool: Buffer.AccessHandle ← Buffer.MakePool[send: 1, receive: 10];
soc: PupSocket ← PupSocketMake[fillInSocketID, where, SecondsToTocks[5]];
sequenceNumber: CARDINAL ← GetNextSequenceNumber[];
magic: WORD = 27182;
worked ← FALSE;
FOR i: CARDINAL IN [0..5) UNTIL worked OR UserInput.UserAbort[log] DO
b: PupBuffer ← Buffer.GetBuffer[pup, pool, send];
b.pup.pupID.a ← magic;
b.pup.pupID.b ← sequenceNumber;
b.pup.pupType ← PupTimeServerFormat.resetTimeRequest;
b.pup.address ← GetLocalPupAddress[miscSrvSoc, @where];
SetPupContentsWords[b, SIZE[PupAddress]];
soc.put[b];
UNTIL worked OR (b ← soc.get[]) = NIL DO
SELECT TRUE FROM
((b.pup.pupType # PupTimeServerFormat.resetTimeReply) OR (b.pup.pupID.a # magic)
OR (b.pup.pupID.b # sequenceNumber)) =>
BEGIN
temp: STRING = [100];
PupDefs.AppendErrorPup[temp, b];
MsgSW.Post[msg, temp];
END;
ENDCASE => BEGIN FlipBoxes[]; worked ← TRUE; END;
Buffer.ReturnBuffer[b];
b ← NIL;
ENDLOOP;
IF b # NIL THEN Buffer.ReturnBuffer[b];
ENDLOOP;
PupSocketDestroy[soc];
Buffer.DestroyPool[pool];
END;
LookAtTimeResponse: PUBLIC PROCEDURE [
b: PupDefs.PupBuffer, t: System.GreenwichMeanTime, delay: System.Pulses] =
BEGIN
timeStamp: System.GreenwichMeanTime;
timeInfo: LONG POINTER TO PupTimeServerFormat.PupTimeFormat;
offset: LONG INTEGER;
timeInfo ← LOOPHOLE[@b.pup.pupWords[0]];
timeStamp ← LOOPHOLE[PupWireFormat.BcplToMesaLongNumber[timeInfo.time]];
offset ← timeStamp - t;
AddToList[b.pup.source, TRUE, offset, delay];
END;
LookAtSpecificTimeResponse: PUBLIC PROCEDURE [
ts: Handle, b: PupDefs.PupBuffer, t: System.GreenwichMeanTime,
delay: System.Pulses] =
BEGIN
timeStamp: System.GreenwichMeanTime;
timeInfo: LONG POINTER TO PupTimeServerFormat.PupTimeFormat;
offset: LONG INTEGER;
timeInfo ← LOOPHOLE[@b.pup.pupWords[0]];
timeStamp ← LOOPHOLE[PupWireFormat.BcplToMesaLongNumber[timeInfo.time]];
offset ← timeStamp - t;
ts.offset ← MIN[ts.offset, offset];
IF delay < ts.delay THEN ts.delay ← delay;
ts.known ← TRUE;
END;
AddToList: PROCEDURE [
where: PupTypes.PupAddress, on: BOOLEAN, offset: LONG INTEGER,
delay: System.Pulses] =
BEGIN
finger: Handle ← NIL;
new: Handle;
FOR ts: Handle ← first, ts.next UNTIL ts = NIL DO
IF where = ts.where THEN
BEGIN
IF on THEN ts.offset ← MIN[ts.offset, offset];
IF delay < ts.delay THEN ts.delay ← delay;
ts.known ← ts.on ← ts.on OR on;
RETURN;
END;
IF LessPupAddress[ts.where, where] THEN finger ← ts;
ENDLOOP;
new ← z.NEW[Object];
new↑ ← [
next: NIL, where: where, on: on, known: on, offset: offset, delay: delay];
SELECT TRUE FROM
first = NIL => first ← new; -- first
finger = NIL => BEGIN new.next ← first; first ← new; END; -- insert at front of list
ENDCASE => BEGIN new.next ← finger.next; finger.next ← new; END; -- middle or end
END;
LessPupAddress: PROCEDURE [a, b: PupAddress] RETURNS [BOOLEAN] =
BEGIN
IF a.net < b.net THEN RETURN[TRUE];
IF a.net > b.net THEN RETURN[FALSE];
IF a.host < b.host THEN RETURN[TRUE];
IF a.host > b.host THEN RETURN[FALSE];
IF a.socket.a < b.socket.a THEN RETURN[TRUE];
IF a.socket.a > b.socket.a THEN RETURN[FALSE];
IF a.socket.b < b.socket.b THEN RETURN[TRUE];
IF a.socket.b > b.socket.b THEN RETURN[FALSE];
RETURN[FALSE];
END;
DeleteList: PROCEDURE =
BEGIN
ts: Handle ← first;
UNTIL ts = NIL DO
next: Handle ← ts.next; z.FREE[@ts]; ts ← next; ENDLOOP;
first ← NIL;
END;
PrintTimeServerList: PROCEDURE =
BEGIN
Put.Line[log, "Offset Delay Name+Address"L];
FOR ts: Handle ← first, ts.next UNTIL ts = NIL DO
temp: STRING = [40];
ms: LONG CARDINAL = System.PulsesToMicroseconds[ts.delay]/1000;
PupDefs.AppendHostName[temp, ts.where];
IF ts.known THEN Put.LongNumber[log, ts.offset, [10, FALSE, FALSE, 6]]
ELSE Put.Text[log, " "L];
IF ts.on THEN Put.Text[log, " "L] ELSE Put.Text[log, " Off "L];
Put.LongNumber[log, ms, [10, FALSE, FALSE, 6]];
Put.Text[log, " "L];
Put.Text[log, temp];
Put.Text[log, " = "L];
PrintPupAddress[ts.where];
Put.CR[log];
ENDLOOP;
END;
nextSequenceNumber: CARDINAL ← 123;
GetNextSequenceNumber: PROCEDURE RETURNS [CARDINAL] =
BEGIN RETURN[nextSequenceNumber ← nextSequenceNumber + 1]; END;
Enable: FormSW.ProcType =
BEGIN
person: STRING = [100];
pwd: STRING = [100];
status: Password.Status;
SaveUserInfo: PROCEDURE [name, password: LONG STRING] =
BEGIN
String.AppendString[person, name];
String.AppendString[pwd, password];
END;
Profile.GetUser[SaveUserInfo, registry];
status ← Password.ValidMemberOfGroup[person, pwd, "TimeFixers↑.internet"L];
SELECT status FROM
yes =>
BEGIN
FormSW.FindItem[form, circleIX].flags.invisible ← FALSE;
FormSW.FindItem[form, targetIX].flags.invisible ← FALSE;
FormSW.Display[form];
END;
nil => MsgSW.Post[msg, "Name or Password is NIL."L];
allDown => MsgSW.Post[msg, "All Grapevine servers appear to be down."L];
notFound => MsgSW.Post[msg, "Grapevine doesn't like your name."L];
badPwd => MsgSW.Post[msg, "Grapevine doesn't like your password."L];
group => MsgSW.Post[msg, "Grapevine thinks you are a group."L];
no => MsgSW.Post[msg, "You are not in TimeFixers↑.internet."L];
notGroup =>
MsgSW.Post[msg, "Grapevine doesn't recognize TimeFixers↑.internet."L];
error => MsgSW.Post[msg, "Error from GrapevineUser package."L];
ENDCASE => ERROR;
END;
SetStartingError: FormSW.ProcType =
BEGIN
TimeServerOps.SetClockError[startingError];
END;
ForwardOneMin: FormSW.ProcType =
BEGIN
AdjustClock[60];
END;
ForwardTenSec: FormSW.ProcType =
BEGIN
AdjustClock[10];
END;
ForwardOneSec: FormSW.ProcType =
BEGIN
AdjustClock[1];
END;
BackOneMin: FormSW.ProcType =
BEGIN
AdjustClock[-60];
END;
BackTenSec: FormSW.ProcType =
BEGIN
AdjustClock[-10];
END;
BackOneSec: FormSW.ProcType =
BEGIN
AdjustClock[-1];
END;
AdjustClock: PROCEDURE [seconds: INTEGER] =
BEGIN
SpecialSystem.AdjustClock[seconds];
UpdateNow[];
END;
-- IO things
WriteChar: PROCEDURE [c: CHARACTER] = BEGIN Put.Char[log, c]; END;
WriteCR: PROCEDURE = BEGIN Put.CR[log]; END;
WriteString: PROCEDURE [s: LONG STRING] = BEGIN Put.Text[log, s]; END;
WriteLine: PROCEDURE [s: LONG STRING] = BEGIN Put.Line[log, s]; END;
WriteLongDecimal: PROCEDURE [n: LONG CARDINAL] =
BEGIN Put.LongDecimal[log, n]; END;
WriteDecimal: PROCEDURE [n: CARDINAL] = INLINE BEGIN WriteNumber[n, 10, 0]; END;
WriteOctal: PROCEDURE [n: CARDINAL] = INLINE BEGIN WriteNumber[n, 8, 0]; END;
WriteNumber: PROCEDURE [n, radix, width: CARDINAL] = INLINE
BEGIN
temp: STRING = [25];
String.AppendNumber[temp, n, radix];
THROUGH [temp.length..width) DO WriteChar[' ]; ENDLOOP;
WriteString[temp];
END;
D8: PROCEDURE [n: CARDINAL] = BEGIN WriteNumber[n, 10, 8]; END;
O3: PROCEDURE [n: CARDINAL] = BEGIN WriteNumber[n, 8, 3]; END;
O6: PROCEDURE [n: CARDINAL] = BEGIN WriteNumber[n, 8, 3]; END;
O9: PROCEDURE [n: CARDINAL] = BEGIN WriteNumber[n, 8, 9]; END;
WriteCurrentDateAndTime: PROCEDURE =
BEGIN time: STRING = [20]; Time.AppendCurrent[time]; WriteString[time]; END;
PrintPupAddress: PROCEDURE [a: PupAddress] =
BEGIN temp: STRING = [40]; AppendPupAddress[temp, a]; WriteString[temp]; END;
indicatorBox: Window.Box = [[25, 10], [16, 16]];
DisplayBoxes: ToolWindow.DisplayProcType =
BEGIN
pattern: ARRAY [0..1] OF ARRAY [0..8) OF WORD;
left: WORD = 177400B;
right: WORD = 000377B;
SELECT indicator FROM
left => pattern ← [ALL[left], ALL[right]];
right => pattern ← [ALL[right], ALL[left]];
off => pattern ← [ALL[0], ALL[0]];
ENDCASE;
Display.Bitmap[window, indicatorBox, [@pattern, 0, 0], 16, Display.replaceFlags]
END;
SetupBoxes: PROCEDURE = BEGIN indicator ← left; DisplayBoxes[boxes]; END;
FlipBoxes: PROCEDURE =
BEGIN
SELECT indicator FROM
left => indicator ← right;
off, right => indicator ← left;
ENDCASE;
Display.Invert[boxes, indicatorBox];
END;
SetDownBoxes: PROCEDURE =
BEGIN indicator ← off; Display.White[boxes, indicatorBox]; END;
MakeBoxesSW: PROCEDURE [window: Window.Handle] =
BEGIN
box: Window.Box ← ToolWindow.nullBox;
box.dims.h ← 36;
boxes ← ToolWindow.CreateSubwindow[parent: window, display: DisplayBoxes, box: box];
Tool.AddThisSW[window: window, sw: boxes, swType: vanilla];
END;
MakeSWs: Tool.MakeSWsProc =
BEGIN
logFileName: STRING = [40];
msg ← Tool.MakeMsgSW[window: window, lines: 5];
form ← Tool.MakeFormSW[window: window, formProc: MakeForm];
MakeBoxesSW[window];
Tool.UnusedLogName[logFileName, "FixTimeServers.log$"L];
log ← Tool.MakeFileSW[window: window, name: logFileName];
Put.Line[
log,
"
Offset is in seconds.
It is positive if the remote clock is faster than ours.
The phone company time server in Palo Alto is 767-8900.
Target can be a net as well as a specific machine.
That's why it takes longer than it should to do simple things.
"L];
END;
UpdateIt: PROCEDURE =
BEGIN
then: System.GreenwichMeanTime ← System.GetGreenwichMeanTime[];
UNTIL stopUpdating DO
IF then # System.GetGreenwichMeanTime[] THEN
BEGIN then ← System.GetGreenwichMeanTime[]; UpdateNow[]; END;
Process.Pause[Process.MsecToTicks[250]];
ENDLOOP;
stopUpdating ← FALSE;
END;
UpdateNow: PROCEDURE =
BEGIN
left, right: CARDINAL;
new: STRING = [30];
item: FormSW.ItemHandle;
IF form = NIL THEN RETURN;
item ← FormSW.FindItem[form, nowIX];
Time.Append[new, Time.Unpack[System.GetGreenwichMeanTime[]]];
right ← MIN[new.length, now.length];
FOR left ← 0, left + 1 UNTIL left = right DO
IF new[left] # now[left] THEN EXIT; ENDLOOP;
FOR i: CARDINAL IN [0..new.length - left) DO new[i] ← new[i + left]; ENDLOOP;
new.length ← new.length - left;
item.flags.readOnly ← FALSE;
FormSW.ModifyEditable[form, nowIX, left, now.length - left, new];
item.flags.readOnly ← TRUE;
END;
nowIX: CARDINAL = 2;
circleIX: CARDINAL = 4;
targetIX: CARDINAL = 7;
MakeForm: FormSW.ClientItemsProcType =
BEGIN
nParams: CARDINAL = 17;
items ← FormSW.AllocateItemDescriptor[nParams];
items[0] ← FormSW.CommandItem[
tag: "ResetLocalTimeFromTarget"L, proc: ResetLocalTimeFromTarget,
place: FormSW.newLine];
items[1] ← FormSW.CommandItem[tag: "Enable"L, proc: Enable];
items[nowIX] ← FormSW.StringItem[tag: "Now"L, string: @now, readOnly: TRUE];
items[3] ← FormSW.CommandItem[
tag: "ScanCircle"L, proc: ScanCircle, place: FormSW.newLine];
items[circleIX] ← FormSW.CommandItem[
tag: "FixupCircle"L, proc: FixupCircle, invisible: TRUE];
items[5] ← FormSW.NumberItem[
tag: "MaxHops"L, value: @maxHops, default: defaultMaxHops];
items[6] ← FormSW.CommandItem[
tag: "ScanTarget"L, proc: ScanTarget, place: FormSW.newLine];
items[targetIX] ← FormSW.CommandItem[
tag: "FixupTarget"L, proc: FixupTarget, invisible: TRUE];
items[8] ← FormSW.StringItem[tag: "Target"L, string: @target, inHeap: TRUE];
items[9] ← FormSW.CommandItem[
tag: "AheadOneMin"L, proc: ForwardOneMin, place: FormSW.newLine];
items[10] ← FormSW.CommandItem[tag: "AheadTenSec"L, proc: ForwardTenSec];
items[11] ← FormSW.CommandItem[tag: "AheadOneSec"L, proc: ForwardOneSec];
items[12] ← FormSW.CommandItem[
tag: "BackOneMin"L, proc: BackOneMin, place: FormSW.newLine];
items[13] ← FormSW.CommandItem[tag: "BackTenSec"L, proc: BackTenSec];
items[14] ← FormSW.CommandItem[tag: "BackOneSec"L, proc: BackOneSec];
items[15] ← FormSW.CommandItem[
tag: "SetStartingError"L, proc: SetStartingError, place: FormSW.newLine];
items[16] ← FormSW.LongNumberItem[
tag: "StartingError"L, value: @startingError, default: defaultStartingError];
RETURN[items, TRUE];
END;
ClientTransition: ToolWindow.TransitionProcType =
BEGIN
SELECT TRUE FROM
old = inactive =>
BEGIN
now ← z.NEW[StringBody[20]];
target ← z.NEW[StringBody[20]];
String.AppendString[target, "ME"L];
[] ← PupDefs.PupPackageMake[];
Process.Detach[FORK UpdateIt[]];
END;
new = inactive =>
BEGIN
IF running THEN Off[];
stopUpdating ← TRUE;
WHILE stopUpdating DO Process.Pause[1]; ENDLOOP;
PupDefs.PupPackageDestroy[];
z.FREE[@target];
z.FREE[@now];
msg ← form ← log ← NIL;
END;
ENDCASE;
END;
Init: PROCEDURE =
BEGIN
herald: STRING = [100];
String.AppendString[herald, "FixTimeServers of "L];
Time.Append[herald, Time.Unpack[Runtime.GetBcdTime[]]];
[] ← Tool.Create[
name: herald, makeSWsProc: MakeSWs, clientTransition: ClientTransition];
IF ~Runtime.IsBound[@GateDefs.typescript] THEN CaptureTypeOut;
END;
CaptureTypeOut: PROCEDURE =
BEGIN
defaultWindow: Window.Handle = UserInput.GetDefaultWindow[];
UserInput.DestroyIndirectStringOut[defaultWindow];
UserInput.CreateIndirectStringOut[from: defaultWindow, to: log];
END;
Init[];
END.