// PupNetDirLookup.bcpl -- Network directory lookup routines. // requires functions up to and including Pup level 1 // Copyright Xerox Corporation 1981, 1982 // Last modified September 25, 1982 10:03 AM 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 = 1 to 10 do [ for i = 0 to nPorts-1 do if hopsVec!i gr maxHops then [ let rte = LocateNet((ports+i*lenPort)>>Port.net) 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 gr 1) break 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 ]