-- RPC: Binding primitives

-- RPCBinding.mesa

-- Andrew Birrell March 30, 1983 4:18 pm
-- Last Edited by: MBrown, March 30, 1983 4:20 pm

DIRECTORY
BodyDefs   USING[ Connect, maxConnectLength, maxRNameLength, Password,
         RName ],
Heap     USING[ systemZone ],
Inline    USING[ HighHalf, LongCOPY ],
NameInfoDefs  USING[ GetConnect ],
NameUpdateDefs USING[ SetConnect, MakeKey ],
PupDefs    USING[ GetLocalPupAddress, GetPupAddress, PupAddress,
         PupNameTrouble ],
MesaRPC   USING[ CallFailed, EncryptionKey, ExportFailed, ImportFailed,
         InterfaceName, matchAllVersions, Principal, VersionRange ],
RPCInternal   USING[ ExportInstance, ExportTable, ImportInstance ],
RPCPkt    USING[ DispatcherDetails, DispatcherID, ExportHandle, Machine,
         noDispatcher],
RPCLupine   USING[ Call, Dispatcher, GetStubPkt, pktOverhead, StartCall,
         StubPkt],
String    USING[ AppendChar, AppendNumber, AppendString ],
System    USING[ GetGreenwichMeanTime ];

RPCBinding: MONITOR
IMPORTS Heap, Inline, NameInfoDefs, NameUpdateDefs, PupDefs, MesaRPC, RPCLupine,
String, System
EXPORTS MesaRPC, RPCInternal, RPCLupine =

BEGIN

LongAppendString: PROC[to: STRING, from: LONG STRING] =
BEGIN
FOR i: CARDINAL IN [0..from.length) DO String.AppendChar[to, from[i]] ENDLOOP;
END;

LongEquivalent: PROC[a, b: LONG STRING] RETURNS[BOOLEAN] =
BEGIN
IF a.length # b.length
THEN RETURN[FALSE]
ELSE FOR i: CARDINAL IN [0..a.length)
DO ac: CHARACTER = a[i];
bc: CHARACTER = b[i];
  IF ac # bc
  THEN IF ac IN ['a..'z]
  THEN { IF ac + ('A-'a) # bc THEN RETURN[FALSE] }
  ELSE IF bc IN ['a..'z] AND bc + ('A-'a) # ac THEN RETURN[FALSE];
ENDLOOP;
RETURN[TRUE]
END;

InstanceInfo: TYPE = { ok, badName, allDown, noAddress };

LocateInstance: PROC[buff: BodyDefs.RName, instance: LONG STRING]
RETURNS[info: InstanceInfo, isRName: BOOLEAN, host: RPCPkt.Machine] =
BEGIN
connect: BodyDefs.Connect = [BodyDefs.maxConnectLength];
IF instance = NIL OR instance.length > buff.maxlength THEN RETURN[badName,,];
LongAppendString[buff, instance];
FOR i: CARDINAL DECREASING IN [0..buff.length)
DO IF buff[i] = '. THEN { isRName←TRUE; EXIT }; REPEAT
FINISHED => isRName ← FALSE;
ENDLOOP;
IF isRName
THEN SELECT NameInfoDefs.GetConnect[buff, connect] FROM
individual => NULL;
notFound, group => RETURN[badName,isRName,];
allDown => RETURN[allDown,isRName,];
ENDCASE => ERROR
ELSE String.AppendString[connect, buff];
IF connect.length = 0
THEN info ← IF isRName THEN noAddress ELSE badName
ELSE BEGIN
addr: PupDefs.PupAddress;
info ← ok;
PupDefs.GetPupAddress[@addr, connect ! PupDefs.PupNameTrouble =>
IF code = errorFromServer
THEN{ info ← IF isRName THEN noAddress ELSE badName; CONTINUE }
ELSE{ info ← allDown; CONTINUE } ];
host ← [net: addr.net, host: addr.host];
END;
END;


-- ******** Binding primitives ******** --

ExportHandle: PUBLIC TYPE = RPCPkt.ExportHandle;

exportTable: PUBLIC LONG POINTER TO RPCInternal.ExportTable ←
Heap.systemZone.NEW[RPCInternal.ExportTable[20] ← [used:0, entries:] ];

-- Representation of exports in the GV database:
-- Each interface type is a group, such as "Alpine.pa"
-- Members of the group are the interface instances.
-- Each interface instance is an individual, such as "MontBlanc.pa"
-- Connect-site for the individual contains the exporting host.
-- The syntax of instances' connect-sites is (all octal):
-- net#host#mds.

MakeKey: PUBLIC PROC[text: LONG STRING] RETURNS[ MesaRPC.EncryptionKey ] =
BEGIN
buff: STRING = [64--??--];
LongAppendString[buff, text];
RETURN[NameUpdateDefs.MakeKey[buff]]
END;

ExportInterface: PUBLIC PROC[user: MesaRPC.Principal,
    password: MesaRPC.EncryptionKey,
    interface: MesaRPC.InterfaceName,
    dispatcher: RPCLupine.Dispatcher,
    stubProtocol: MesaRPC.VersionRange,
    localOnly: BOOLEAN ← FALSE]
  RETURNS[ instance: ExportHandle ] =
BEGIN
IF interface.type = NIL THEN ERROR MesaRPC.ExportFailed[badType];
IF interface.version # MesaRPC.matchAllVersions
AND interface.version.first > interface.version.last
THEN ERROR MesaRPC.ExportFailed[badVersion];
instance ← AddToExportTable[interface, dispatcher, stubProtocol];
IF NOT localOnly
THEN BEGIN
ENABLE UNWIND => [] ← UnexportInterface[instance];
buff: BodyDefs.RName = [BodyDefs.maxRNameLength];
prevHost: RPCPkt.Machine;
prevInfo: InstanceInfo;
isRName: BOOLEAN;
[prevInfo, isRName, prevHost] ←
LocateInstance[buff,interface.instance];
SELECT prevInfo FROM
ok => IF prevHost = myMachine THEN RETURN;
  badName => ERROR MesaRPC.ExportFailed[badInstance];
  allDown => ERROR MesaRPC.ExportFailed[communications];
  noAddress => NULL;
ENDCASE => ERROR;
IF isRName
THEN BEGIN
connect: BodyDefs.Connect = [BodyDefs.maxConnectLength];
  userBuff: BodyDefs.RName = [BodyDefs.maxRNameLength];
String.AppendNumber[connect, myMachine.net, 8];
String.AppendChar[connect, '#];
String.AppendNumber[connect, myMachine.host, 8];
String.AppendChar[connect, '#];
  IF user.length > BodyDefs.maxRNameLength
  THEN ERROR MesaRPC.ExportFailed[badCredentials];
  LongAppendString[userBuff, user];
SELECT NameUpdateDefs.SetConnect[userBuff, LOOPHOLE[password],
       buff, connect] FROM
individual, noChange => NULL;
group, notFound => ERROR MesaRPC.ExportFailed[badInstance];
badPwd, notAllowed => ERROR MesaRPC.ExportFailed[badCredentials];
allDown => ERROR MesaRPC.ExportFailed[communications];
ENDCASE => ERROR;
  END
ELSE ERROR MesaRPC.ExportFailed[badInstance];
END;
END;

lastExportID: RPCPkt.DispatcherID ← System.GetGreenwichMeanTime[];
-- UID on this machine --

AddToExportTable: ENTRY PROC[interface: MesaRPC.InterfaceName,
    dispatcher: RPCLupine.Dispatcher,
    stubProtocol: MesaRPC.VersionRange]
  RETURNS[ instance: ExportHandle ] =
BEGIN
myMDS: CARDINAL = Inline.HighHalf[LONG[LOOPHOLE[1,POINTER]]];
FOR instance IN [0..exportTable.used)
DO IF exportTable[instance].id = RPCPkt.noDispatcher THEN EXIT;
REPEAT
FINISHED =>
IF exportTable.used = exportTable.length
THEN RETURN WITH ERROR MesaRPC.ExportFailed[tooMany]
ELSE { instance ← exportTable.used; exportTable.used ← exportTable.used+1 }
ENDLOOP;
exportTable[instance] ←
[lastExportID ← lastExportID+1,
dispatcher,
myMDS,
[type: IF interface.type = NIL
THEN NIL
  ELSE Heap.systemZone.NEW[StringBody[interface.type.length]],
instance: IF interface.instance = NIL
THEN NIL
  ELSE Heap.systemZone.NEW[StringBody[interface.instance.length]],
version: interface.version],
stubProtocol];
IF interface.type # NIL
THEN Inline.LongCOPY[from: interface.type,
to: exportTable[instance].name.type,
nwords: SIZE[StringBody[interface.type.length]]];
IF interface.instance # NIL
THEN Inline.LongCOPY[from: interface.instance,
to: exportTable[instance].name.instance,
nwords: SIZE[StringBody[interface.instance.length]]];
END;

UnexportInterface: PUBLIC ENTRY PROC[ instance: ExportHandle ]
 RETURNS[ExportHandle] =
{ IF exportTable[instance].id # RPCPkt.noDispatcher
AND instance # binderHint
THEN BEGIN
IF exportTable[instance].name.instance # NIL
  THEN Heap.systemZone.FREE[@exportTable[instance].name.instance];
IF exportTable[instance].name.type # NIL
  THEN Heap.systemZone.FREE[@exportTable[instance].name.type];
  exportTable[instance] ← [RPCPkt.noDispatcher,NIL,0,[NIL,NIL,],];
  END;
RETURN[instance] };


-- Details of the exported dispatcher are kept only in the exporting machine.
-- The importer obtains the details by an RPC call to dispatcher 1 on that machine.
-- "Bind" makes the call, "Binder" is dispatcher 1 on every machine.
-- "LocalBind" accepts the call.
-- "Bind" returns RPCPkt.noDispatcher for unbound instances.

binderID: RPCPkt.DispatcherID = SUCC[RPCPkt.noDispatcher];
binderHint: ExportHandle = 0;
binderProc: CARDINAL = 0;

BinderResult: TYPE = MACHINE DEPENDENT RECORD[
stubProtocol: MesaRPC.VersionRange,
version: MesaRPC.VersionRange,
dispatcher: RPCPkt.DispatcherDetails];

BinderArgs: TYPE = MACHINE DEPENDENT RECORD[
request(0): CARDINAL,
type(1): CARDINAL, -- offset in pkt, 0 => NIL --
instance(2): CARDINAL -- offset in pkt, 0 => NIL --
-- followed by the StringBody values for type, instance --];

-- Server-stub for binding calls --

Binder: RPCLupine.Dispatcher =
BEGIN
PktString: PROC[n: CARDINAL] RETURNS[ LONG STRING ] =
{ RETURN[IF n+SIZE[StringBody[0]] NOT IN
[SIZE[BinderArgs]+SIZE[StringBody[0]]..
callLength]
  THEN NIL
  ELSE LOOPHOLE[@pkt[n]] ] };
args: LONG POINTER TO BinderArgs = LOOPHOLE[@pkt.data];
result: LONG POINTER TO BinderResult = LOOPHOLE[@pkt.data];
SELECT args.request FROM
binderProc =>
result^ ← LocalBind[PktString[args.type], PktString[args.instance]];
ENDCASE => NULL -- ??--;
RETURN[SIZE[BinderResult]];
END;

-- Server-implementation for binding calls --
LocalBind: ENTRY PROC[type, instance: LONG STRING]
RETURNS[BinderResult] =
BEGIN
FOR i: CARDINAL IN [1..exportTable.used)
DO IF exportTable[i].id # RPCPkt.noDispatcher
AND( type = NIL
OR LongEquivalent[type, exportTable[i].name.type]
 )
AND( instance = NIL
OR LongEquivalent[instance, exportTable[i].name.instance]
 )
THEN RETURN[[exportTable[i].stubProtocol,
    exportTable[i].name.version,
   [exportTable[i].mds, exportTable[i].id, i]]];
ENDLOOP;
RETURN[[,,[,RPCPkt.noDispatcher,]]]
END;

-- user-stub for binding calls --
RemoteBind: PROC[host: RPCPkt.Machine,
type, instance: LONG STRING]
RETURNS[BinderResult] =
BEGIN
binderInterface: ImportInstance ← [host,[,binderID,binderHint]];
argSize: CARDINAL = SIZE[BinderArgs];
pktSize: CARDINAL = MAX[argSize+2*SIZE[StringBody[BodyDefs.maxRNameLength]],
    SIZE[BinderResult] ];
pktData: ARRAY [0..RPCLupine.pktOverhead+pktSize) OF WORD;
pkt: RPCLupine.StubPkt = RPCLupine.GetStubPkt[@pktData];
args: POINTER TO BinderArgs = LOOPHOLE[@pkt.data];
resultLength: CARDINAL;
RPCLupine.StartCall[pkt, @binderInterface];
BEGIN
used: CARDINAL;
args^ ← [binderProc, 0, 0];
used ← SIZE[BinderArgs];
IF type # NIL
THEN BEGIN
args.type ← used;
  Inline.LongCOPY[from: type, to: @pkt[used],
  nwords: SIZE[StringBody[type.length]]];
  used ← used + SIZE[StringBody[type.length]];
  END;
IF instance # NIL
THEN BEGIN
args.instance ← used;
  Inline.LongCOPY[from: instance, to: @pkt[used],
  nwords: SIZE[StringBody[instance.length]]];
  used ← used + SIZE[StringBody[instance.length]];
  END;
IF used > pktSize THEN ERROR;
[resultLength,] ← RPCLupine.Call[pkt, used, pktSize];
END;
RETURN[LOOPHOLE[@pkt.data, POINTER TO BinderResult]^];
END;


ImportInstance: PUBLIC TYPE = RPCInternal.ImportInstance;

debugRemoteBind: BOOLEAN ← FALSE;

LocateImportInstance: PROC[instance: LONG STRING]
RETURNS[host: RPCPkt.Machine] =
BEGIN
buff: BodyDefs.RName = [BodyDefs.maxRNameLength];
info: InstanceInfo;
isRName: BOOLEAN;
[info, isRName, host] ← LocateInstance[buff, instance];
SELECT info FROM
ok => NULL;
badName => ERROR MesaRPC.ImportFailed[badInstance];
allDown => ERROR MesaRPC.ImportFailed[communications];
noAddress => ERROR MesaRPC.ImportFailed[unbound];
ENDCASE => ERROR;
END;

ImportInterface: PUBLIC PROC[interface: MesaRPC.InterfaceName,
    stubProtocol: MesaRPC.VersionRange,
    localOnly: BOOLEAN ← FALSE]
  RETURNS[ handle: LONG POINTER TO ImportInstance ] =
BEGIN
host: RPCPkt.Machine;
dispatcher: RPCPkt.DispatcherDetails;
IF interface.type = NIL THEN ERROR MesaRPC.ExportFailed[badType];
IF debugRemoteBind AND NOT localOnly
THEN BEGIN
host ← LocateImportInstance[interface.instance];
dispatcher ← TryBinding[host, interface, stubProtocol];
END
ELSE BEGIN
host ← LocateImportInstance[interface.instance];
IF localOnly AND host # myMachine
THEN ERROR MesaRPC.ImportFailed[unbound]
ELSE dispatcher ← TryBinding[host, interface, stubProtocol];
END;
RETURN[Heap.systemZone.NEW[ImportInstance ← [host,dispatcher]]]
END;

TryBinding: PROC[host: RPCPkt.Machine,
   impName: MesaRPC.InterfaceName,
stubProtocol: MesaRPC.VersionRange]
RETURNS[RPCPkt.DispatcherDetails] =
BEGIN
expDetails: BinderResult;
expDetails ← RemoteBind[host, impName.type, impName.instance !
MesaRPC.CallFailed =>
IF why = busy THEN RETRY ELSE ERROR MesaRPC.ImportFailed[communications] ];
IF expDetails.dispatcher.dispatcherID = RPCPkt.noDispatcher
THEN ERROR MesaRPC.ImportFailed[unbound];
IF stubProtocol # MesaRPC.matchAllVersions
AND expDetails.stubProtocol # MesaRPC.matchAllVersions
AND ( stubProtocol.first > expDetails.stubProtocol.last
OR stubProtocol.last < expDetails.stubProtocol.first )
THEN ERROR MesaRPC.ImportFailed[stubProtocol];
IF impName.version # MesaRPC.matchAllVersions
AND impName.version.first > impName.version.last
THEN ERROR MesaRPC.ImportFailed[badVersion];
IF impName.version # MesaRPC.matchAllVersions
AND expDetails.version # MesaRPC.matchAllVersions
AND ( impName.version.first > expDetails.version.last
OR impName.version.last < expDetails.version.first )
THEN ERROR MesaRPC.ImportFailed[wrongVersion];
RETURN[expDetails.dispatcher];
END;

UnimportInterface: PUBLIC PROC[handle: LONG POINTER TO ImportInstance]
 RETURNS[LONG POINTER TO ImportInstance] =
{ Heap.systemZone.FREE[@handle]; RETURN[NIL] };

myMachine: RPCPkt.Machine;




-- ******** Initialization ******** --

Initialize: ENTRY PROC =
BEGIN
BEGIN
myAddr: PupDefs.PupAddress = PupDefs.GetLocalPupAddress[[0,0], NIL];
myMachine ← [net: myAddr.net, host: myAddr.host];
END;
IF exportTable.used = 0
THEN BEGIN
binderMDS: CARDINAL = Inline.HighHalf[LONG[LOOPHOLE[1,POINTER]]];
exportTable[binderHint] ←
[binderID, Binder, binderMDS, ["Binder",NIL,[0,0]], [0,0]];
exportTable.used ← 1;
END;
END;

Restart: ENTRY PROC =
{};


Initialize[];

DO STOP; Restart[]; ENDLOOP;

END.