// PupNameServ.bcpl - Name lookup server
// See also PupNameCore.bcpl, PupNameInit.bcpl PupNameServ.decl
// Last modified June 30, 1982  10:02 AM by Taft

get "Pup0.decl"
get "Pup1.decl"
get "PupNameServ.decl"
get "PupServEftp.decl"

external
[
// outgoing procedures
NameServ; NameServCtx

// incoming procedures
NameLookup; LockNameServ; UnlockNameServ
MoveBlock; Zero; Usc; DoubleIncrement
Enqueue; Dequeue; Unqueue; Allocate; Free; Block
InitializeContext; Dismiss; SetTimer; TimerHasExpired
OpenLevel1Socket; CloseLevel1Socket; GetPBI; ReleasePBI
CompletePup; ExchangePorts; PupServSend; PupServReceive

// outgoing statics
@ns

// incoming statics
lenPup; CtxRunning; @ms
]

static @ns

// NameServCtx is the main process for this module.
//  It runs forever and does the following things:
//   Probes for newer directories.
//   Destroys transient processes when they are done.
// There are two types of transient processes:
//  Receivers probe for newer directory versions and receive them.
//  Senders send the directory to other name servers.
// There are two module-wide locks:
//  InternalLock is set by LockNameServ() which also closes the file
//   and prevents further references to it first waiting for any
//   present activity to cease.
//  ExternalLock is set from GateControl and prevents any further server
//   activity (no lookups are done, no directories are sent or received
//   etc.), but the state of the file isn't altered.
// NameServ is logically part of the miscellaneous services process,
//  handling the Name Lookup Protocol packet types.

//----------------------------------------------------------------------------
let NameServ(pbi) be
//----------------------------------------------------------------------------
[
ExchangePorts(pbi)
switchon pbi>>PBI.pup.type into
   [
   case ptNetDirLookup:
      [
      if ns>>NS.globalLocks eq 0 then
         [ NameLookup(pbi); return ]
      endcase
      ]
   case ptNetDirVersion:
      [
      if ns>>NS.globalLocks eq 0 then
         switchon Usc(pbi>>PBI.pup.words^1, ns>>NS.header>>Hdr.version) into
            [
            case -1:  //tell him we have a later version
               [
               pbi>>PBI.pup.words^1 = ns>>NS.header>>Hdr.version
               CompletePup(pbi, ptNetDirVersion, pupOvBytes+2)
               return
               ]
            case 1:  //he claims to have a later version
               [ CreateNameCtx(ReceiveNetDir, rcvrLock); endcase ]
            case 0:  //our versions are the same
               endcase
         ]
      endcase
      ]
   case ptSendNetDir:
      [
      if ns>>NS.globalLocks eq 0 then
         [
         MoveBlock(lv ns>>NS.reqPort, lv pbi>>PBI.pup.words^1, lenPort)
         CreateNameCtx(SendNetDir, sendLock)
         ]
      endcase
      ]
   case ptNetDirStatsRequest:
      [
      MoveBlock(lv pbi>>PBI.pup.words, lv ns>>NS.stats, size Stats/16)
      CompletePup(pbi, ptNetDirStatsReply, pupOvBytes+size Stats/8)
      return
      ]
   case ptNetDirLockRequest:
      [
      if Authenticate(pbi) then
         [
         ns>>NS.externalLock = true
         CompletePup(pbi, ptNetDirLockReply, pupOvBytes)
         return
         ]
      endcase
      ]
   case ptNetDirUnlockRequest:
      [
      if Authenticate(pbi) then
         [
         ns>>NS.bcstTimer = 0
         ns>>NS.externalLock = false
         CompletePup(pbi, ptNetDirUnlockReply, pupOvBytes)
         return
         ]
      endcase
      ]
   ]
ReleasePBI(pbi)
]

//----------------------------------------------------------------------------
and Authenticate(pbi) = pbi>>PBI.pup.id^1 eq 27182
//----------------------------------------------------------------------------

//----------------------------------------------------------------------------
and NameServCtx(ctx) be  //a process
//----------------------------------------------------------------------------
[
Dismiss(500)	// 5 seconds

// destroy any contexts which are done
compiletest nova
   ifso
      [
      while ns>>NS.doneQ.head ne 0 do
         ReleasePBI(Dequeue(lv ns>>NS.doneQ)-offset PBI.pup/16)
      ]
   ifnot
      [
      while ns>>NS.doneQ.head ne 0 do
         Free(ms>>MS.zone, Dequeue(lv ns>>NS.doneQ))
      ]

// only garbage collect transient processes if global lock is set
if ns>>NS.globalLocks ne 0 loop

if ns>>NS.bcstTimer gr 0 then
   ns>>NS.bcstTimer = ns>>NS.bcstTimer -1
if ns>>NS.bcstTimer eq 0 then
   CreateNameCtx(ReceiveNetDir, rcvrLock)

] repeat

//----------------------------------------------------------------------------
and CreateNameCtx(proc, lockMask) be
//----------------------------------------------------------------------------
[
if ns>>NS.globalLocks ne 0 % (ns>>NS.localLocks & lockMask) ne 0 return
ns>>NS.localLocks = ns>>NS.localLocks % lockMask

let ctx = alto? Allocate(ms>>MS.zone, 1200, true), valof
   [  //nova case
   let pbi = GetPBI(ms>>MS.soc, true)
   resultis pbi eq 0? 0, lv pbi>>PBI.pup
   ]
test ctx ne 0
   ifso
      [
      InitializeContext(ctx, (alto? 1200, lenPup), proc, NCTXextra)
      ctx>>NCTX.lockMask = lockMask
      Enqueue(ms>>MS.ctxQ, ctx)
      ]
   ifnot ns>>NS.localLocks = ns>>NS.localLocks & not lockMask
]

//----------------------------------------------------------------------------
and DestroyNameCtx(ctx) be
//----------------------------------------------------------------------------
// This doesn't actually destroy it.  It releases ctx's locks
//  and queues it for destruction by NameCtx.
[
Unqueue(ms>>MS.ctxQ, ctx)
Enqueue(lv ns>>NS.doneQ, ctx)
ns>>NS.localLocks = ns>>NS.localLocks & not ctx>>NCTX.lockMask
]

//----------------------------------------------------------------------------
and SendNetDir(ctx) be	// a context
//----------------------------------------------------------------------------
[
let eftp = vec lenEFTP; Zero(eftp, lenEFTP)
eftp>>EFTP.frnPort = lv ns>>NS.reqPort
eftp>>EFTP.fp = lv ns>>NS.fp
eftp>>EFTP.realName = ns>>NS.name
eftp>>EFTP.timeOut1 = 1000
eftp>>EFTP.timeOut2 = 1000
if PupServSend(eftp) then DoubleIncrement(lv ns>>NS.stats.dirReqs)
DestroyNameCtx(ctx)
// returning from a context does an implicit Block()
]

//----------------------------------------------------------------------------
and ReceiveNetDir(ctx) be	// a context
//----------------------------------------------------------------------------
//probe all name servers on all directly connected networks
//If we locate a newer version, get it.
[
ns>>NS.bcstTimer = ns>>NS.bcstInterval

let soc = vec lenPupSoc; OpenLevel1Socket(soc, 0, table [ 0; 0; psMiscServ ])
let pbi = GetPBI(soc)
pbi>>PBI.allNets = true  // broadcast request on all nets
pbi>>PBI.pup.words^1 = ns>>NS.header>>Hdr.version
CompletePup(pbi, ptNetDirVersion, pupOvBytes+2)

let bestSoFar = ns>>NS.header>>Hdr.version
let timer = nil; SetTimer(lv timer, 1000)  //10 seconds
let frnPort = vec lenPort 
   [
   Block()
   until soc>>PupSoc.iQ.head eq 0 do
      [
      let pbi = Dequeue(lv soc>>PupSoc.iQ)
      if pbi>>PBI.pup.type eq ptNetDirVersion &
       pbi>>PBI.pup.words^1 ugr bestSoFar then
         [
         bestSoFar = pbi>>PBI.pup.words^1
         MoveBlock(frnPort, lv pbi>>PBI.pup.sPort, lenPort)
         ]
      ReleasePBI(pbi)
      ]
   ] repeatuntil TimerHasExpired(lv timer)

CloseLevel1Socket(soc)

if bestSoFar ugr ns>>NS.header>>Hdr.version then
   [
   let eftp = vec lenEFTP; Zero(eftp, lenEFTP)
   eftp>>EFTP.frnPort = frnPort
   eftp>>EFTP.fp = lv ns>>NS.fp
   eftp>>EFTP.realName = ns>>NS.name
   eftp>>EFTP.tempName = "TEMP.NS"
   eftp>>EFTP.timeOut1 = 100
   eftp>>EFTP.timeOut2 = 3000  //20 seconds
   eftp>>EFTP.proc1 = NSStartProc
   eftp>>EFTP.proc2 = NSEndProc
   if PupServReceive(eftp) then UnlockNameServ()
   loop  //notify world
   ]

DestroyNameCtx(ctx)
Block()
] repeat

//----------------------------------------------------------------------------
and NSStartProc(soc) be
//----------------------------------------------------------------------------
[
let pbi = GetPBI(soc, true); if pbi ne 0 then
   [
   MoveBlock(lv pbi>>PBI.pup.words, lv soc>>PupSoc.lclPort, lenPort)
   CompletePup(pbi, ptSendNetDir, pupOvBytes + lenPort*2)
   ]
]

//----------------------------------------------------------------------------
and NSEndProc(stream) be LockNameServ(CtxRunning>>NCTX.lockMask)
//----------------------------------------------------------------------------
// This is only called if the directory was correctly received.
// ServEFTPReceive is about to delete the old version and rename the new
//  version.  It will then return true and ReceiveNetDir will unlock it.