-- Copyright (C) 1983, 1984  by Xerox Corporation. All rights reserved. 
-- RPCBinding.mesa, HGM, 21-Jan-84 20:37:10
-- Cedar 5, 21-Jan-84 20:37:07
-- NIL instance => let anybody Bind in, 30-Apr-83 21:11:00
-- Deleted hack to try Local Binding first, HGM, 12-Apr-83 18:38:50
-- Patched for NIL instance, HGM, 12-Apr-83 17:23:50

-- RPC: Binding primitives

-- RPCBinding.mesa

-- Andrew Birrell  September 2, 1982 10:25 am

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],
  MesaRPCLupine USING [Call, Dispatcher, GetStubPkt, pktOverhead, StartCall, StubPkt],
  String USING [AppendChar, AppendNumber, AppendString],
  System USING [GetGreenwichMeanTime];

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

  BEGIN

  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, , ];
    String.AppendString[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
    RETURN[NameUpdateDefs.MakeKey[text]]
    END;

  ExportInterface: PUBLIC PROC [
    user: MesaRPC.Principal, password: MesaRPC.EncryptionKey,
    interface: MesaRPC.InterfaceName, dispatcher: MesaRPCLupine.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 AND interface.instance # NIL 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];
        String.AppendString[userBuff, user];
        SELECT NameUpdateDefs.SetConnect[
        userBuff, LOOPHOLE[password], buff, connect] FROM
          individual => NULL;
          badPwd => ERROR MesaRPC.ExportFailed[badCredentials];
          group, notFound => ERROR MesaRPC.ExportFailed[badInstance];
          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: MesaRPCLupine.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: MesaRPCLupine.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 exportTable[i].name.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..MesaRPCLupine.pktOverhead + pktSize) OF WORD;
    pkt: MesaRPCLupine.StubPkt = MesaRPCLupine.GetStubPkt[@pktData];
    args: POINTER TO BinderArgs = LOOPHOLE[@pkt.data];
    resultLength: CARDINAL;
    MesaRPCLupine.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, ] ¬ MesaRPCLupine.Call[pkt, used, pktSize];
    END;
    RETURN[LOOPHOLE[@pkt.data, POINTER TO BinderResult]­];
    END;


  ImportInstance: PUBLIC TYPE = RPCInternal.ImportInstance;

  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];
    host ¬ LocateImportInstance[interface.instance];
    dispatcher ¬ TryBinding[ host, interface, stubProtocol];
    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;

  Initialize[];

  END.