// IfsNameServ.bcpl - Name lookup server
// adapted from the one used in gateways
// Copyright Xerox Corporation 1979, 1981
// Last modified December 5, 1981 3:26 PM by Taft
get "Pup0.decl"
get "Pup1.decl"
get "Ifs.decl"
get "Streams.d"
get "IfsNameServ.decl"
external
[
// outgoing procedures
NameServ; NameLookup; AddressLookup
NameCompareKey; AddressCompareKey
// incoming procedures
NameServUncommon; ReadRecLE
ExchangePorts; CompletePup; ReleasePBI; AppendStringToPup
ExtractSubstring; StringCompare; CreateStringStream
Gets; Puts; Closes; CurrentPos; Wss; PutTemplate
DoubleIncrement; DoubleUsc; Lock; Unlock; ErrorCodeToString; ByteBlt
SysAllocate; SysFree; FreePointer; Zero; MoveBlock; TruePredicate; Max
// outgoing statics
@ns
// incoming statics
lenPup; maxPupDataBytes
]
static [ @ns ]
//----------------------------------------------------------------------------
structure NLS: // Name Lookup State -- internal to NameLookup
//----------------------------------------------------------------------------
[
resultVec word // -> resultVec passed by caller
nResultPorts word // number of ports currently in resultVec
maxResultPorts word // maximum number of ports that will fit in resultVec
tempVec word // -> temporary copy of resultVec
nTempPorts word // number of ports currently in tempVec
]
manifest lenNLS = size NLS/16
//----------------------------------------------------------------------------
let NameServ(pbi) be
//----------------------------------------------------------------------------
[
ExchangePorts(pbi)
let res = ecNameServerDisabled
switchon pbi>>PBI.pup.type into
[
case ptNameLookup:
[
if ns>>NS.globalLocks eq 0 then
[
DoubleIncrement(lv ns>>NS.stats.nameReqs)
let name = ExtractSubstring(lv pbi>>PBI.pup, offset Pup.bytes/8,
pbi>>PBI.pup.length-3)
res = NameLookup(name, lv pbi>>PBI.pup.bytes, maxNPorts*lenPort)
SysFree(name)
if res ls ecNameFirst then
[
CompletePup(pbi, ptNameReply, res*(lenPort*2)+pupOvBytes)
return
]
]
endcase
]
case ptAddressLookup:
[
if ns>>NS.globalLocks eq 0 then
[
DoubleIncrement(lv ns>>NS.stats.nameReqs)
// Use the rest of the pbi as a region in which to return a string
let string = lv pbi>>PBI.pup.words↑(lenPort+1)
let ss = CreateStringStream(string, maxPupDataBytes-2*lenPort)
res = AddressLookup(ss, lv pbi>>PBI.pup.words↑1)
Closes(ss)
if res eq 0 then
[ // Slide the result text down to the right place
let length = string>>String.length
ByteBlt(lv pbi>>PBI.pup.bytes, 0, string, 1, length)
CompletePup(pbi, ptAddressReply, pupOvBytes+length)
return
]
]
endcase
]
default:
NameServUncommon(pbi)
return
]
// Get here only to handle errors. res contains the error code.
test res eq ecNameServerDisabled
ifso ReleasePBI(pbi) // if server is locked do nothing
ifnot // otherwise, generate error reply
[
let errorString = ErrorCodeToString(res)
AppendStringToPup(pbi, 1, errorString)
SysFree(errorString)
CompletePup(pbi, ptNetDirError)
]
]
//----------------------------------------------------------------------------
and NameLookup(string, resultVec, lenResultVec) = valof
//----------------------------------------------------------------------------
// Attempts to interpret string as a Pup name expression.
// lenResultVec should be the length of resultVec in words.
// If successful, stores the result as an array of ports in resultVec and
// returns the number of ports.
// If unsuccessful, returns an error code (ge ecNameFirst).
[
// Set up lookup state and initialize reply to a single zero port
let nls = vec lenNLS
nls>>NLS.resultVec = resultVec
nls>>NLS.maxResultPorts = lenResultVec/lenPort
nls>>NLS.nResultPorts = 1
Zero(resultVec, lenPort)
nls>>NLS.tempVec = SysAllocate(lenResultVec)
// Set up to parse the name string
let ss = CreateStringStream(string)
ss>>ST.error = TruePredicate // return -1 at end of string
let name = 0 // no names parsed yet
let result = valof
[
[ // repeat
// Collect text up to next $+ or end of string
let char = nil; char = Gets(ss) repeatwhile char eq $*s
if char eq -1 break
let first = CurrentPos(ss)-1
let last = first-1
until char eq $+ % char le $*s % char ge $*177 do
[ char = Gets(ss); last = last+1 ]
while char eq $*s do char = Gets(ss)
unless (char eq $+ % char eq -1) & last ge first resultis ecNameIllegal
name = ExtractSubstring(string, first, last)
MoveBlock(nls>>NLS.tempVec, resultVec, lenResultVec)
nls>>NLS.nTempPorts = nls>>NLS.nResultPorts
nls>>NLS.nResultPorts = 0
// Try to parse as address constant
let port = vec lenPort
if ParseAddressConstant(name, port) then
[ CrossPort(nls, port); SysFree(name); loop ]
// Not address constant. Lookup name in directory B-tree
let ndte = 0
Lock(lv ns>>NS.treeLock)
if ns>>NS.tree ne 0 then
[
ndte = ReadRecLE(ns>>NS.tree, name, NameCompareKey)
if ndte ne 0 then
unless NameCompareKey(name, ndte) eq 0 do FreePointer(lv ndte)
]
Unlock(lv ns>>NS.treeLock)
SysFree(name)
if ndte eq 0 then
resultis ns>>NS.tree ne 0? ecNameNotFound, ecNameServerDisabled
// Compute intersection of new entry with preceding terms of expression.
let iPort = offset NDTE.name.string/16 +
(ndte>>NDTE.name.string.length rshift 1) +1
while iPort ls ndte>>NDTE.length do
[ CrossPort(nls, ndte+iPort); iPort = iPort+lenPort ]
SysFree(ndte)
] repeat
// Reached end of request string. If result is empty, the intersection
// of terms in the expression was empty. This is an error.
resultis nls>>NLS.nResultPorts eq 0? ecNameInconsistent,
name eq 0? ecNameIllegal, nls>>NLS.nResultPorts
]
SysFree(nls>>NLS.tempVec)
Closes(ss)
resultis result
]
//----------------------------------------------------------------------------
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, char, len = 0, nil, string>>String.length
[ // repeat
[ // repeat
c = c+1; if c gr len resultis true
char = string>>String.char↑c
if char ls $0 % char gr $7 break
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
] repeat
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(nls, port) be
//----------------------------------------------------------------------------
[
for t = 0 to nls>>NLS.nTempPorts-1 do
[
let tPort = nls>>NLS.tempVec + t*lenPort
unless (tPort>>Port.net ne 0 & port>>Port.net ne 0 &
tPort>>Port.net ne port>>Port.net ) %
(tPort>>Port.host ne 0 & port>>Port.host ne 0 &
tPort>>Port.host ne port>>Port.host ) %
((tPort>>Port.socket↑1 ne 0 % tPort>>Port.socket↑2 ne 0) &
(port>>Port.socket↑1 ne 0 % port>>Port.socket↑2 ne 0) &
(tPort>>Port.socket↑1 ne port>>Port.socket↑1 %
tPort>>Port.socket↑2 ne port>>Port.socket↑2)) do
[
if nls>>NLS.nResultPorts eq nls>>NLS.maxResultPorts return
let rPort = nls>>NLS.resultVec + nls>>NLS.nResultPorts*lenPort
nls>>NLS.nResultPorts = nls>>NLS.nResultPorts+1
for i = 0 to lenPort-1 do rPort!i = tPort!i % port!i
]
]
]
//----------------------------------------------------------------------------
and AddressLookup(stream, port) = valof
//----------------------------------------------------------------------------
// Attempts to look up the address designated by port. If successful,
// outputs the resulting name text to stream and returns zero.
// If unsuccessful, returns an error code.
[
Lock(lv ns>>NS.treeLock)
let result = valof
[
if ns>>NS.tree eq 0 resultis ecNameServerDisabled
unless ConvertPort(stream, port) do
[
let iPort = vec lenPort
iPort!0 = port!0; iPort!1 = 0; iPort!2 = 0 // just net and host
unless ConvertPort(stream, iPort) resultis ecAddressNotFound
Puts(stream, $+)
iPort!0 = 0; iPort!1 = port!1; iPort!2 = port!2 // just socket
unless ConvertPort(stream, iPort) do
PutTemplate(stream, "$UEO", lv iPort>>Port.socket)
]
resultis 0
]
Unlock(lv ns>>NS.treeLock)
resultis result
]
//----------------------------------------------------------------------------
and ConvertPort(stream, port) = valof
//----------------------------------------------------------------------------
[
let ndte = ReadRecLE(ns>>NS.tree, port, AddressCompareKey)
let res = false
if ndte ne 0 & AddressCompareKey(port, ndte) eq 0 then
[ Wss(stream, lv ndte>>NDTE.address.string); res = true ]
FreePointer(lv ndte)
resultis res
]
//----------------------------------------------------------------------------
and NameCompareKey(key, ndte) =
//----------------------------------------------------------------------------
// CompareKey routine handed to the B-tree package to look up names.
// key is a string. Note that all names are "less than" all addresses.
// Careful: StringCompare may return -2 (initial substring match),
// which is not acceptable to the B-Tree package.
ndte>>NDTE.type eq ndteTypeAddress? -1,
Max(StringCompare(key, lv ndte>>NDTE.name.string), -1)
//----------------------------------------------------------------------------
and AddressCompareKey(key, ndte) =
//----------------------------------------------------------------------------
// CompareKey routine handed to the B-tree package to look up addresses.
// key is a port. Note that all addresses are "greater than" all names.
ndte>>NDTE.type eq ndteTypeName? 1,
DoubleUsc(key, lv ndte>>NDTE.address.port, lenPort)
//----------------------------------------------------------------------------
// and NetDirEntryLength(ndte) = ndte>>NDTE.length
//----------------------------------------------------------------------------
// Length routine handed to the B-tree package.
// Hand-coded in IfsNameA.asm for speed -- the B-tree package calls it a lot.