// 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.