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