ui/src/confctl/TrestleConf.m3


Copyright (C) 1994, Digital Equipment Corp.

<*PRAGMA LL*>

MODULE TrestleConf;
  IMPORT ArgoCtl, ArgoProp, ArgoClient;
  IMPORT VBT;
  IMPORT Text, RefList, Env, Thread, NetObj;

REVEAL
  User = UserPublic BRANDED OBJECT
           valid: BOOLEAN;       (* Is this a real User created by
                                    Trestle? *)
           ccUser: CCUser;
         OVERRIDES
           register := RegisterUser;
         END;

REVEAL
  App = AppPublic BRANDED OBJECT
          conf     : Conf;
          handler  : Handler;
          localUser: User;       (* Only used for non-conference mode *)
        OVERRIDES
          init    := InitApp;
          destroy := DestroyApp;
        END;

TYPE
  CCUser = ArgoCtl.User;
  Conf = ArgoCtl.Conf;
  Member = ArgoCtl.Member;
  Members = ArgoCtl.Members;
  Event = ArgoCtl.Event;
  Events = ArgoCtl.Events;
  Tkt = ArgoCtl.Tkt;
  Activity = ArgoCtl.Activity;

CONST
  UserNameProp    = ArgoProp.UserName;
  DisplayNameProp = ArgoProp.DisplayName;
  Global          = NIL;

CONST
  MyEvents = Events{Event.Activated, Event.Deactivated, Event.Joined,
                    Event.Left};
  Either = Activity.Either;
  Any    = NIL;                  (* ArgoCtl wildcard for Confs and Users *)

VAR
  userCreate: UserProc;          (* Trestle-supplied proc to create User
                                    objects *)
TrestleConf operates in either Conference mode or Local mode. If: - the conference-control server is reachable, - the local user is found to be registered, and - the local user is active in a conference then mode = Conference and the application is shared. If any of the above conditions fails to hold, then mode = Local and the application is private.

TYPE Mode = {Local, Conference};
CONST
  Local      = Mode.Local;
  Conference = Mode.Conference;
VAR
  mode: Mode;
** User methods **

PROCEDURE RegisterUser (self: User) =
  BEGIN
    IF mode = Conference THEN KnowUser(self) END
  END RegisterUser;
** App methods **

PROCEDURE InitApp (self: App; user: User) =
  VAR ccUser: CCUser;
  PROCEDURE Process (m: Member) =
  <* FATAL ArgoCtl.Error, NetObj.Error, Thread.Alerted *>
    VAR
      u: User   := NewUserFromCCUser(m.user(tag := tag));
    BEGIN
      IF u.valid THEN
        self.add(u);
        IF m.active(tag := tag) THEN self.activate(u) END;
      END;
    END Process;
  BEGIN
    IF mode = Conference THEN
      ccUser := FindCCUser(user.name);
      IF ccUser = NIL THEN mode := Local END;
    END;
    IF mode = Conference THEN
      self.conf := CurrentConf(ccUser);
      IF self.conf = NIL THEN mode := Local END;
    END;
    IF mode = Conference THEN
      self.conf := CurrentConf(ccUser);
      VAR rl := ConfMembers(self.conf); BEGIN
        WHILE rl # NIL DO
          Process(rl.head);
          rl := rl.tail
        END
      END;
      (* race here: what if events before we register? *)
      RegisterForEvents(self, self.conf);
    ELSE
      self.localUser := user;
      self.add(user);
      self.activate(user);
    END;
  END InitApp;

PROCEDURE DestroyApp (self: App) =
  PROCEDURE Process (m: Member) =
    <* FATAL NetObj.Error, Thread.Alerted, ArgoCtl.Error *>
    VAR
      u: User   := KnownUserFromCCUser(m.user(tag := tag));
    BEGIN
      IF u.valid THEN
        IF m.active(tag := tag) THEN self.suspend(u) END;
        self.delete(u);
      END;
    END Process;
  BEGIN
    IF mode = Local THEN
      self.suspend(self.localUser);
      self.delete(self.localUser);
    ELSE
      UnregisterForEvents(self);
      (* race here: what if events after we unregister? *)
      VAR rl := ConfMembers(self.conf); BEGIN
        WHILE rl # NIL DO
          Process(rl.head);
          rl := rl.tail
        END
      END;
    END;
  END DestroyApp;
** TrestleConf.Init procedure **

PROCEDURE Init (createUser: UserProc) =
  BEGIN
    userCreate := createUser;
    ImportServer();
  END Init;
** Routines to access ArgoCtl conference control server **

Import the server as a network object

VAR cct: ArgoCtl.T;
    tag: ArgoCtl.Tag;

PROCEDURE ImportServer () =
  BEGIN
    IF Env.Get("ARGOENABLED") # NIL THEN
      cct := ArgoClient.ImportServer();
      IF cct = NIL THEN
        mode := Local
      ELSE
        tag := ArgoClient.MakeTag("TrestleApplication");
        mode := Conference       (* conf control available => assume conf
                                    mode *)
      END
    ELSE
      mode := Local;
      cct := NIL
    END
  END ImportServer;
ArgoCtl Event callback machinery

TYPE
  Handler = ArgoCtl.Handler OBJECT
              app: App;
            OVERRIDES
              joined      := Joined;
              left        := Left;
              activated   := Activated;
              deactivated := Deactivated;
            END;

PROCEDURE RegisterForEvents (app: App; conf: Conf) =
  <* FATAL NetObj.Error, Thread.Alerted, ArgoCtl.Error *>
  VAR myFilter := Members{user := Any, conf := conf, activity := Either};
  BEGIN
    app.handler := NEW(Handler, app := app);
    cct.register(app.handler, MyEvents, myFilter, tag := tag);
  END RegisterForEvents;

PROCEDURE UnregisterForEvents (app: App) =
  <* FATAL NetObj.Error, Thread.Alerted, ArgoCtl.Error *>
  BEGIN
    cct.unregister(app.handler, tag := tag);
  END UnregisterForEvents;

PROCEDURE Joined (self: Handler; m: Member; t: Tkt)
  RAISES {NetObj.Error, Thread.Alerted} =
  <* FATAL ArgoCtl.Error *>
  VAR user: User;
  BEGIN
    LOCK VBT.mu DO
      user := NewUserFromCCUser(m.user(t, tag := tag), t);
      IF user.valid THEN self.app.add(user) END;
    END;
  END Joined;

PROCEDURE Left (self: Handler; m: Member; t: Tkt)
  RAISES {NetObj.Error, Thread.Alerted} =
  <* FATAL ArgoCtl.Error *>
  VAR user := KnownUserFromCCUser(m.user(t, tag := tag));
  BEGIN
    IF user.valid THEN LOCK VBT.mu DO self.app.delete(user) END END;
  END Left;

PROCEDURE Activated (self: Handler; m: Member; t: Tkt)
  RAISES {NetObj.Error, Thread.Alerted} =
  <* FATAL ArgoCtl.Error *>
  VAR user := KnownUserFromCCUser(m.user(t, tag := tag));
  BEGIN
    IF user.valid THEN LOCK VBT.mu DO self.app.activate(user) END END;
  END Activated;

PROCEDURE Deactivated (self: Handler; m: Member; t: Tkt)
  RAISES {NetObj.Error, Thread.Alerted} =
  <* FATAL ArgoCtl.Error *>
  VAR user := KnownUserFromCCUser(m.user(t, tag := tag));
  BEGIN
    IF user.valid THEN LOCK VBT.mu DO self.app.suspend(user) END END;
  END Deactivated;
Find CCUser having the given value of the UserNameProp property, or return NIL

PROCEDURE FindCCUser (name: TEXT): CCUser =
  BEGIN
    TRY
      VAR
        user, res: CCUser := NIL;
        cnt := 0;
        rl          := cct.getObjectsWith(UserNameProp, tag := tag);
      BEGIN
        WHILE rl # NIL DO
          user := rl.head;
          IF Text.Equal(name, user.getProp(UserNameProp, tag := tag)) THEN
            res := user;
            INC(cnt);
          END;
          rl := rl.tail
        END;
        IF cnt # 1 THEN
          res := ArgoClient.GetUser(tag := tag, userName := name)
        END;
        RETURN res
      END
    EXCEPT
      NetObj.Error, Thread.Alerted, ArgoCtl.Error => RETURN NIL
    END;
  END FindCCUser;

PROCEDURE ConfMembers (conf: Conf): RefList.T =
  <* FATAL NetObj.Error, Thread.Alerted, ArgoCtl.Error *>
  VAR myFilter := Members{user := Any, conf := conf, activity := Either};
  BEGIN
    RETURN cct.getMembers(myFilter, tag := tag)
  END ConfMembers;

PROCEDURE CurrentConf (ccUser: CCUser): Conf =
  BEGIN
    RETURN ArgoClient.GetUsersActiveConference(ccUser, tag)
  END CurrentConf;
** Procedures to maintain table of known Users **

VAR
  table         := NEW(MUTEX);
  users: RefList.T;                 (* List of known user objects *)
Add to table of known Users

PROCEDURE KnowUser (u: User) =
  BEGIN
    LOCK table DO
      IF NOT KnownUser(u) THEN
        u.ccUser := FindCCUser(u.name);
        u.valid := u.ccUser # NIL;
        users := RefList.Cons(u, users);
      END;
    END;
  END KnowUser;
Is User already known?

PROCEDURE KnownUser (u: User): BOOLEAN = <* LL = table *>
  VAR ul := users;
  BEGIN
    WHILE ul # NIL DO
      IF ul.head = u THEN RETURN TRUE END;
      ul := ul.tail;
    END;
    RETURN FALSE
  END KnownUser;
Find known User given CCUser, else create and register it

PROCEDURE NewUserFromCCUser (ccUser: CCUser; tkt: Tkt := ArgoCtl.None):
  User =
  <* FATAL NetObj.Error, Thread.Alerted, ArgoCtl.Error *>
  VAR
    result, recheck: User;
    name, disp     : TEXT;
  BEGIN
    LOCK table DO result := UserFromCCUserInternal(ccUser) END;
    IF result = NIL THEN
      name := ccUser.getProp(UserNameProp, Global, tkt, tag := tag);
      disp := ccUser.getProp(DisplayNameProp, Global, tkt, tag := tag);
      result := userCreate(name, disp);
      IF result # NIL THEN
        result.valid := TRUE;
      ELSE
        result := NEW(User, valid := FALSE);
      END;
      result.ccUser := ccUser;
      LOCK table DO              (* recheck, since lock was released
                                    above *)
        recheck := UserFromCCUserInternal(ccUser);
        IF recheck = NIL THEN    (* Did it pop into table when we weren't
                                    looking? *)
          users := RefList.Cons(result, users) (* no *)
        ELSE
          result := recheck;     (* yes *)
        END;
      END;
    END;
    RETURN result
  END NewUserFromCCUser;
Find known User given CCUser, else error

PROCEDURE KnownUserFromCCUser (ccUser: CCUser): User =
  VAR result: User;
  BEGIN
    LOCK table DO result := UserFromCCUserInternal(ccUser) END;
    <*ASSERT result # NIL *>
    RETURN result
  END KnownUserFromCCUser;
Find known User given CCUser, else return NIL

PROCEDURE UserFromCCUserInternal (ccUser: CCUser): User = <* LL = table *>
  VAR ul := users; res: User;
  BEGIN
    WHILE ul # NIL DO
      res := ul.head;
      IF res.ccUser = ccUser THEN RETURN res END;
      ul := ul.tail
    END;
    RETURN NIL
  END UserFromCCUserInternal;

BEGIN
END TrestleConf.