// GateConName.bcpl -- talks to the Name server
// Last modified July 2, 1983  10:23 PM by Boggs

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

external
[
// outgoing procedures
CreateNameCtx; RestartName; Name; NameSummary

// incoming procedures
OpenLevel1Socket; CloseLevel1Socket
GetBuf; ReleasePBI; AppendStringToPup; GetPartner
Zero; MoveBlock; Allocate; Free; Enqueue; ReturnFrom
InitializeContext; Block; SetTimer; TimerHasExpired; Noop
Ws; Wss; PutTemplate; Puts; PrintPort; GetString; Confirm
ResetCmdMenu; CreateCmdBox; TopLevel; BoxProc
SendCommand; MiscCmd

// incoming statics
dsp; sysZone; ctxQ; gcHost; oldStatsQ; wheel
]

static @nu

structure NU:		// nu -> this 'global frame' for this module
[
soc word		// -> PupSoc
stats word		// -> Name Server Stats block
timer word		// update stats when this expires
]
manifest lenNU = size NU/16

//----------------------------------------------------------------------------
let CreateNameCtx() be
//----------------------------------------------------------------------------
[
Enqueue(ctxQ, InitializeContext(Allocate(sysZone, 150), 150, NameCtx))
nu = Allocate(sysZone, lenNU); Zero(nu, lenNU)
nu>>NU.soc = Allocate(sysZone, lenPupSoc); OpenLevel1Socket(nu>>NU.soc)
]

//---------------------------------------------------------------------------
and RestartName() be
//---------------------------------------------------------------------------
[
SetTimer(lv nu>>NU.timer, 0)
if nu>>NU.stats ne 0 then
   [ Enqueue(oldStatsQ, nu>>NU.stats); nu>>NU.stats = 0 ]
]

//----------------------------------------------------------------------------
and Name() be
//----------------------------------------------------------------------------
[
ResetCmdMenu()
CreateCmdBox(TopLevel, "TopLevel")
CreateCmdBox(NameToAddress, "Name->Address")
CreateCmdBox(AddressToName, "Address->Name")
if gcHost ne 0 then
   [
   CreateCmdBox(NameStats, "NameStats")
   CreateCmdBox(NetDirVersion, "NetDirVersion")
   if wheel then
      [
      CreateCmdBox(LockName, "Lock")
      CreateCmdBox(UnlockName, "Unlock")
      ]
   ]
// ResetCmdMenu destroyed the BoxQ which BoxProc is following.
// If we just return now, BoxProc will get horribly confused.
// So don't let it continue: force a return from BoxProc.
ReturnFrom(BoxProc)
]

//----------------------------------------------------------------------------
and NameCtx(ctx) be  //a context
//----------------------------------------------------------------------------
[
Block() repeatuntil TimerHasExpired(lv nu>>NU.timer) & gcHost ne 0
SetTimer(lv nu>>NU.timer, 1000)  // 10 sec
let pbi = GetBuf(nu>>NU.soc)
pbi>>PBI.pup.dPort.socket↑2 = psMiscServ
pbi = SendCommand(pbi, ptNetDirStatsRequest, pupOvBytes, (nu>>NU.stats? 1, 3))
if pbi ne 0 then
   [
   let stats = lv pbi>>PBI.pup.words
   if pbi>>PBI.pup.type eq ptNetDirStatsReply &
    stats>>Stats.version eq nameStatsVersion then
      [
      if nu>>NU.stats then Enqueue(oldStatsQ, nu>>NU.stats)
      let lenStatBlock = (pbi>>PBI.pup.length-pupOvBytes+1)/2
      nu>>NU.stats = Allocate(sysZone, lenStatBlock)
      MoveBlock(nu>>NU.stats, stats, lenStatBlock)
      ]
   ReleasePBI(pbi)
   ]
] repeat

//----------------------------------------------------------------------------
and NameSummary(stream) be
//----------------------------------------------------------------------------
[
if nu>>NU.stats ne 0 then
   PutTemplate(stream, "Name: $EUD  ", lv nu>>NU.stats>>Stats.nameReqs)
]

//----------------------------------------------------------------------------
and NameStats() be
//----------------------------------------------------------------------------
[
let oldStats = nu>>NU.stats
SetTimer(lv nu>>NU.timer, 0)
let timer = nil; SetTimer(lv timer, 500)  // 5 sec
Block() repeatuntil TimerHasExpired(lv timer) % nu>>NU.stats ne oldStats
test nu>>NU.stats ne oldStats
   ifso Ws("*NName Server stats:")
   ifnot
      [
      Ws("*NThe Name Server doesn't answer.")
      if nu>>NU.stats ne 0 then
         Ws("*NWhen last heard from its stats were:")
      ]
if nu>>NU.stats ne 0 then
   [
   PutTemplate(dsp, "*NLookups: $EUD  Dirs Sent: $EUD  Cache Hits: $EUD  Cache Misses: $EUD",
    lv nu>>NU.stats>>Stats.nameReqs, lv nu>>NU.stats>>Stats.dirReqs,
    lv nu>>NU.stats>>Stats.cacheHits, lv nu>>NU.stats>>Stats.cacheMisses)
   ]
]

//---------------------------------------------------------------------------
and NameToAddress() be
//---------------------------------------------------------------------------
[
let name = vec 128; unless GetString("*NName: ", name) return
Lookup(ptNetDirLookup, name)
]

//---------------------------------------------------------------------------
and AddressToName() be
//---------------------------------------------------------------------------
[
let name = vec 128; unless GetString("*NAddress: ", name) return
let port = vec lenPort; unless GetPartner(name, dsp, port) return
Lookup(ptNetDirLookup1, port)
]

//---------------------------------------------------------------------------
and Lookup(type, arg) be
//---------------------------------------------------------------------------
[
let soc = vec lenPupSoc; OpenLevel1Socket(soc)
let pbi = GetBuf(soc)
pbi>>PBI.pup.dPort.socket↑2 = psMiscServ
test type eq ptNetDirLookup
   ifso AppendStringToPup(pbi, 1, arg)
   ifnot
      [
      MoveBlock(lv pbi>>PBI.pup.words, arg, lenPort)
      pbi>>PBI.pup.length = pupOvBytes +6
      ]
pbi = SendCommand(pbi, type)
test pbi ne 0
   ifso
      [
      switchon pbi>>PBI.pup.type into
         [
         case ptNetDirReply1:
         case ptNetDirError:
            [
            for i = 1 to pbi>>PBI.pup.length-pupOvBytes do
               Puts(dsp, pbi>>PBI.pup.bytes↑i)
            endcase
            ]
         case ptNetDirReply:
            [
            for i = 1 to pbi>>PBI.pup.length-pupOvBytes by 6 do
               PutTemplate(dsp, "$P ", PrintPort, lv pbi>>PBI.pup.bytes↑i)
            endcase
            ]
         ]
      ReleasePBI(pbi)
      ]
   ifnot Ws(" - no response")
CloseLevel1Socket(soc)
]

//----------------------------------------------------------------------------
and NetDirVersion() be
//----------------------------------------------------------------------------
[
let version = 0
MiscCmd(ptNetDirVersion, ptNetDirVersion, PrintVersion, lv version, 1)
]

//----------------------------------------------------------------------------
and PrintVersion(pbi) be
//----------------------------------------------------------------------------
   PutTemplate(dsp, "*NNetDir version = $UD", pbi>>PBI.pup.words↑1)

//----------------------------------------------------------------------------
and LockName() be if Confirm("*NLock Name Server") then
//----------------------------------------------------------------------------
   MiscCmd(ptNetDirLockRequest, ptNetDirLockReply, Noop)

//----------------------------------------------------------------------------
and UnlockName() be MiscCmd(ptNetDirUnlockRequest, ptNetDirUnlockReply, Noop)
//----------------------------------------------------------------------------