// PupNetDirLookup.bcpl -- Network directory lookup routines.
// requires functions up to and including Pup level 1
// Copyright Xerox Corporation 1981, 1982, 1983
// Last modified September 18, 1983 1:09 PM by Taft
get "Pup0.decl"
get "Pup1.decl"
get "PupNetDir.decl"
external
[
// outgoing procedures
GetPartner; EnumeratePupAddresses; PupAddressLookup; ParseAddressConstant
// incoming procedures
OpenLevel1Socket; CloseLevel1Socket; CompletePup
GetPBI; ReleasePBI; AppendStringToPup; LocateNet; FlushQueue
SetTimer; TimerHasExpired; Block; Dismiss; Dequeue; Min
DefaultArgs; Wss; MoveBlock; Zero; SetBlock; Allocate
// incoming statics
pupRT; pupZone
]
manifest
[
psMiscServ = 4 // well-known socket
ptNameLookup = 220B // Pup types
ptNameReply = 221B
ptAddressLookup = 223B
ptAddressReply = 224B
ptNetDirError = 222B
maxNPorts = 35 // max number of ports we'll consider in answer
]
//----------------------------------------------------------------------------
let GetPartner(name, stream, port, s1, s2; numargs na) = valof
//----------------------------------------------------------------------------
// Looks up name to yield a single port. If name evaluates to multiple
// ports, chooses the closest, based on routing table hop counts.
// If all the ports are inaccessible, gives an error.
// Stream is an output character stream for error messages; zero if none.
// name is the name to lookup - a bcpl string.
// port is a pointer to a 3 word area where the answer goes.
// s1 and s2 are put into the socket field of port if the
// answer has zero there. These may be omitted.
// Returns true if successful, false if unsuccessful.
// This procedure is compatible with the old GetPartner procedure of
// previous Pup packages (PupNameLookup.bcpl), but is implemented
// entirely differently.
[
let ec = EnumeratePupAddresses(name, TakeTheFirst, port)
test ec eq 0
ifso if na ge 5 &
port>>Port.socket↑1 eq 0 & port>>Port.socket↑2 eq 0 then
[ port>>Port.socket↑1 = s1; port>>Port.socket↑2 = s2 ]
ifnot if stream ne 0 then
Wss(stream, selecton ec into
[
case ecNoServerResponded: "No name server responded"
case ecCantGetThere: "Can't get there from here"
// case ecNameNotFound:
default: "Name not found"
])
resultis ec eq 0
]
//----------------------------------------------------------------------------
and TakeTheFirst(argPort, resultPort) = valof
//----------------------------------------------------------------------------
[
MoveBlock(resultPort, argPort, lenPort)
resultis true
]
//----------------------------------------------------------------------------
and EnumeratePupAddresses(name, filter, arg, dontCheckRT; numargs na) = valof
//----------------------------------------------------------------------------
// Evaluates name to one or more addresses. For each address, calls
// filter(port, arg), where port is that address and arg is the arg passed
// to EnumeratePupAddresses. If filter returns true, enumeration stops; if
// false, enumeration continues. Ordinarily the addresses are enumerated in
// order of increasing distance away from here (hop count), and inaccessible
// addresses are omitted; however, if dontCheckRT is supplied and true,
// the addresses are not sorted and are all returned.
// Filter defaults to TakeTheFirst, which treats arg as a pointer to a Port
// and copies the first Pup address to that port, discarding the rest.
// Returns zero if successful and an error code (from PupNetDir.decl)
// if unsuccessful.
[
DefaultArgs(lv na, -1, TakeTheFirst, 0, false)
let soc = vec lenPupSoc-1
let pbi = 0
let ports = soc // use as port only if ParseAddressConstant succeeds
let nPorts = 1
unless ParseAddressConst(name, ports) do
[ // consult network directory server
// Default transient local port, zero foreign port
OpenLevel1Socket(soc, 0, 0, true)
soc>>PupSoc.frnPort.socket↑2 = psMiscServ
for try = 1 to 20 do
[
pbi = GetPBI(soc)
AppendStringToPup(pbi, 1, name)
pbi>>PBI.allNets = true // send on all directly connected nets
CompletePup(pbi, ptNameLookup)
let wait = nil; SetTimer(lv wait, 100) // 1 sec
[ // repeat
Block()
pbi = Dequeue(lv soc>>PupSoc.iQ)
if pbi ne 0 then
[
switchon pbi>>PBI.pup.type into
[
case ptNetDirError:
ReleasePBI(pbi)
CloseLevel1Socket(soc)
resultis ecNameNotFound
case ptNameReply:
try = 20 // out of for loop
break
]
ReleasePBI(pbi)
]
] repeatuntil TimerHasExpired(lv wait)
]
if pbi eq 0 then
[ CloseLevel1Socket(soc); resultis ecNoServerResponded ]
ports = lv pbi>>PBI.pup.bytes
nPorts = Min((pbi>>PBI.pup.length-pupOvBytes)/6, maxNPorts)
]
// EnumeratePupAddresses (cont'd)
// Obtain hop counts for sorting
let hopsVec = vec maxNPorts-1
SetBlock(hopsVec, (dontCheckRT? 0, maxHops+1), nPorts)
let nRoutesFound = 0
test dontCheckRT
ifso // Return all the ports that we got
nRoutesFound = nPorts
ifnot // Look up route for each port
for try = 0 to 20 do
[
// Even tries just look in the routing table; odd tries initiate probes.
// The purpose of this dance is to get all the information we can from the
// existing routing table before initiating probes that might displace
// useful entries already there. This can happen if the name we are looking
// up maps to more networks than there are entries in the routing cache.
let dontProbe = (try & 1) eq 0
for i = 0 to nPorts-1 do
if hopsVec!i gr maxHops then
[
let rte = LocateNet((ports+i*lenPort)>>Port.net, dontProbe)
if rte ne 0 then
[
hopsVec!i = rte>>RTE.hops
if hopsVec!i le maxHops then nRoutesFound = nRoutesFound+1
]
]
if nRoutesFound eq nPorts % (nRoutesFound gr 0 & try ge 4) break
unless dontProbe do Dismiss(100)
// In case multiple answers came back, don't hog PBIs
if pbi ne 0 then FlushQueue(lv soc>>PupSoc.iQ)
]
// Emit answers in increasing order of hop count, being careful to maintain
// the existing order of addresses at equal distances.
// This is effectively an n↑2 sort, but n is small, right?
let hops = 0
while hops le maxHops do
[
let nextHops = maxHops+1
for i = 0 to nPorts-1 do
[
if hopsVec!i eq hops & filter(ports+i*lenPort, arg) then
[ nextHops = maxHops+1; break ]
if hopsVec!i gr hops then nextHops = Min(nextHops, hopsVec!i)
]
hops = nextHops
]
if pbi ne 0 then [ ReleasePBI(pbi); CloseLevel1Socket(soc) ]
resultis nRoutesFound eq 0? ecCantGetThere, 0
]
//----------------------------------------------------------------------------
and PupAddressLookup(port, lvEC, zone; numargs na) = valof
//----------------------------------------------------------------------------
// Interacts with a network directory server to find a name string corresponding
// to the Pup address pointed to by port. If successful, returns a string
// allocated from zone (which defaults to pupZone). If unsuccessful, stores
// an error code (see PupNetDir.decl) at @lvEC (which may be omitted) and
// returns zero.
[
DefaultArgs(lv na, -1, lv na, pupZone)
let soc = vec lenPupSoc-1
// Default transient local port, zero foreign port
OpenLevel1Socket(soc, 0, 0, true)
soc>>PupSoc.frnPort.socket↑2 = psMiscServ
for try = 1 to 20 do
[
let pbi = GetPBI(soc)
MoveBlock(lv pbi>>PBI.pup.words, port, lenPort)
pbi>>PBI.allNets = true // send on all directly connected nets
CompletePup(pbi, ptAddressLookup, pupOvBytes+2*lenPort)
let wait = nil; SetTimer(lv wait, 100) // 1 sec
[ // repeat
Block()
pbi = Dequeue(lv soc>>PupSoc.iQ)
if pbi ne 0 then
[
switchon pbi>>PBI.pup.type into
[
case ptNetDirError:
ReleasePBI(pbi)
CloseLevel1Socket(soc)
@lvEC = ecAddressNotFound
resultis 0
case ptAddressReply:
[
let length = pbi>>PBI.pup.length - pupOvBytes
let string = Allocate(zone, length rshift 1 +1)
for i = 1 to length do
string>>String.char↑i = pbi>>PBI.pup.bytes↑i
string>>String.length = length
ReleasePBI(pbi)
CloseLevel1Socket(soc)
resultis string
]
]
ReleasePBI(pbi)
]
] repeatuntil TimerHasExpired(lv wait)
]
CloseLevel1Socket(soc)
@lvEC = ecNoServerResponded
resultis 0
]
//----------------------------------------------------------------------------
and ParseAddressConst(string, port) = valof
//----------------------------------------------------------------------------
// Parses a network address constant of the form
// net#host#sock and sets port accordingly
// Returns:
// true if string had correct syntax
// false otherwise
[
Zero(port, lenPort)
let c, len = 0, string>>String.length
if len eq 0 resultis false
[ // repeat
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
]