Copyright (C) 1994, Digital Equipment Corp.
<*PRAGMA LL*> MODULETrestleConf 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.; 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
TYPE Mode = {Local, Conference}; CONST Local = Mode.Local; Conference = Mode.Conference; VAR mode: Mode;** User methods **
PROCEDURE** App methods **RegisterUser (self: User) = BEGIN IF mode = Conference THEN KnowUser(self) END END RegisterUser;
PROCEDURE** TrestleConf.Init 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; PROCEDUREDestroyApp (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;
PROCEDURE** Routines to access ArgoCtl conference control server **Init (createUser: UserProc) = BEGIN userCreate := createUser; ImportServer(); END Init;
Import the server as a network object
VAR cct: ArgoCtl.T; tag: ArgoCtl.Tag; PROCEDUREArgoCtl Event callback machineryImportServer () = 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;
TYPE Handler = ArgoCtl.Handler OBJECT app: App; OVERRIDES joined := Joined; left := Left; activated := Activated; deactivated := Deactivated; END; PROCEDUREFind CCUser having the given value of the UserNameProp property, or return NILRegisterForEvents (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; PROCEDUREUnregisterForEvents (app: App) = <* FATAL NetObj.Error, Thread.Alerted, ArgoCtl.Error *> BEGIN cct.unregister(app.handler, tag := tag); END UnregisterForEvents; PROCEDUREJoined (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; PROCEDURELeft (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; PROCEDUREActivated (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; PROCEDUREDeactivated (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;
PROCEDURE** Procedures to maintain table of known Users **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; PROCEDUREConfMembers (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; PROCEDURECurrentConf (ccUser: CCUser): Conf = BEGIN RETURN ArgoClient.GetUsersActiveConference(ccUser, tag) END CurrentConf;
VAR table := NEW(MUTEX); users: RefList.T; (* List of known user objects *)Add to table of known Users
PROCEDUREIs User already known?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;
PROCEDUREFind known User given CCUser, else create and register itKnownUser (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;
PROCEDUREFind known User given CCUser, else errorNewUserFromCCUser (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;
PROCEDUREFind known User given CCUser, else return NILKnownUserFromCCUser (ccUser: CCUser): User = VAR result: User; BEGIN LOCK table DO result := UserFromCCUserInternal(ccUser) END; <*ASSERT result # NIL *> RETURN result END KnownUserFromCCUser;
PROCEDUREUserFromCCUserInternal (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.