-- Copyright (C) 1981, 1984, 1985  by Xerox Corporation. All rights reserved. 
-- Locate.mesa - Location of server by client --

-- HGM, 15-Sep-85  2:38:33
-- Andrew Birrell  20-Mar-81 16:56:49 --
-- Mike Schroeder March 21, 1981  10:59 AM --
-- Hankins:	 13-Jun-84 17:22:48	Klamath update (pup changes)

DIRECTORY
  BodyDefs USING [Connect, maxRNameLength, RName],
  Buffer USING [AccessHandle, GetBuffer, MakePool, ReturnBuffer],
  Heap USING [MakeNode, systemZone],
  LocateDefs USING [FoundServerInfo, FoundState],
  NameInfoDefs USING [
    Close, Enumerate, GetConnect, GetMembers, MemberInfo, NameType, RListHandle],
  Process USING [MsecToTicks, SetTimeout],
  ProtocolDefs USING [
    Connect, Init, IsLocal, maxConnectLength, RegServerEnquirySocket,
    RegServerPollingSocket],
  PupDefs USING [
    EnumeratePupAddresses, GetHopsToNetwork, GetPupAddress, PupAddress, PupBuffer,
    PupNameTrouble, PupRouterSendThis, PupSocket, PupSocketDestroy, PupSocketID,
    PupSocketKick, PupSocketMake, SetPupContentsWords, veryLongWait],
  PupTypes USING [fillInSocketID, PupSocketID],
  String USING [AppendString, EquivalentString];

Locate: MONITOR
  IMPORTS Buffer, Heap, NameInfoDefs, Process, ProtocolDefs, PupDefs, String
  EXPORTS LocateDefs =

  BEGIN

  HopCount: TYPE = [0..37777B];
  AddressRec: TYPE = RECORD [
    addr: PupDefs.PupAddress, hops: HopCount, reply: BOOLEAN];
  AddressTable: TYPE = LONG DESCRIPTOR FOR ARRAY OF AddressRec;
  AddressInfo: TYPE = RECORD [
    outcome: {done, down, badName},
    preSorted: BOOLEAN,
    found: CARDINAL,
    addresses: AddressTable];
  ReplyInfo: TYPE = RECORD [found: BOOLEAN, where: PupDefs.PupAddress];

  bufferPool: Buffer.AccessHandle;

  Prod: PROCEDURE [
    socket: PupDefs.PupSocket, addrInfo: AddressInfo,
    accept: PROCEDURE [PupDefs.PupAddress] RETURNS [BOOLEAN]]
    RETURNS [info: ReplyInfo] =
    BEGIN
    -- This is complicated!
    -- The parameters are a table of candidate addresses, and a socket.
    -- The prodder process sends out "echoMe" pups to the addresses;
    -- the slurper process accepts "iAmEcho" replies, and marks the table.
    -- The original process reads the marks from the table, and calls the
    -- client's "accept" procedure to see if this address is ok.
    -- This satisfies various constraints about not hogging pup buffers.
    -- The "echoMe" packets are sent out to closer addresses first; they're
    -- not sent after the client has accepted an address.
    -- Everywhere, the Monitor is not locked while doing long waits.
    from: PupDefs.PupAddress = socket.getLocalAddress[];
    replyRecvd: BOOLEAN ¬ FALSE;  -- "reply-waiting" flag --
    cond: CONDITION;  -- notified when reply comes in --
    pleaseDie: BOOLEAN ¬ FALSE;  -- for killing auxiliary processes --
    DeathWish: ENTRY PROC RETURNS [BOOLEAN] = INLINE {RETURN[pleaseDie]};
    KillSiblings: ENTRY PROC = INLINE {
      pleaseDie ¬ TRUE; PupDefs.PupSocketKick[socket]};
    NoteReply: ENTRY PROC [i: CARDINAL, addr: PupDefs.PupAddress] =
      BEGIN  -- caller promises that "i" is in range --
      IF addrInfo.addresses[i].addr.host = 0 THEN {
        addrInfo.addresses[i].addr.host ¬ addr.host;
        addrInfo.addresses[i].addr.net ¬ addr.net};
      addrInfo.addresses[i].reply ¬ TRUE;
      IF NOT replyRecvd THEN NOTIFY cond;
      replyRecvd ¬ TRUE;
      END;
    TestReply: ENTRY PROC [i: CARDINAL] RETURNS [yes: BOOLEAN] = INLINE {
      yes ¬ addrInfo.addresses[i].reply; addrInfo.addresses[i].reply ¬ FALSE};
    More: ENTRY PROC RETURNS [yes: BOOLEAN] = {
      IF NOT replyRecvd THEN WAIT cond; yes ¬ replyRecvd; replyRecvd ¬ FALSE};
    SendProd: PROCEDURE =
      BEGIN
      sent: CARDINAL ¬ 0;
      lastHops: CARDINAL = 3;  --sorting limit--
      FOR wantedHops: CARDINAL IN [0..lastHops] DO
        lastPass: BOOLEAN = (wantedHops = lastHops);
        FOR i: CARDINAL IN [0..addrInfo.found) DO
          IF DeathWish[] OR sent >= addrInfo.found THEN GOTO getUsOutOfHere;
          IF addrInfo.preSorted
            OR (lastPass AND addrInfo.addresses[i].hops >= wantedHops)
            OR addrInfo.addresses[i].hops = wantedHops THEN
            BEGIN
            b: PupDefs.PupBuffer = Buffer.GetBuffer[
              type: pup, aH: bufferPool, function: send, size: smallBuffer];
            b.pup.source ¬ from;
            b.pup.pupType ¬ echoMe;
            b.pup.dest ¬ addrInfo.addresses[i].addr;
            -- force socket number, because database may not have GV test-mode socket numbers --
            b.pup.dest.socket ¬ ProtocolDefs.RegServerPollingSocket;
            b.pup.pupWords[0] ¬ i;
            PupDefs.SetPupContentsWords[b, 1];
            PupDefs.PupRouterSendThis[b];
            sent ¬ sent + 1;
            END;
          REPEAT getUsOutOfHere => EXIT  -- from outer loop! --
          ENDLOOP;
        ENDLOOP;
      END;
    Slurp: PROCEDURE =
      BEGIN
      UNTIL DeathWish[] DO
        b: PupDefs.PupBuffer = socket.get[];
        IF b # NIL THEN
          BEGIN
          SELECT b.pup.pupType FROM
            iAmEcho =>
              IF b.pup.pupWords[0] < addrInfo.found THEN
                NoteReply[b.pup.pupWords[0], b.pup.source];
            ENDCASE => NULL;
          Buffer.ReturnBuffer[b];
          END;
        ENDLOOP;
      END;
    prodder: PROCESS = FORK SendProd[];
    slurper: PROCESS = FORK Slurp[];
    Process.SetTimeout[@cond, Process.MsecToTicks[1500]];
    info.found ¬ FALSE;
    UNTIL info.found DO
      IF NOT More[] THEN EXIT -- time-out on "cond" -- ;
      FOR i: CARDINAL IN [0..addrInfo.found) UNTIL info.found DO
        IF TestReply[i] THEN
          BEGIN
          info.where ¬ addrInfo.addresses[i].addr;
          IF accept[info.where] THEN info.found ¬ TRUE;
          END;
        ENDLOOP;
      ENDLOOP;
    KillSiblings[];
    JOIN prodder;
    JOIN slurper;
    END;

  GetGVRegServer: PROCEDURE RETURNS [info: AddressInfo] =
    BEGIN
    addressesInGVRS: CARDINAL = 10;  -- we take the 10 closest --
    Work: PROCEDURE [addr: PupDefs.PupAddress] RETURNS [BOOLEAN] =
      BEGIN  -- terminate if we have enough addresses --
      -- Note: EnumeratePupAddresses gives them closest first --
      IF info.found = LENGTH[info.addresses] THEN RETURN[TRUE];
      info.addresses[info.found] ¬ [
        addr: [
        net: addr.net, host: addr.host,
        socket: ProtocolDefs.RegServerEnquirySocket], hops: 0
        -- ignored, because of "preSorted" flag -- , reply: FALSE];
      info.found ¬ info.found + 1;
      RETURN[FALSE]
      END;
    -- Top-level contacting R-Servers.  Any method is valid!
    -- Try local broadcast, and try Name Lookup Server.
    -- Failing only means R-Servers are inaccessible; name might be ok.
    BEGIN
    info ¬ [
      done, TRUE, 0, DESCRIPTOR[
      Heap.MakeNode[n: addressesInGVRS * SIZE[AddressRec]], addressesInGVRS]];
    [] ¬ Work[
      [
      net: [0], host: [0],  -- local broadcast --
      socket: ProtocolDefs.RegServerEnquirySocket]];
    [] ¬ PupDefs.EnumeratePupAddresses[
      "GrapevineRServer"L, Work ! PupDefs.PupNameTrouble => GOTO no];
    EXITS no => NULL;
    END;
    END;

  GetGroupInfo: PROC [who, local: BodyDefs.RName] RETURNS [info: AddressInfo] =
    BEGIN
    mInfo: NameInfoDefs.MemberInfo = NameInfoDefs.GetMembers[who];
    WITH m: mInfo SELECT FROM
      notFound => info ¬ [badName, FALSE, 0, ];
      allDown => info ¬ [down, FALSE, 0, ];
      individual => info ¬ [badName, FALSE, 0, ];
      group =>
        BEGIN
        apparent: CARDINAL ¬ 0;
        Count: PROC [member: BodyDefs.RName] RETURNS [done: BOOLEAN] = {
          apparent ¬ apparent + 1; done ¬ FALSE};
        Access: PROC [member: BodyDefs.RName] RETURNS [done: BOOLEAN] =
          BEGIN
          cInfo: NameInfoDefs.NameType;
          connect: ProtocolDefs.Connect = [ProtocolDefs.maxConnectLength];
          done ¬ FALSE;
          cInfo ¬ NameInfoDefs.GetConnect[member, connect];
          SELECT cInfo FROM
            individual =>
              BEGIN
              addr: PupDefs.PupAddress;
              addr.socket ¬ [0, 0];
              PupDefs.GetPupAddress[
                @addr, connect ! PupDefs.PupNameTrouble => GOTO cant];
              info.addresses[info.found] ¬ [
                addr: addr,
                hops: MIN[PupDefs.GetHopsToNetwork[addr.net], LAST[HopCount]],
                reply: FALSE];
              info.found ¬ info.found + 1;
              IF local # NIL AND ProtocolDefs.IsLocal[addr] THEN {
                local.length ¬ 0; String.AppendString[local, member]};
              EXITS cant => NULL;
              END;
            ENDCASE => NULL -- ignore others -- ;
          END;
        NameInfoDefs.Enumerate[m.members, Count];
        info ¬ [
          done, FALSE, 0, DESCRIPTOR[
          Heap.MakeNode[n: apparent * SIZE[AddressRec]], apparent]];
        NameInfoDefs.Enumerate[m.members, Access];
        NameInfoDefs.Close[m.members];
        END;
      ENDCASE => ERROR;
    END;

  FindNearestServer: PUBLIC PROCEDURE [
    list: BodyDefs.RName,
    accept: PROCEDURE [PupDefs.PupAddress] RETURNS [BOOLEAN]]
    RETURNS [info: LocateDefs.FoundServerInfo] =
    BEGIN
    gvName: STRING = "gv.gv"L;
    socket: PupDefs.PupSocket = PupDefs.PupSocketMake[
      local: PupTypes.fillInSocketID, remote:, ticks: PupDefs.veryLongWait];
    addrInfo: AddressInfo ¬
      IF String.EquivalentString[list, gvName] THEN GetGVRegServer[]
      ELSE GetGroupInfo[list, NIL];
    SELECT addrInfo.outcome FROM
      badName => info ¬ [notFound[]];
      down => info ¬ [allDown[]];
      done =>
        BEGIN
        THROUGH [1..4]  -- re-tries for lost packets --
          DO
          reply: ReplyInfo = Prod[socket, addrInfo, accept];
          IF reply.found THEN {info ¬ [found[reply.where]]; EXIT}
          REPEAT FINISHED => info ¬ [allDown[]]
          ENDLOOP;
        Heap.systemZone.FREE[@addrInfo.addresses.BASE];
        END;
      ENDCASE => ERROR;
    PupDefs.PupSocketDestroy[socket];
    END --FindNearestServer-- ;

  FindLocalServer: PUBLIC PROCEDURE [list, local: BodyDefs.RName]
    RETURNS [LocateDefs.FoundState] =
    BEGIN
    addrInfo: AddressInfo ¬ GetGroupInfo[list, local];
    SELECT addrInfo.outcome FROM
      badName => RETURN[notFound];
      down => RETURN[allDown];
      done => {
        Heap.systemZone.FREE[@addrInfo.addresses.BASE];
        RETURN[IF local.length # 0 THEN found ELSE notFound]};
      ENDCASE => ERROR;
    END;

  FindRegServer: PUBLIC PROCEDURE [
    who: BodyDefs.RName, accept: PROCEDURE [PupDefs.PupAddress] RETURNS [BOOLEAN]]
    RETURNS [foundInfo: LocateDefs.FoundServerInfo] =
    BEGIN
    -- find a registration server for given R-Name --
    sep: CHARACTER = '.;  -- SN sep NA --
    rPtr: CARDINAL;
    NA: BodyDefs.RName = [BodyDefs.maxRNameLength];
    -- parse to find registry name --
    rPtr ¬ who.length;
    DO
      IF rPtr = 0 THEN RETURN[[notFound[]]];
      rPtr ¬ rPtr - 1;
      IF who[rPtr] = sep THEN EXIT;
      ENDLOOP;
    NA.length ¬ 0;
    FOR rPtr ¬ rPtr + 1, rPtr + 1 WHILE rPtr # who.length DO
      NA[NA.length] ¬ who[rPtr]; NA.length ¬ NA.length + 1 ENDLOOP;
    String.AppendString[NA, ".GV"L];
    foundInfo ¬ FindNearestServer[NA, accept];
    END;  --FindRegServer--

  AcceptFirst: PUBLIC PROCEDURE [PupDefs.PupAddress] RETURNS [BOOLEAN] = {
    RETURN[TRUE]};

  ProtocolDefs.Init[];
  bufferPool ¬ Buffer.MakePool[send: 3, receive: 0];

  END.