<> <> DIRECTORY IO, Lark -- USING [ -- CommandEvents, ConnectionSpec, Event, LarkModel, Passel, SHHH, StatusEvent, StatusEvents ]--, LarkRpcControl USING [ ImportNewInterface, InterfaceRecord ], LarkSmarts, LarkSmartsMonitorImpl, LarkSmartsRpcControl USING [ExportInterface, InterfaceName, UnexportInterface], Log USING [ DNFProc, LOG, LogProc, RegisterWhereToReport, Report, Problem, WhereProc ], LupineRuntime, MulticastRpcControl USING [ ImportInterface, InterfaceName ], Names USING [--CurrentRName, -- CurrentPasskey, GetDefaultDetails, GVDetails, NetError, RnameToRspec, Rspec, StartConversation ], Nice USING [ LarkConLogStream ], RPC USING [ AuthenticateFailed, EncryptionKey, ExportFailed, GetCaller, ImportFailed ], SafeStorage USING [ GetCanonicalType, Type ], SpyLog USING [ Here ], ThNet USING [ pd ], ThPartyPrivate USING [ DehandleSmarts, LocalSmartsInterface, RegisterLocal, SmartsBody, SmartsData, GetPartySmarts ], ThParty USING [ CreateParty, Deregister, Enable ], Thrush USING [ CallUrgency, ConversationHandle, Disposition, epoch, Epoch, H, NetAddress, none, nullHandle, PartyHandle, ROPE, SmartsHandle, ThHandle, unencrypted ], ThSmartsPrivate USING [ CheckHookState, EnterLarkState, GetSmartsInfo, LarkFailed, LarkInfo, LarkInfoBody, LarkParseEvent, LarkProgress, LarkSupervise, RegisterTrunk, RingEnable, SmartsInfo, SetRingingParameters, SmartsInfoBody ], ThSmartsRpcControl, Triples USING [ Erase, Make ], TU, UserProfile USING [ Token ] ; LarkSmartsInitImpl: CEDAR MONITOR LOCKS root IMPORTS IO, LarkRpcControl, LarkSmartsRpcControl, Log, Names, root: LarkSmartsMonitorImpl, LupineRuntime, MulticastRpcControl, Nice, RPC, SafeStorage, SpyLog, ThNet, ThPartyPrivate, ThParty, Thrush, ThSmartsPrivate, ThSmartsRpcControl, Triples, TU, UserProfile EXPORTS LarkSmarts, ThSmartsPrivate SHARES LarkSmartsMonitorImpl = { OPEN IO; <> CallUrgency: TYPE = Thrush.CallUrgency; CommandEvents: TYPE = Lark.CommandEvents; ConversationHandle: TYPE = Thrush.ConversationHandle; H: PROC[r: REF] RETURNS[Thrush.ThHandle] = INLINE {RETURN[Thrush.H[r]]; }; none: SHHH = Thrush.none; nullHandle: Thrush.ThHandle = Thrush.nullHandle; PartyHandle: TYPE = Thrush.PartyHandle; ROPE: TYPE = Thrush.ROPE; SHHH: TYPE = Lark.SHHH; -- Encrypts conv. if first arg to RPC PROC RTSmartsType: SafeStorage.Type = SafeStorage.GetCanonicalType[CODE[ThPartyPrivate.SmartsBody]]; SmartsHandle: TYPE = Thrush.SmartsHandle; SmartsInfo: TYPE = ThSmartsPrivate.SmartsInfo; SmartsInfoBody: TYPE = ThSmartsPrivate.SmartsInfoBody; StatusEvents: TYPE = Lark.StatusEvents; larkInterfaces: LIST OF LarkRpcControl.InterfaceRecord _ NIL; <> Register: PUBLIC PROC[ shh: SHHH, -- encrypts connection oldSmartsID: Thrush.SmartsHandle, oldEpoch: Thrush.Epoch, netAddress: Thrush.NetAddress, -- machine name for registering Lark -- model: Lark.LarkModel, authenticated: BOOL_FALSE, clientInstance: ROPE ] RETURNS [ smartsID: Thrush.SmartsHandle_nullHandle, epoch: Thrush.Epoch_Thrush.epoch ] = { larkSh: Lark.SHHH; partyID: PartyHandle; localSmarts: ThPartyPrivate.LocalSmartsInterface; info: SmartsInfo; larkInterface: LarkRpcControl.InterfaceRecord_NIL; smarts: ThPartyPrivate.SmartsData; fullRname: ROPE = RPC.GetCaller[shh]; partyRname: ROPE _ fullRname; s: Names.Rspec _ NIL; gvDetails: Names.GVDetails; ringEnable: ThSmartsPrivate.RingEnable _ on; IF (s_Names.RnameToRspec[partyRname])#NIL AND Names.RnameToRspec[s.simpleName] # NIL THEN partyRname_s.simpleName; <> <> DO ENABLE UNWIND=>NULL; <> <> partyID _ ThParty.CreateParty[ type: (SELECT model.genre FROM --<<>>-- ENDCASE=> individual), rName: partyRname]; IF partyID=nullHandle THEN { Log.Report[IO.PutFR["Registering party %s not found", rope[partyRname]], $System]; RETURN[nullHandle, Thrush.epoch]; }; <<>> <> <> <<<< This may all cause trouble later when users log in at Larks -- WAIL.>>>> smartsID _ ThPartyPrivate.GetPartySmarts[partyID, $VoiceTerminal]; IF smartsID#nullHandle THEN { DR: ENTRY PROC = { ENABLE UNWIND=>NULL; Deregister[ThSmartsPrivate.GetSmartsInfo[smarts: smarts]]; }; smarts _ ThPartyPrivate.DehandleSmarts[smartsID]; IF oldSmartsID=smartsID AND epoch = Thrush.epoch AND smarts#NIL THEN WITH smarts.properties SELECT FROM voiceTerminal, manager => IF machine = netAddress THEN RETURN[oldSmartsID, Thrush.epoch]; ENDCASE; -- oldHandle is a strange beast indeed. IF smarts#NIL THEN DR[]; smartsID_nullHandle; partyID _ nullHandle; LOOP; }; <> <<>> <> larkSh _ IF NOT ThNet.pd.encryptionRequested THEN Thrush.unencrypted ELSE Names.StartConversation [ caller: myName.instance, callee: fullRname, key: serverPassword, level: --<>--CBCCheck ! RPC.AuthenticateFailed=>{ Log.Problem["Can't authenticate"]; GOTO NotSmart; }]; <> larkInterface _ LarkRpcControl.ImportNewInterface[ interfaceName: [type: "Lark.Lark", instance: clientInstance] ! RPC.ImportFailed=> { Log.Problem["Can't import Lark interface"]; GOTO NotSmart; }]; larkInterfaces _ CONS[larkInterface, larkInterfaces]; <<<< No way to deal with resumption of calls in progress, as yet. >>>> <> localSmarts _ ThSmartsRpcControl.NewInterfaceRecord[]; localSmarts.Progress _ ThSmartsPrivate.LarkProgress; smartsID_ThPartyPrivate.RegisterLocal[ partyID: partyID, interface: localSmarts, properties: [x: voiceTerminal[machine: netAddress]] ! -- << If decide to return error code to caller, problem tells the story. >> -- Names.NetError=> { smartsID _ nullHandle; CONTINUE; }]; IF smartsID = nullHandle THEN { Log.Problem["Can't register Lark"]; GOTO NotSmart; }; <> smarts _ ThPartyPrivate.DehandleSmarts[smartsID,TRUE]; info _ NEW[SmartsInfoBody_ [ smarts: smarts, ParseEvent: ThSmartsPrivate.LarkParseEvent, Supervise: ThSmartsPrivate.LarkSupervise, larkInfo: NEW[ThSmartsPrivate.LarkInfoBody _ [ interface: larkInterface, shh: larkSh, netAddress: netAddress, model: model]] ]]; info.larkInfo.scratchEv _ NEW[Lark.CommandEventSequence[15]]; IF ([,gvDetails] _ Names.GetDefaultDetails[info.larkInfo.netAddress]).results = ok AND gvDetails#NIL AND gvDetails.larkSpec THEN ringEnable _ SELECT gvDetails.ringEnable FROM 'R => on, 'S => subdued, 'O => off, ENDCASE => on; ThSmartsPrivate.SetRingingParameters[ info: info.larkInfo, ringEnable: ringEnable]; -- set to current defaults Triples.Make[$SmartsData, smarts, info]; info.otherSmarts _ ThPartyPrivate.DehandleSmarts[ ThSmartsPrivate.RegisterTrunk[ partyID, smarts, info ]]; Log.Report[IO.PutFR[" (%g = %g)", rope[clientInstance], TU.RefAddr[info.smarts]], $Smarts, info]; EnableSmartsE[info]; -- Ready to go, as long as phone is on hook EXIT; REPEAT NotSmart => RETURN; ENDLOOP; }; EnableSmartsE: ENTRY PROC[info: SmartsInfo] = { []_EnableSmarts[info]; }; EnableSmarts: PUBLIC INTERNAL PROC[info: SmartsInfo] RETURNS[enabled: BOOL] = { ENABLE UNWIND, ThSmartsPrivate.LarkFailed =>GOTO Failed; SELECT info.larkInfo.larkState FROM none, failed, recovering => NULL; ENDCASE=> RETURN[TRUE]; IF ThSmartsPrivate.CheckHookState[info.larkInfo].onHook=FALSE THEN RETURN[FALSE]; IF ThParty.Enable[ smartsID: H[info.smarts]]#success THEN RETURN[FALSE]; -- << REPORT!! >> -- IF ThParty.Enable[ smartsID: H[info.otherSmarts]]#success THEN Log.Problem["Impossible", $Smarts, info]; ThSmartsPrivate.EnterLarkState[ info.larkInfo, none, info ]; -- Clear any previous failure. ThSmartsPrivate.EnterLarkState[ info.larkInfo, idle, info ]; -- Reset the Lark RETURN[TRUE]; EXITS Failed => RETURN[FALSE]; }; Deregister: PUBLIC INTERNAL PROC[info: SmartsInfo] = { IF info=NIL OR ThPartyPrivate.DehandleSmarts[H[info.smarts]] = NIL THEN RETURN; ThSmartsPrivate.EnterLarkState[ info.larkInfo, failed, info ]; -- prevent further action. SimpleDeregister[ThSmartsPrivate.GetSmartsInfo[smarts: info.otherSmarts]]; SimpleDeregister[info]; <> Log.Report[IO.PutFR["Smarts %d (%g) is dead", card[H[info.smarts]], TU.RefAddr[info.smarts]], $Smarts, info]; }; SimpleDeregister: INTERNAL PROC[info: SmartsInfo] = { ThParty.Deregister[smartsID: H[info.smarts]]; Triples.Erase[$SmartsData, info.smarts, info]; }; Login: PUBLIC PROC[shh: SHHH, smartsID: SmartsHandle, authenticated: BOOL] = { NULL }; <> WhereIsSmartsLog: Log.WhereProc -- [fixedWhereData: REF ANY, whereData: REF ANY] RETURNS [s: STREAM _ NIL] -- = CHECKED { info: SmartsInfo=NARROW[whereData]; IF info#NIL THEN s_Nice.LarkConLogStream[info.larkInfo.netAddress]; }; WhereIsLarkLogFerSherr: Log.WhereProc -- [fixedWhereData: REF ANY, whereData: REF ANY] RETURNS [s: STREAM _ NIL] -- = CHECKED { info: ThSmartsPrivate.LarkInfo=NARROW[whereData]; IF info#NIL THEN s_Nice.LarkConLogStream[info.netAddress]; IF s#NIL AND s=Nice.LarkConLogStream[[[0],[0]]] THEN s_NIL; -- only want the debug viewer stream }; FerSherrDefault: Log.DNFProc=TRUSTED{ RETURN[ThNet.pd.defaultLarkReports]; }; WhereIsLarkLog: Log.WhereProc -- [fixedWhereData: REF ANY, whereData: REF ANY] RETURNS [s: STREAM _ NIL] -- = CHECKED { info: ThSmartsPrivate.LarkInfo=NARROW[whereData]; IF info#NIL THEN s_Nice.LarkConLogStream[info.netAddress]; }; LOG: Log.LogProc = TRUSTED INLINE { Log.LOG[group]; }; <> myName: LarkSmartsRpcControl.InterfaceName = [ type: "LarkSmarts.Lark", instance: UserProfile.Token[key: "ThrushServerInstance", default: "Morley.Lark"]]; serverPassword: RPC.EncryptionKey = Names.CurrentPasskey[UserProfile.Token[ key: "ThrushServerPassword", default: "MFLFLX"]]; mName: MulticastRpcControl.InterfaceName = [ type: "Multicast.Lark", instance: UserProfile.Token[key: "MulticastInstance", default: "Michaelson.Lark"]]; LarkSmartsInit: PROC = { ENABLE { RPC.ExportFailed => GOTO Failed; RPC.ImportFailed => GOTO Failed; ANY => { Log.Problem["LarkSmarts export failed", $System]; GOTO Failed; }; }; Log.RegisterWhereToReport[proc: WhereIsLarkLog, where: $Lark]; Log.RegisterWhereToReport[proc: WhereIsLarkLogFerSherr, where: $LarkDetailed, defaultIfNotFound: FerSherrDefault]; <> Log.RegisterWhereToReport[proc: WhereIsSmartsLog, where: $Smarts]; LarkSmartsRpcControl.ExportInterface[ interfaceName: myName, user: myName.instance, password: serverPassword]; Log.Report[IO.PutFR["Export[LarkSmarts.Lark, %s]", rope[myName.instance]], $System]; MulticastRpcControl.ImportInterface[interfaceName: mName]; EXITS Failed => LarkSmartsRpcControl.UnexportInterface[!LupineRuntime.BindingError=>CONTINUE]; }; LarkSmartsInit[]; }.