// PupNameLookup.bcpl  - Network directory lookup routines.
// requires functions up to and including Pup level 1
// Copyright Xerox Corporation 1979, 1981

// Last modified November 21, 1981  11:17 AM by Taft

get "Pup0.decl"
get "Pup1.decl"

external
[
// outgoing procedures
GetPartner; RequestNameLookup; ParseAddressConst

// incoming procedures
OpenLevel1Socket; CloseLevel1Socket; CompletePup
GetPBI; ReleasePBI; AppendStringToPup; LocateNet
SetTimer; TimerHasExpired; Block; Dismiss; Dequeue; Min
Puts; Wss; MoveBlock; Zero

// incoming statics
pupRT
]

manifest
[
psMiscServ = 4		// well-known socket
ptNetDirLookup = 220b
ptNetDirReply = 221b
ptNetDirError = 222b
]

//----------------------------------------------------------------------------
let GetPartner(name, stream, port, s1, s2; numargs na) = valof
//----------------------------------------------------------------------------
// stream is an output character stream.  zero if not there.
// 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.
[
let portVec = vec 10*lenPort
let nPorts = 1
unless ParseAddressConst(name, portVec) do
   [
   nPorts = RequestNameLookup(name, stream, portVec, 10*lenPort)
   if nPorts eq 0 resultis false
   ]

// Attempt to select the address for which we have the best route,
// and initiate attempts to locate a route if we don't have any.
for try = 1 to 10 do
   [
   let bestHops = maxHops+1
   let curPort = portVec
   let cacheOK = true
   for i = 1 to nPorts do
      [
      let rte = LocateNet(curPort>>Port.net)  // initiates probe if not found
      test rte eq 0
         ifso cacheOK = false  // don't have all required entries in RT yet
         ifnot if rte>>RTE.hops ls bestHops then
            [
            bestHops = rte>>RTE.hops
            MoveBlock(port, curPort, lenPort)
            ]
      curPort = curPort+lenPort
      ]
   if bestHops le maxHops & (cacheOK % try gr 1) then
      [
      // Found a route.  Now default socket number if necessary
      if na ge 5 & port>>Port.socket^1 eq 0 & port>>Port.socket^2 eq 0 then
         [  // no socket number in result, substitute default
         port>>Port.socket^1 = s1
         port>>Port.socket^2 = s2
         ]
      resultis true
      ]
   Dismiss(100)
   ]

if stream ne 0 then Wss(stream, "Can't get there from here")
resultis false
]

//----------------------------------------------------------------------------
and RequestNameLookup(name, stream, resultVec, lenResultVec) = valof
//----------------------------------------------------------------------------
// lenResultVec should be the length of resultVec in words.
// Stores the result ports in resultVec and returns the number of ports
// if successful.  Outputs an error message to stream and returns zero
// if unsuccessful.
[
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 30 do
   [
   let pbi = GetPBI(soc)
   AppendStringToPup(pbi, 1, name)
   pbi>>PBI.allNets = true  //send on all directly connected nets
   CompletePup(pbi, ptNetDirLookup)
   let wait = nil; SetTimer(lv wait, 100)  //1 sec
   until TimerHasExpired(lv wait) do
      [
      Block()
      pbi = Dequeue(lv soc>>PupSoc.iQ)
      if pbi ne 0 then
         [
         let res = -1
         switchon pbi>>PBI.pup.type into
            [
            case ptNetDirError:
               [
               if stream ne 0 then
                  for i = 1 to pbi>>PBI.pup.length-pupOvBytes do
                     Puts(stream, pbi>>PBI.pup.bytes^i)
               res = 0
               endcase
               ]
            case ptNetDirReply:
               [
               let nWords =
                Min((pbi>>PBI.pup.length-pupOvBytes) rshift 1, lenResultVec)
               MoveBlock(resultVec, lv pbi>>PBI.pup.words, nWords)
               res = nWords/3
               endcase
               ]
            ]
         ReleasePBI(pbi)
         if res ne -1 then
            [ CloseLevel1Socket(soc); resultis res ]
         ]
      ]
   ]
if stream ne 0 then Wss(stream, "No name lookup server responded")
CloseLevel1Socket(soc)
resultis false
]

//----------------------------------------------------------------------------
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
   [
   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
]