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