-- GrapevineUser: communication with registration server

-- [Indigo]<Grapevine>MS>NameInfo.mesa

-- Ted Wobber	  29-Aug-84 13:40:37
-- Andrew Birrell  August 30, 1982 12:00 pm

DIRECTORY
  BodyDefs USING [Connect, oldestTime, Password, Remark, RName, Timestamp],
  LocateDefs USING [FindRegServer, FoundServerInfo],
  NameInfoDefs USING [
    AuthenticateInfo, ConnectInfo, ExpandInfo, ListType, MembershipGrade,
    MemberInfo, MembershipLevel, Membership, NameType, Outcome, RemarkInfo,
    RListHandle, StampInfo],
  NameInfoPrivate USING [],
  NameInfoSpecialDefs USING [],
  NameUpdateDefs USING [],
  Process USING [GetCurrent],
  ProtocolDefs USING [
    CreateStream, DestroyStream, Enquire, Failed, Handle, IsLocal, MakeKey,
    ReceiveBoolean, ReceiveConnect, ReceiveRC, ReceiveRemark,
    RegServerEnquirySocket, ReturnCode, RSOperation, SendByte, SendNow,
    SendPassword, SendRName, SendRSOperation],
  PupDefs USING [AppendPupAddress, PupAddress],
  RListDefs USING [Close, Enumerate, Receive, RListHandle];

NameInfo: MONITOR
  IMPORTS LocateDefs, Process, ProtocolDefs, PupDefs, RListDefs
  EXPORTS NameInfoDefs, NameInfoPrivate, NameInfoSpecialDefs, NameUpdateDefs =

  BEGIN

  -- monitor FindRegServer calls
  lockedProcess: PROCESS ¬ NIL;
  canSearch: CONDITION;
  recursions: CARDINAL ¬ 0;


  -- Re-export RListDefs into NameInfoDefs --

  RListHandle: PUBLIC TYPE = RECORD [l: RListDefs.RListHandle];

  Enumerate: PUBLIC PROC [
    list: RListHandle, work: PROC [BodyDefs.RName] RETURNS [done: BOOLEAN]] = {
    RListDefs.Enumerate[list.l, work]};

  Close: PUBLIC PROC [list: RListHandle] = {RListDefs.Close[list.l]};



  Expand: PUBLIC PROC [
    name: BodyDefs.RName, oldStamp: BodyDefs.Timestamp ¬ BodyDefs.oldestTime]
    RETURNS [NameInfoDefs.ExpandInfo] =
    BEGIN
    info: NameInfoDefs.NameType;
    list: RListHandle;
    stamp: BodyDefs.Timestamp;
    Receive: PROC [str: ProtocolDefs.Handle] = {
      list ¬ [l: RListDefs.Receive[str]]};
    [info, stamp] ¬ GetCompound[name, oldStamp, Expand, Receive];
    SELECT info FROM
      noChange => RETURN[[noChange[]]];
      group => RETURN[[group[list, stamp]]];
      individual => RETURN[[individual[list, stamp]]];
      notFound => RETURN[[notFound[]]];
      protocolError => RETURN[[protocolError[]]];
      wrongServer => RETURN[[wrongServer[]]];
      allDown => RETURN[[allDown[]]];
      ENDCASE => RETURN[[protocolError[]]];
    END;


  GetMembers: PUBLIC PROC [
    name: BodyDefs.RName, oldStamp: BodyDefs.Timestamp ¬ BodyDefs.oldestTime]
    RETURNS [NameInfoDefs.MemberInfo] = {
    RETURN[GetGroupList[name, oldStamp, ReadMembers]]};

  GetOwners: PUBLIC PROC [
    name: BodyDefs.RName, oldStamp: BodyDefs.Timestamp ¬ BodyDefs.oldestTime]
    RETURNS [NameInfoDefs.MemberInfo] = {
    RETURN[GetGroupList[name, oldStamp, ReadOwners]]};

  GetFriends: PUBLIC PROC [
    name: BodyDefs.RName, oldStamp: BodyDefs.Timestamp ¬ BodyDefs.oldestTime]
    RETURNS [NameInfoDefs.MemberInfo] = {
    RETURN[GetGroupList[name, oldStamp, ReadFriends]]};


  GetGroupList: PUBLIC PROC [
    name: BodyDefs.RName, oldStamp: BodyDefs.Timestamp,
    op: ProtocolDefs.RSOperation] RETURNS [NameInfoDefs.MemberInfo] =
    BEGIN
    info: NameInfoDefs.NameType;
    list: RListHandle;
    stamp: BodyDefs.Timestamp;
    Receive: PROC [str: ProtocolDefs.Handle] = {
      list ¬ [l: RListDefs.Receive[str]]};
    [info, stamp] ¬ GetCompound[name, oldStamp, op, Receive];
    SELECT info FROM
      noChange => RETURN[[noChange[]]];
      group => RETURN[[group[list, stamp]]];
      individual => RETURN[[individual[]]];
      notFound => RETURN[[notFound[]]];
      protocolError => RETURN[[protocolError[]]];
      wrongServer => RETURN[[wrongServer[]]];
      allDown => RETURN[[allDown[]]];
      ENDCASE => RETURN[[protocolError[]]];
    END;


  GetCompound: PUBLIC PROC [
    name: BodyDefs.RName, stamp: BodyDefs.Timestamp, op: ProtocolDefs.RSOperation,
    receive: PROC [ProtocolDefs.Handle], reporter: PROC [STRING] ¬ NIL]
    RETURNS [info: NameInfoDefs.NameType, newStamp: BodyDefs.Timestamp] =
    BEGIN
    rcCopy: ProtocolDefs.ReturnCode;
    GetListWork: PROC [str: ProtocolDefs.Handle]
      RETURNS [rc: ProtocolDefs.ReturnCode] =
      BEGIN
      [rc, newStamp] ¬ ProtocolDefs.Enquire[str, op, name, stamp];
      rcCopy ¬ rc;
      END;
    info ¬ Enquire[name, GetListWork, reporter];
    IF
      (info = individual
        AND (op = Expand OR op = ReadEntry OR op = ReadMailboxes)) OR info = group
      OR (op = ReadEntry AND rcCopy = [done, dead]) THEN
      receive[str ! ProtocolDefs.Failed => GOTO notQuite];
    ReleaseStream[];
    EXITS notQuite => {CloseStream[]; ReleaseStream[]; info ¬ allDown; }
    END;



  GetConnect: PUBLIC PROC [name: BodyDefs.RName, connect: BodyDefs.Connect]
    RETURNS [NameInfoDefs.ConnectInfo] =
    BEGIN
    ConnectWork: PROC [str: ProtocolDefs.Handle]
      RETURNS [rc: ProtocolDefs.ReturnCode] =
      BEGIN [rc, ] ¬ ProtocolDefs.Enquire[str, ReadConnect, name]; END;
    info: NameInfoDefs.NameType ¬ Enquire[name, ConnectWork];
    IF info = individual THEN
      ProtocolDefs.ReceiveConnect[
        str, connect ! ProtocolDefs.Failed => GOTO notQuite];
    ReleaseStream[];
    SELECT info FROM
      IN NameInfoDefs.ConnectInfo => RETURN[info];
      ENDCASE => RETURN[protocolError];
    EXITS notQuite => {CloseStream[]; ReleaseStream[]; RETURN[allDown]}
    END;



  GetRemark: PUBLIC PROC [name: BodyDefs.RName, remark: BodyDefs.Remark]
    RETURNS [NameInfoDefs.RemarkInfo] =
    BEGIN
    RemarkWork: PROC [str: ProtocolDefs.Handle]
      RETURNS [rc: ProtocolDefs.ReturnCode] =
      BEGIN [rc, ] ¬ ProtocolDefs.Enquire[str, ReadRemark, name]; END;
    info: NameInfoDefs.NameType = Enquire[name, RemarkWork];
    IF info = group THEN
      ProtocolDefs.ReceiveRemark[
        str, remark ! ProtocolDefs.Failed => GOTO notQuite];
    ReleaseStream[];
    SELECT info FROM
      IN NameInfoDefs.RemarkInfo => RETURN[info];
      ENDCASE => RETURN[protocolError];
    EXITS notQuite => {CloseStream[]; ReleaseStream[]; RETURN[allDown]}
    END;



  CheckStamp: PUBLIC PROC [
    name: BodyDefs.RName, oldStamp: BodyDefs.Timestamp ¬ BodyDefs.oldestTime]
    RETURNS [NameInfoDefs.StampInfo] =
    BEGIN
    info: NameInfoDefs.NameType;
    CheckStampWork: PROC [str: ProtocolDefs.Handle]
      RETURNS [rc: ProtocolDefs.ReturnCode] =
      BEGIN [rc, ] ¬ ProtocolDefs.Enquire[str, CheckStamp, name, oldStamp]; END;
    info ¬ Enquire[name, CheckStampWork];
    ReleaseStream[];
    SELECT info FROM
      IN NameInfoDefs.StampInfo => RETURN[info];
      ENDCASE => RETURN[protocolError];
    END;


  Authenticate: PUBLIC PROC [name: BodyDefs.RName, password: STRING]
    RETURNS [NameInfoDefs.AuthenticateInfo] = {
    RETURN[AuthenticateKey[name, ProtocolDefs.MakeKey[password]]]};


  AuthenticateKey: PUBLIC PROC [name: BodyDefs.RName, key: BodyDefs.Password]
    RETURNS [NameInfoDefs.AuthenticateInfo] =
    BEGIN
    AuthWork: PROC [str: ProtocolDefs.Handle]
      RETURNS [rc: ProtocolDefs.ReturnCode] =
      BEGIN
      ProtocolDefs.SendRSOperation[str, Authenticate];
      ProtocolDefs.SendRName[str, name];
      ProtocolDefs.SendPassword[str: str, key: [0, 0, 0, 0], pw: key];
      ProtocolDefs.SendNow[str];
      rc ¬ ProtocolDefs.ReceiveRC[str];
      END;
    info: NameInfoDefs.NameType = Enquire[name, AuthWork];
    ReleaseStream[];
    SELECT info FROM
      IN NameInfoDefs.AuthenticateInfo => RETURN[info];
      ENDCASE => RETURN[protocolError];
    END;



  IsInList: PUBLIC PROC [
    name, member: BodyDefs.RName, level: NameInfoDefs.MembershipLevel,
    grade: NameInfoDefs.MembershipGrade, acl: NameInfoDefs.ListType]
    RETURNS [res: NameInfoDefs.Membership] =
    BEGIN
    IsInListWork: PROC [str: ProtocolDefs.Handle]
      RETURNS [rc: ProtocolDefs.ReturnCode] =
      BEGIN
      ProtocolDefs.SendRSOperation[str, IsInList];
      ProtocolDefs.SendRName[str, name];
      ProtocolDefs.SendRName[str, member];
      ProtocolDefs.SendByte[str, LOOPHOLE[grade]];
      ProtocolDefs.SendByte[str, LOOPHOLE[acl]];
      ProtocolDefs.SendByte[str, LOOPHOLE[level]];
      ProtocolDefs.SendNow[str];
      rc ¬ ProtocolDefs.ReceiveRC[str];
      END;
    info: NameInfoDefs.NameType = Enquire[name, IsInListWork];
    SELECT info FROM
      group =>
        res ¬
          IF ProtocolDefs.ReceiveBoolean[
          str ! ProtocolDefs.Failed => GOTO notQuite] THEN yes ELSE no;
      individual, notFound => res ¬ notGroup;
      ENDCASE => res ¬ allDown;  -- includes various protocol errors --
    ReleaseStream[];
    EXITS notQuite => {CloseStream[]; ReleaseStream[]; res ¬ allDown; }
    END;



  Update: PUBLIC PROC [
    user: BodyDefs.RName, password: BodyDefs.Password,
    op: ProtocolDefs.RSOperation, target: BodyDefs.RName, value: STRING ¬ NIL,
    newPwd: BodyDefs.Password ¬ [, , , ], reporter: PROC [STRING] ¬ NIL]
    RETURNS [info: NameInfoDefs.Outcome] =
    BEGIN
    UpdateWork: PROC [str: ProtocolDefs.Handle]
      RETURNS [rc: ProtocolDefs.ReturnCode] =
      BEGIN
      ProtocolDefs.SendRSOperation[str, IdentifyCaller];
      ProtocolDefs.SendRName[str, user];
      ProtocolDefs.SendPassword[str, [0, 0, 0, 0], password];
      ProtocolDefs.SendNow[str];
      rc ¬ ProtocolDefs.ReceiveRC[str];
      IF rc = [BadRName, group] THEN rc ¬ [BadRName, notFound];
      IF rc = [done, individual] THEN
        BEGIN
        ProtocolDefs.SendRSOperation[str, op];
        ProtocolDefs.SendRName[str, target];
        SELECT op FROM
          CreateGroup, DeleteIndividual, DeleteGroup, AddSelf, DeleteSelf => NULL;
          ChangePassword, CreateIndividual =>
            ProtocolDefs.SendPassword[str, [0, 0, 0, 0], newPwd];
          ENDCASE => ProtocolDefs.SendRName[str, value];
        ProtocolDefs.SendNow[str];
        rc ¬ ProtocolDefs.ReceiveRC[str];
        END;
      END;
    info ¬ Enquire[target, UpdateWork, reporter];
    ReleaseStream[];
    END;



  -- There is a cache of one stream and one address. --
  -- Access to this is under mutual exclusion, enforced by calls
  -- on ClaimStream and ReleaseStream --

  released: CONDITION;
  free: BOOLEAN ¬ TRUE;
  str: ProtocolDefs.Handle ¬ NIL;  -- cached R-Server stream --
  cacheAddr: PupDefs.PupAddress;  -- address of cached stream --
  addrHint: BOOLEAN ¬ FALSE;  -- whether to use cached address as a hint --

  ClaimStream: ENTRY PROC = {UNTIL free DO WAIT released ENDLOOP; free ¬ FALSE; };

  ReleaseStream: ENTRY PROC = {free ¬ TRUE; NOTIFY released};

  GetSearchLock: ENTRY PROC =
    BEGIN
    myProcess: PROCESS = Process.GetCurrent[];
    DO
      SELECT lockedProcess FROM
        NIL => {lockedProcess ¬ myProcess; EXIT};
        myProcess => {recursions ¬ recursions + 1; EXIT};  -- recursion
        ENDCASE => WAIT canSearch;
      ENDLOOP;
    END;

  ReleaseSearchLock: ENTRY PROC = {
    IF recursions # 0 THEN recursions ¬ recursions - 1
    ELSE {lockedProcess ¬ NIL; NOTIFY canSearch}};

  CleanUp: PUBLIC --NameInfoSpecialDefs-- PROC =
    BEGIN
    ClaimStream[];
    -- optimize for R-Server/M-Server internal stream --
    IF NOT ProtocolDefs.IsLocal[cacheAddr] THEN CloseStream[];
    ReleaseStream[];
    END;


  -- "SetServer" allows a client (typically Maintain) to provide
  -- a server address as a hint.

  SetServer: PUBLIC PROC [addr: PupDefs.PupAddress] =
    BEGIN ClaimStream[]; cacheAddr ¬ addr; addrHint ¬ TRUE; ReleaseStream[]; END;


  Enquire: PROC [
    name: BodyDefs.RName,
    EnquiryWork: PROC [ProtocolDefs.Handle] RETURNS [ProtocolDefs.ReturnCode],
    reporter: PROC [STRING] ¬ NIL] RETURNS [info: NameInfoDefs.Outcome] =
    BEGIN
    -- slightly subtle optimisation: If we don't have a stream, or the
    -- stream we have times out,  we'll need to get one to an R-Server for
    -- GV.  Getting one early might save us from having to call
    -- FindRegServer later --
    Create: PROC =
      BEGIN
      cacheAddr.socket ¬ ProtocolDefs.RegServerEnquirySocket;
      IF reporter # NIL THEN
        BEGIN
        s: STRING = [64];
        PupDefs.AppendPupAddress[s, cacheAddr];
        reporter[s];
        END;
      str ¬ ProtocolDefs.CreateStream[cacheAddr];
      END;
    rc: ProtocolDefs.ReturnCode;
    oldBad: BOOLEAN ¬ FALSE;
    ClaimStream[];
    BEGIN
    AcceptGV: PROC [addr: PupDefs.PupAddress] RETURNS [BOOLEAN] =
      BEGIN
      IF str # NIL THEN ERROR;
      cacheAddr ¬ addr;
      Create[ ! ProtocolDefs.Failed => GOTO failed];
      RETURN[TRUE];
      EXITS failed => {CloseStream[]; RETURN[FALSE]}
      END;
    IF addrHint THEN  -- cached address hint set by client, so try it --
      {addrHint ¬ FALSE; CloseStream[]; [] ¬ AcceptGV[cacheAddr]};
    IF str # NIL  -- try cached stream first --
      THEN
      BEGIN
      rc ¬ EnquiryWork[str ! ProtocolDefs.Failed => GOTO streamGone];
      EXITS streamGone => CloseStream[];
      END;
    IF str = NIL THEN
      BEGIN
      -- Don't use cached address, so that we return to a near server--
      -- Note: The following call of FindRegServer doesn't call us
      -- back recursively!
      [] ¬ LocateDefs.FindRegServer["x.GV"L, AcceptGV];
      IF str = NIL THEN {info ¬ allDown; RETURN};
      rc ¬ EnquiryWork[str ! ProtocolDefs.Failed => GOTO notThere];
      END;
    IF rc.code = WrongServer THEN oldBad ¬ TRUE ELSE oldBad ¬ FALSE;
    EXITS notThere => {CloseStream[]; oldBad ¬ TRUE; };
    END;
    IF oldBad THEN
      BEGIN  -- need to find the correct R-Server --
      Accept: PROC [addr: PupDefs.PupAddress] RETURNS [BOOLEAN] =
        BEGIN
        ClaimStream[];
        addr.socket ¬ ProtocolDefs.RegServerEnquirySocket;
        IF str # NIL AND cacheAddr # addr THEN CloseStream[];
        IF str = NIL THEN
          BEGIN
          cacheAddr ¬ addr;
          Create[ ! ProtocolDefs.Failed => GOTO failed];
          END;
        RETURN[TRUE];
        EXITS failed => {CloseStream[]; ReleaseStream[]; RETURN[FALSE]}
        END;
      foundInfo: LocateDefs.FoundServerInfo;
      ReleaseStream[] -- for FindRegServer -- ;
      GetSearchLock[];  -- serialize calls to FindRegServer (to save processes)
      foundInfo ¬ LocateDefs.FindRegServer[name, Accept];
      ReleaseSearchLock[];
      WITH foundInfo SELECT FROM
        notFound => {info ¬ notFound; ClaimStream[]; RETURN};
        allDown => {info ¬ allDown; ClaimStream[]; RETURN};
        found =>
          BEGIN
          -- stream was claimed inside "Accept" --
          rc ¬ EnquiryWork[str ! ProtocolDefs.Failed => GOTO down];
          EXITS down => {CloseStream[]; info ¬ allDown; RETURN}
          END;
        ENDCASE => ERROR;
      END;
    info ¬
      SELECT rc.code FROM
        noChange => noChange,
        done, BadRName =>
          SELECT rc.type FROM
            individual => individual,
            group => group,
            ENDCASE => notFound -- includes dead -- ,
        BadOperation, BadProtocol => protocolError,
        WrongServer => wrongServer,
        AllDown => allDown,
        BadPassword => badPwd,
        outOfDate => outOfDate,
        NotAllowed => notAllowed,
        ENDCASE => allDown;
    END;

  CloseStream: PROC = {
    IF str # NIL THEN {ProtocolDefs.DestroyStream[str]; str ¬ NIL}};


  END.