// IfsTimeRare.bcpl -- Time server initialization and uncommon events
// Copyright Xerox Corporation 1979, 1980, 1981, 1983

// Last modified September 23, 1983  2:55 PM by Taft

get "pup0.decl"
get "pup1.decl"
get "IfsTimeServ.decl"
get "AltoDefs.d"
get "Ifs.decl"
get "IfsSystemInfo.decl"

external
[
// outgoing procedures
CreateTimeServ; ResetTimeServ; ResetTimeCtx; EnableTimeServ

// incoming procedures
CreateCtx; DestroyCtx
OpenLevel1Socket; CloseLevel1Socket
GetPBI; ReleasePBI; CompletePup; SetPupDPort
SetTimer; TimerHasExpired; Block
Dequeue; DoubleAdd; DoubleSubtract
VFileReadPage; VFileWritePage; CallProc
Allocate; Zero; MoveBlock; ReadCalendar; SetCalendar

// incoming statics
@ts; sysZone; infoVMD
]

//----------------------------------------------------------------------------
let CreateTimeServ() be
//----------------------------------------------------------------------------
// Once-only initialization
[
ts = Allocate(sysZone, lenTS); Zero(ts, lenTS)
ts>>TS.stats.version = timeStatsVersion

// Convert local time parameters to network format
ts>>TS.timeParams.zoneS = timeParams>>LTP.sign
ts>>TS.timeParams.zoneH = timeParams>>LTP.zoneH
ts>>TS.timeParams.zoneM = timeParams>>LTP.zoneM
ts>>TS.timeParams.beginDST = timeParams>>LTP.beginDST
ts>>TS.timeParams.endDST = timeParams>>LTP.endDST

// Disable the time server until we have at least tried to get the time
// from some other server.
ts>>TS.dontKnowTime = true
ResetTimeServ()
]

//----------------------------------------------------------------------------
and TimeOK(time, ntp) = valof
//----------------------------------------------------------------------------
[
let t = vec 1; MoveBlock(t, time, 2)
DoubleSubtract(t,
 lv CallProc(VFileReadPage, infoVMD, spPage)>>SysParams.runFileCreated)
resultis t!0 uls 2406 &  // within 5 years after Ifs.run file creation?
 ntp>>TimeParams.beginDST gr 0 & ntp>>TimeParams.endDST gr 0 &
 ntp>>TimeParams.zoneH le 12
]

//----------------------------------------------------------------------------
and EnableTimeServ(value) be ts>>TS.externalLock = not value
//----------------------------------------------------------------------------

//----------------------------------------------------------------------------
and ResetTimeServ(port; numargs na) be
//----------------------------------------------------------------------------
// Call this to Reset clock from the internet.
// The work is done asynchronously by a process spawned by this procedure
//  so time may not yet be reset when this procedure returns.
// Port is who to send the request to.  It defaults to all time servers
//  on all directly connected nets.
// If ResetTimeCtx is active and we get another reset request, perhaps the
//  port was bad in the first request, so reach into the context and change
//  the port.
[
if ts>>TS.resetCtx eq 0 then ts>>TS.resetCtx = CreateCtx(150, ResetTimeCtx)
let resetPort = lv ts>>TS.stats.resetPort
MoveBlock(resetPort, (na eq 0 ? table [ 0; 0; 0 ], port), lenPort)
if resetPort>>Port.socket↑1 eq 0 & resetPort>>Port.socket↑2 eq 0 then
   resetPort>>Port.socket↑2 = socketMiscServices
]

//----------------------------------------------------------------------------
and ResetTimeCtx(ctx) be
//----------------------------------------------------------------------------
// The context destroys itself when done.
[
let soc = vec lenPupSoc
OpenLevel1Socket(soc)

let answerPBI = valof
   [
   for try = 1 to 30 do  // keep trying for 1 minute
      [
      let pbi = GetPBI(soc, true)
      if pbi ne 0 then
         [
         SetPupDPort(pbi, lv ts>>TS.stats.resetPort)
         CompletePup(pbi, ptAltoTimeRequest, pupOvBytes)
         ]

      let timer = nil
      SetTimer(lv timer, 200)   // 2 seconds

         [ // repeat
         Block()
         pbi = Dequeue(lv soc>>PupSoc.iQ)
         if pbi ne 0 then
            [
            if pbi>>PBI.pup.type eq ptAltoTimeReply &
             TimeOK(lv pbi>>PBI.pup.words↑1, lv pbi>>PBI.pup.words↑3) then
               resultis pbi  // Here is a good reply
            ReleasePBI(pbi)
            ]
         ] repeatuntil TimerHasExpired(lv timer)
      ]

   resultis 0  // No response
   ]

// ResetTimeCtx (cont'd)

if answerPBI ne 0 then
   [
   // correct the basis for the IFS uptime computation
   let time = vec 1
   ReadCalendar(time)
   let ifsStartTime =
    lv CallProc(VFileWritePage, infoVMD, spPage)>>SysParams.ifsStartTime
   DoubleSubtract(ifsStartTime, time)
   DoubleAdd(ifsStartTime, lv answerPBI>>PBI.pup.words↑1)

   // set local time from net
   ts>>TS.dontKnowTime = false
   SetCalendar(lv answerPBI>>PBI.pup.words↑1)

   // set time parameters only if reply is from directly-connected network
   if answerPBI>>PBI.pup.hopCnt eq 0 then
      [
      MoveBlock(lv ts>>TS.timeParams, lv answerPBI>>PBI.pup.words↑3, 3)
      timeParams>>LTP.sign = ts>>TS.timeParams.zoneS
      timeParams>>LTP.zoneH = ts>>TS.timeParams.zoneH
      timeParams>>LTP.zoneM = ts>>TS.timeParams.zoneM
      timeParams>>LTP.beginDST = ts>>TS.timeParams.beginDST
      timeParams>>LTP.endDST = ts>>TS.timeParams.endDST
      ]

   MoveBlock(lv ts>>TS.stats.resetPort, lv answerPBI>>PBI.pup.sPort, lenPort)
   ReleasePBI(answerPBI)
   ]

CloseLevel1Socket(soc)
if ts>>TS.dontKnowTime then
   [
   // Failed to obtain time from another server.
   // Enable local time server only if the local time appears reasonable.
   let time = vec 1
   ReadCalendar(time)
   ts>>TS.dontKnowTime = not TimeOK(time, lv ts>>TS.timeParams)
   ]

ts>>TS.resetCtx = 0
DestroyCtx()
]