<> <> <> DIRECTORY Commander USING [ CommandProc, Register ], 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, RegisterWhereToReport, ReportFR, Problem, ProblemFR, WhereProc ], LupineRuntime, Names USING [CmdOrToken, CurrentPasskey, RnameToRspec, Rspec ], NamesRPC USING [ StartConversation ], Nice USING [ LarkConLogStream ], RPC USING [ AuthenticateFailed, EncryptionKey, ExportFailed, GetCaller, ImportFailed ], SafeStorage USING [ GetCanonicalType, Type ], 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, SmartsInfo, SmartsInfoBody ], ThSmartsRpcControl, ThVersions, Triples USING [ Erase, Make ], TU ; LarkSmartsInitImpl: CEDAR MONITOR LOCKS root IMPORTS IO, Commander, LarkRpcControl, LarkSmartsRpcControl, Log, Names, NamesRPC, root: LarkSmartsMonitorImpl, LupineRuntime, Nice, RPC, SafeStorage, ThNet, ThPartyPrivate, ThParty, Thrush, ThSmartsPrivate, ThSmartsRpcControl, ThVersions, Triples, TU 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; larkRegistry: ROPE_".lark"; thSmartsExported: BOOL_FALSE; <> 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; 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.ReportFR["Registering party %s not found", $System, NIL, rope[partyRname]]; 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 NamesRPC.StartConversation [ caller: myName.instance, callee: fullRname, key: serverPassword, level: --<>--CBCCheck ! RPC.AuthenticateFailed=> { Log.ProblemFR["Can't authenticate %g to %g", $System, NIL, rope[myName.instance], rope[fullRname]]; GOTO NotSmart; }]; <> larkInterface _ LarkRpcControl.ImportNewInterface[ interfaceName: [type: "Lark.Lark", instance: clientInstance] ! RPC.ImportFailed=> { Log.ProblemFR["Can't import Lark interface from %g", $System, NIL, rope[clientInstance]]; 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 smartsID=nullHandle THEN {Log.ProblemFR["Can't register Lark: %g, %g",$System,NIL, rope[fullRname], rope[clientInstance]]; 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]]; Triples.Make[$SmartsData, smarts, info]; info.otherSmarts _ ThPartyPrivate.DehandleSmarts[ ThSmartsPrivate.RegisterTrunk[ partyID, smarts, info ]]; Log.ReportFR[" (%g = %g)", $Smarts, info, rope[clientInstance], TU.RefAddr[info.smarts]]; 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.ReportFR["Smarts %d (%g) is dead", $Smarts, info, card[H[info.smarts]], TU.RefAddr[info.smarts]]; }; 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]; IF s#NIL AND s=Nice.LarkConLogStream[[[0],[0]]] THEN s_NIL; -- use default stream unless debug viewer stream open. }; 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]; IF s#NIL AND s=Nice.LarkConLogStream[[[0],[0]]] THEN s_NIL; -- only want the debug viewer stream }; WhereIsLarkLogFerSherr: Log.WhereProc _ WhereIsLarkLog; FerSherrDefault: Log.DNFProc=TRUSTED{ RETURN[ThNet.pd.defaultLarkReports]; }; <> myName: LarkSmartsRpcControl.InterfaceName; serverPassword: RPC.EncryptionKey; LarkSmartsInit: Commander.CommandProc = { ENABLE { RPC.ExportFailed => { Log.Problem["LarkSmarts export failed", $System]; GOTO Failed; }; }; myName _ [ type: "LarkSmarts.Lark", instance: Names.CmdOrToken[cmd: cmd, key: "ThrushServerInstance", default: "Morley.Lark"], version: ThVersions.ThrushVR]; serverPassword _ Names.CurrentPasskey[Names.CmdOrToken[ cmd: cmd, key: "ThrushServerPassword", default: "MFLFLX"]]; IF thSmartsExported THEN RETURN; 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.ReportFR["Export[LarkSmarts.Lark, %s]", $System, NIL, rope[myName.instance]]; thSmartsExported _ TRUE; EXITS Failed => LarkSmartsRpcControl.UnexportInterface[!LupineRuntime.BindingError=>CONTINUE]; }; Commander.Register["LarkSmarts", LarkSmartsInit, "LarkSmarts > -- Initialize and Export LarkSmarts"]; }.