-- GrapevineUser: communication with registration server

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

-- 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 [],
  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, ProtocolDefs, PupDefs, RListDefs
EXPORTS NameInfoDefs, NameInfoPrivate, NameInfoSpecialDefs, NameUpdateDefs =

BEGIN

-- 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 };

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 --;
        foundInfo _ LocateDefs.FindRegServer[name, Accept];
        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.