// PupNameCore.bcpl - Name lookup server
// See also PupNameServ.bcpl, PupNameInit.bcpl PupNameServ.decl
// Last modified March 5, 1979 11:48 PM by Boggs
get "Pup0.decl"
get "Pup1.decl"
get "Streams.d"
get "PupNameServ.decl"
external
[
// outgoing procedures
LockNameServ; UnlockNameServ; NameLookup
// incoming procedures
OpenFile; Closes; Gets; SetFilePos; ReadBlock
MoveBlock; Zero; MultEq; Min; Max; DoubleIncrement
Enqueue; Dequeue; Unqueue; InsertAfter
InitializeZone; Allocate; Free; CallSwat; Block
Dismiss; GetPBI; ReleasePBI
CompletePup; AppendStringToPup
// incoming statics
lenPup; @ms; @ns
]
//----------------------------------------------------------------------------
let LockNameServ(lockMask; numargs na) be
//----------------------------------------------------------------------------
// Shut down the name server, returning when everything has stopped.
// Special case: if an arument is passed, then one of the transient
// processes wants to lock it, so ignore his local lock.
[
ns>>NS.internalLock = true
Block() repeatuntil ns>>NS.localLocks eq (na eq 1? lockMask, 0)
if ns>>NS.stream ne 0 then
[
Closes(ns>>NS.stream)
ns>>NS.stream = 0
]
]
//----------------------------------------------------------------------------
and UnlockNameServ() be
//----------------------------------------------------------------------------
[
ns>>NS.internalLock = false
ns>>NS.name = alto? "Pup-Network.directory", "PUPNET.DIR"
// Open the directory file and read its header block
Zero(lv ns>>NS.fp, 5)
ns>>NS.stream = OpenFile(ns>>NS.name, ksTypeReadOnly, charItem,
0, lv ns>>NS.fp)
if ns>>NS.stream eq 0 return
ReadBlock(ns>>NS.stream, ns>>NS.header, lenHdr)
// Read the name lookup table and save the positions of the first
// and last name blocks. Use cacheZone as a temporary buffer.
SetDirPos(ns>>NS.header>>Hdr.firstName)
let left = ns>>NS.header>>Hdr.numNames
let cacheZone = ns>>NS.cacheZone
let firstNamePos = 32767
let lastNamePos = 0
while left gr 0 do
[
Dismiss(1)
ReadBlock(ns>>NS.stream, cacheZone, lenCacheZone)
for i = 0 to Min(left, lenCacheZone)-1 do
[
firstNamePos = Min(firstNamePos, cacheZone!i)
lastNamePos = Max(lastNamePos, cacheZone!i)
]
left = left-lenCacheZone
]
ns>>NS.firstNamePos = firstNamePos
ns>>NS.lastNamePos = lastNamePos
// Invalidate and reinitialize the cache
ns>>NS.cneQ.head = 0
InitializeZone(ns>>NS.cacheZone, lenCacheZone)
]
//----------------------------------------------------------------------------
and NameLookup(pbi) be
//----------------------------------------------------------------------------
[
if ns>>NS.stream eq 0 then [ ReleasePBI(pbi); return ]
// get some PBIs for buffers - punt if none left
ns>>NS.lkupLock = true
ns>>NS.firstPBI = GetPBI(ms>>MS.soc, true)
ns>>NS.secondPBI = GetPBI(ms>>MS.soc, true)
if ns>>NS.firstPBI eq 0 % ns>>NS.secondPBI eq 0 then
[
ReleasePBI(pbi)
if ns>>NS.firstPBI ne 0 then ReleasePBI(ns>>NS.firstPBI)
if ns>>NS.secondPBI ne 0 then ReleasePBI(ns>>NS.secondPBI)
ns>>NS.lkupLock = false
return
]
let buffer = lv ns>>NS.firstPBI>>PBI.pup
DoubleIncrement(lv ns>>NS.stats.nameReqs)
// initialize queues
ns>>NS.freeAddrQ.head = 0
ns>>NS.oldAddrQ.head = 0
ns>>NS.newAddrQ.head = 0
let i = lenString
while i ls lenPup-lenAddr do
[ Enqueue(lv ns>>NS.freeAddrQ, buffer+i); i = i+lenAddr ]
Enqueue(lv ns>>NS.oldAddrQ, GetItem()) // initialize to a single zero item
// Parse the name string
let length = pbi>>PBI.pup.length-pupOvBytes
if length le 0 % length gr 255 then
[ ReturnError(pbi, "Illegal name"); return ]
let bytePos = 0
let endOfData = false
let port = vec lenPort
until endOfData do
[
// Collect text up to next $+ or end of string
bytePos = bytePos+1 //skip previous $+
let byteCount = 0
let char = pbi>>PBI.pup.bytes↑bytePos
while char ne $+ do
[
if char ne $*s then
[
byteCount = byteCount+1
if char ge $a & char le $z then char = char-($a-$A)
if char ls #40 % char ge #177 then
[ ReturnError(pbi, "Illegal character in name"); return ]
buffer>>String.char↑byteCount = char
]
if bytePos ge length then [ endOfData = true; break ]
bytePos = bytePos+1; char = pbi>>PBI.pup.bytes↑bytePos
]
buffer>>String.length = byteCount
buffer>>String.char↑(byteCount+1) = 0 //ensure leftover byte zero
// Try to parse as address constant
if ParseAddressConstant(buffer, port) then
[ CrossPort(port); ResetAddrQueues(); loop ]
// NameLookup (cont'd)
// Not address constant. Lookup name in cache
let cne = SearchNameCache(buffer)
if cne eq 0 then
[
// Not in cache, search the directory on the disk
let name = SearchNetDir(buffer)
// Insert name into cache. Note that we do this whether or not
// it was found on the disk. This is so that retransmissions of
// a failing lookup request will not result in repeated disk searches.
cne = InsertNameInCache(buffer)
// If the name was actually found, insert the corresponding
// address entries into the cache also.
if name ne 0 then
[
let addrPos = ReadDir(name>>Name.entry+addrOffset)
while addrPos ne 0 do
[
SetDirPos(addrPos)
let addr = vec lenAddr
ReadBlock(ns>>NS.stream, addr, lenAddr)
InsertAddrInCache(cne, lv addr>>Addr.port)
addrPos = addr>>Addr.link
]
]
]
// cne now points to cache entry for matching name.
let cae = cne>>CNE.cae
if cae eq 0 then
[ ReturnError(pbi, "Name not found"); return ]
// Compute intersection of new entry with preceding terms of
// the name expression.
while cae ne 0 do
[
CrossPort(lv cae>>CAE.port)
cae = cae>>CAE.link
]
ResetAddrQueues()
]
// Reached end of request string. If queue is empty, the intersection
// of terms in the expression was empty. This is an error.
if ns>>NS.oldAddrQ.head eq 0 then
[ ReturnError(pbi, "Inconsistent expression"); return ]
// Construct reply packet
i = 1
[
let addr = Dequeue(lv ns>>NS.oldAddrQ)
if addr eq 0 break
MoveBlock(lv pbi>>PBI.pup.words↑i, lv addr>>Addr.port, lenPort)
i = i + lenPort
] repeat
CompleteNameReq(pbi, ptNetDirReply, pupOvBytes+(i-1)*2)
]
//----------------------------------------------------------------------------
and ReturnError(pbi, message) be
//----------------------------------------------------------------------------
[
AppendStringToPup(pbi, 1, message)
CompleteNameReq(pbi, ptNetDirError, pbi>>PBI.pup.length)
]
//----------------------------------------------------------------------------
and CompleteNameReq(pbi, type, length) be
//----------------------------------------------------------------------------
[
CompletePup(pbi, type, length)
ReleasePBI(ns>>NS.firstPBI)
ReleasePBI(ns>>NS.secondPBI)
ns>>NS.lkupLock = false
]
//--------------------------------------------------------------------------
and SearchNameCache(name) = valof
//--------------------------------------------------------------------------
// Searches for name in cache. If found, returns pointer to cache name
// entry (cne). If not found, returns zero.
// Assumes name has been converted to upper-case and that the leftover byte
// at the end, if present, is zero.
[
let lenName = name>>String.length rshift 1 +1
let cne = ns>>NS.cneQ.head; while cne ne 0 do
[
if MultEq(name, lv cne>>CNE.string, lenName) then
[ // Found, insert cache entry at front of queue
Unqueue(lv ns>>NS.cneQ, cne)
InsertAfter(lv ns>>NS.cneQ, lv ns>>NS.cneQ, cne)
DoubleIncrement(lv ns>>NS.stats.cacheHits)
resultis cne
]
cne = cne>>CNE.link
]
DoubleIncrement(lv ns>>NS.stats.cacheMisses)
resultis 0
]
//--------------------------------------------------------------------------
and InsertNameInCache(name) = valof
//--------------------------------------------------------------------------
// Creates and returns a cache name entry (cne) containing the supplied
// name string, which is assumed to be all upper-case with the leftover
// byte zeroed.
[
let lenName = name>>String.length rshift 1 +1
let cne = CacheAllocate(lenCNEHeader+lenName)
cne>>CNE.cae = 0
MoveBlock(lv cne>>CNE.string, name, lenName)
InsertAfter(lv ns>>NS.cneQ, lv ns>>NS.cneQ, cne) // Insert at front of queue
resultis cne
]
//--------------------------------------------------------------------------
and InsertAddrInCache(cne, port) be
//--------------------------------------------------------------------------
// Creates a cache address entry (cae) and appends it to the queue rooted
// in the supplied cne.
[
let cae = CacheAllocate(lenCAE)
MoveBlock(lv cae>>CAE.port, port, lenPort)
cae>>CAE.link = 0
let lvCAE = lv cne>>CNE.cae
while lvCAE!0 ne 0 do lvCAE = lvCAE!0
lvCAE!0 = cae
]
//--------------------------------------------------------------------------
and CacheAllocate(nWords) = valof
//--------------------------------------------------------------------------
// Allocates nWords words in the cache and returns pointer
[
// Attempt to allocate the block
let block = Allocate(ns>>NS.cacheZone, nWords, true)
if block ne 0 resultis block
// Failed. Flush one cache entry from tail of queue and try again
if ns>>NS.cneQ.head eq 0 then CallSwat("[CacheAllocate] cneQ empty")
let cne = ns>>NS.cneQ.tail
Unqueue(lv ns>>NS.cneQ, cne)
let cae = cne>>CNE.cae
Free(ns>>NS.cacheZone, cne)
while cae ne 0 do
[
let t = cae>>CAE.link
Free(ns>>NS.cacheZone, cae)
cae = t
]
Block()
] repeat
//----------------------------------------------------------------------------
and ParseAddressConstant(string, port) = valof
//----------------------------------------------------------------------------
// Parses a network address constant of the form
// net#host#socket and sets port accordingly
// Returns:
// true if string had correct syntax
// false otherwise
[
Zero(port, lenPort)
let c, len = 0, string>>String.length
[
let char = nil
[
c = c+1; if c gr len resultis true
char = string>>String.char↑c
] repeatwhile char eq $*s
while char ge $0 & char le $7 do
[
if (port>>Port.socket↑1 & #160000) ne 0 resultis false
port>>Port.socket↑1 = port>>Port.socket↑1 lshift 3 +
port>>Port.socket↑2 rshift 13
port>>Port.socket↑2 = port>>Port.socket↑2 lshift 3 + char-$0
c = c+1; if c gr len resultis true
char = string>>String.char↑c
]
while char eq $*s do
[
c = c+1; if c gr len resultis true
char = string>>String.char↑c
]
if char ne $# % port>>Port.net ne 0 % port>>Port.socket↑1 ne 0
% (port>>Port.socket↑2 & #177400) ne 0 resultis false
port>>Port.net = port>>Port.host
port>>Port.host = port>>Port.socket↑2
port>>Port.socket↑1 = 0; port>>Port.socket↑2 = 0
] repeat
]
//----------------------------------------------------------------------------
and CrossPort(port) be
//----------------------------------------------------------------------------
[
let t = ns>>NS.oldAddrQ.head; while t ne 0 do
[
unless (t>>Addr.port.net ne 0 & port>>Port.net ne 0 &
t>>Addr.port.net ne port>>Port.net ) %
(t>>Addr.port.host ne 0 & port>>Port.host ne 0 &
t>>Addr.port.host ne port>>Port.host ) %
((t>>Addr.port.socket↑1 ne 0 % t>>Addr.port.socket↑2 ne 0) &
(port>>Port.socket↑1 ne 0 % port>>Port.socket↑2 ne 0) &
(t>>Addr.port.socket↑1 ne port>>Port.socket↑1 %
t>>Addr.port.socket↑2 ne port>>Port.socket↑2)) do
[
let i = GetItem()
i>>Addr.port.net = t>>Addr.port.net % port>>Port.net
i>>Addr.port.host = t>>Addr.port.host % port>>Port.host
i>>Addr.port.socket↑1 = t>>Addr.port.socket↑1 % port>>Port.socket↑1
i>>Addr.port.socket↑2 = t>>Addr.port.socket↑2 % port>>Port.socket↑2
Enqueue(lv ns>>NS.newAddrQ, i)
]
t = t>>Addr.link
]
]
//----------------------------------------------------------------------------
and ResetAddrQueues() be
//----------------------------------------------------------------------------
//flush oldAddrQ and then move contents of newAddrQ to oldAddrQ
[
while ns>>NS.oldAddrQ.head ne 0 do
Enqueue(lv ns>>NS.freeAddrQ, Dequeue(lv ns>>NS.oldAddrQ))
MoveBlock(lv ns>>NS.oldAddrQ, lv ns>>NS.newAddrQ, 2)
ns>>NS.newAddrQ.head = 0
]
//----------------------------------------------------------------------------
and GetItem() = valof
//----------------------------------------------------------------------------
[
let item = Dequeue(lv ns>>NS.freeAddrQ)
if item eq 0 then CallSwat("[GetItem] freeAddrQ exhausted")
Zero(item, lenAddr)
resultis item
]
//----------------------------------------------------------------------------
and ReadDir(pos; numargs na) = valof
//----------------------------------------------------------------------------
[
if na ne 0 then SetDirPos(pos)
let temp = Gets(ns>>NS.stream)
resultis temp lshift 8 + Gets(ns>>NS.stream)
]
//----------------------------------------------------------------------------
and SetDirPos(pos) be
//----------------------------------------------------------------------------
[
Dismiss(1)
// assume file length is less than 2↑15-1
SetFilePos(ns>>NS.stream, 0, pos lshift 1)
]
//--------------------------------------------------------------------------
and SearchNetDir(key) = valof
//--------------------------------------------------------------------------
// Searches the network directory on disk for the specified name.
// If found, returns a pointer to a copy of the matching Name block.
// If not found, returns zero.
// Supplied key must be all upper-case.
[
let nameBlock = lv ns>>NS.secondPBI>>PBI.pup
// Position to first name block in file
let pos = ns>>NS.firstNamePos //current displacement in file
SetDirPos(pos)
let disp = lenPup //current displacement in nameBlock
// Do linear search through name block portion of file
while pos le ns>>NS.lastNamePos do
[
if disp ge lenPup-lenString then
[
// Need to refill nameBlock.
// Move remaining stuff down to beginning of block, then fill
// remainder of block from file.
Dismiss(1)
let remainder = lenPup-disp
if remainder gr 0 then
MoveBlock(nameBlock, nameBlock+disp, remainder)
ReadBlock(ns>>NS.stream, nameBlock+remainder, disp)
disp = 0
]
// Get pointer to current name block and advance disp to next.
// Know that name blocks are contiguous and a multiple of 2 words long.
let name = nameBlock + disp
let inc = (lenNameHeader + name>>Name.string.length rshift 1 +2) & -2
disp = disp + inc
pos = pos + inc
// Compare key with string in name block
if key>>String.length ne name>>Name.string.length loop
if valof
[
for i = 1 to key>>String.length do
[
let keyChar = key>>String.char↑i
let dirChar = name>>Name.string.char↑i
if dirChar ge $a & dirChar le $z then dirChar = dirChar - ($a-$A)
if keyChar ne dirChar resultis false
]
resultis true
] resultis name
]
// Not found, return failure.
resultis 0
]