// GrapevineEnquire.bcpl
// Copyright Xerox Corporation 1981, 1983
// Last modified September 19, 1983  9:41 AM by Taft

get "Grapevine.decl"
get "GrapevineProtocol.decl"
get "GrapevineInternal.decl"
get "Streams.d"

external
[
// outgoing procedures
Enquire; EnquireWithStamp

// incoming procedures
SendWord; SendRName; ReceiveWord; FindServer; GVCreateStream
GVClaimStream; GVReleaseStream; BSPWriteBlock; BSPForceOutput
ExtractSubstring; ConcatenateStrings
DefaultArgs; Block; MyFrame; Free

// incoming statics
@gus; offsetBSPStr
]

//----------------------------------------------------------------------------
let EnquireWithStamp(stream, op, name, stamp; numargs na) = valof
//----------------------------------------------------------------------------
// Sends an enquiry of the form [op, name, stamp] and returns the
// resulting returnCode.  The default stamp used is null.
[
let defaultStamp = table [ 0; 0; 0 ]
DefaultArgs(lv na, -3, defaultStamp)
SendWord(stream, op)  // op
SendRName(stream, name)  // name
BSPWriteBlock(stream, stamp, 0, 2*lenTimeStamp)  // stamp
BSPForceOutput(stream-offsetBSPStr, true)
resultis ReceiveWord(stream)  // returnCode
]

//----------------------------------------------------------------------------
and Enquire(name, proc, arg) = valof
//----------------------------------------------------------------------------
// Opens a BSP stream to a registration server that has a copy of the registry
// for name (an RName), and then calls Proc(stream, name, arg).
// Proc should return a ReturnCode describing the outcome; any additional
// results may be communicated via storage pointed to by arg.
// Note that proc may be called more than once, since the first registration
// server we talk to may not have the required information, or the connection
// may fail in the middle.  Also, any stream errors on stream cause control
// to be ripped away from proc, so proc must not acquire any resources not
// known to the caller of Enquire.
// Returns the ReturnCode returned by proc if proc was called successfully,
// or a locally-manufactured ReturnCode otherwise.
[
let dot = 0
for i = 1 to name>>RName.length do
   if name>>RName.char^i eq $. then dot = i
if dot eq 0 resultis rcBadRName lshift 8  // missing "." in RName

// for registry NA, the group named NA.GV enumerates its R-Servers
let zone = gus>>GUS.zone
let registry = ConcatenateStrings(ExtractSubstring(name, dot+1, 0, zone),
 ".GV", true, false, zone)

// If we already have a stream open, try it first.  That is, ask the R-Server
// we are currently connected to to perform the enquiry.  If that succeeds,
// we are done; if not, we must go through the R-Server location algorithm.
let returnCode = nil
GVClaimStream()
if gus>>GUS.stream ne 0 then
   [
   gus>>GUS.stream>>ST.par1 = MyFrame()
   returnCode = proc(gus>>GUS.stream, name, arg)
   ]
GVReleaseStream()

// Enquire (cont'd)

// The enquiry process consists of two main stages:
// stage 0: Find ANY R-Server and ask it to look up name; if this succeeds
// 	    then we are done.
// stage 1: find the R-Server for NA.GV and ask it to look up name.
// FindServer would do the complete registry location protocol if we
// simply passed it NA.GV.  However, we employ the following optimization:
// if we don't currently have an open stream, we first ask
// FindServer to open a stream to ANY R-Server, and we present name
// to that server in the hope that the server has a copy of name's
// registry.  Only if this fails do we ask FindServer to go through
// the complete protocol for locating registry -- but by this time we
// have already established a stream to SOME R-Server, so the first part
// of the R-Server location protocol will not need to be repeated.

// Note: if there was a cached stream, and the stream is still alive, and
// proc did NOT return WrongServer, then we are already connected to the
// correct server and received the response we deserved; firstStage=2
// bypasses all the R-Server location protocol in this case.
let firstStage = gus>>GUS.stream eq 0? 0,
 returnCode<<ReturnCode.code eq rcWrongServer? 1, 2
for stage = firstStage to 1 do
   [
   // Stage 0: try to find ANY R-Server, and open a stream to it.
   // Stage 1: try to find the correct R-Server, and open a stream to it.
   // In stage 0, the call of FindServer doesn't call us back
   // recursively, because FindServer locates registry GV by
   // consulting a Name Lookup Server or by broadcasting.
   // In stage 1, FindServer may call us back recursively while
   // expanding NA.GV and obtaining connect sites.
   let ec = FindServer((stage eq 0? "GrapevineRServer", registry),
    socRegServerPolling, GVCreateStream)
   test ec ne 0
      ifso
         [
	 // unable to contact any registration server (stage 0)
	 // or any server for registry (stage 1).  In both cases this is fatal.
         returnCode<<ReturnCode.code = ec eq ecBadRName? rcBadRName, rcAllDown
	 break
	 ]
      ifnot
         [
	 // successfully opened a stream to some R-Server (stage 0) or to some
         // R-Server for registry (stage 1).  Now attempt to perform the enquiry.
         GVClaimStream()
	 gus>>GUS.stream>>ST.par1 = MyFrame()
	 returnCode = proc(gus>>GUS.stream, name, arg)
         GVReleaseStream()
	 
	 // If the server does not know about name and this is stage 0,
	 // go around again.  In all other cases we are finished.
	 // A WrongServer error in stage 1 indicates an inconsistency
	 // in the data base; convert this to BadName.
	 test returnCode<<ReturnCode.code eq rcWrongServer
	    ifso returnCode<<ReturnCode.code = rcBadRName
	    ifnot break
	 ]
   ]

Free(zone, registry)
resultis returnCode
]