<> <> <> <> DIRECTORY BasicTime USING [ Now, nullGMT, OutOfRange, Update ], Commander USING [ CommandProc, Register ], FinchSmarts, IO, LupineRuntime USING [ BindingError ], MBQueue USING [ Create, QueueClientAction ], NamesGV USING [ GVGetAttribute ], NamesGVImpExp USING [ GVImport, UnGVImport ], NamesRPC USING [ StartConversation ], Nice, PrincOpsUtils USING [ IsBound ], Process USING [ SecondsToTicks, SetTimeout, Ticks ], RefID USING [ ID ], RefQ USING [ Dequeue, Enqueue, Map, MapType, Queue ], Rope, RPC USING [ AuthenticateFailed, CallFailed, EncryptionKey, ImportFailed, VersionRange ], ThParty USING [ Advance, Alert, ConversationInfo, CreateConversation, Deregister, Enable, GetConversationInfo, GetParty, GetPartyFromNumber, GetPartyInfo, Register ], ThPartyRpcControl, Thrush USING[ ConversationID, ConvEvent, Credentials, NB, none, nullConvID, nullID, PartyID, Reason, ROPE, SHHH, SmartsID, StateInConv, unencrypted ], ThSmarts, ThSmartsRpcControl, ThVersions USING [ GetThrushVR, FinchVersion, FinchVR ], UserProfile USING [ Token], VoiceUtils USING [ CurrentPasskey, CurrentRName, InstanceFromNetAddress, MakeRName, NetAddress, NetAddressFromRope, OwnNetAddress, Problem, ProblemFR, Report ] ; FinchSmartsImpl: CEDAR MONITOR IMPORTS BasicTime, Commander, IO, FinchSmarts, LupineRuntime, MBQueue, NamesGV, NamesGVImpExp, NamesRPC, Nice, PrincOpsUtils, Process, RefQ, Rope, RPC, ThParty, ThPartyRpcControl, ThSmartsRpcControl, ThVersions, UserProfile, VoiceUtils EXPORTS FinchSmarts, ThSmarts = { OPEN IO; <> ConvDesc: TYPE = FinchSmarts.ConvDesc; ConversationID: TYPE = Thrush.ConversationID; nullConvID: ConversationID = Thrush.nullConvID; FinchInfo: TYPE = FinchSmarts.FinchInfo; NB: TYPE = Thrush.NB; none: SHHH = Thrush.none; nullID: RefID.ID = Thrush.nullID; PartyID: TYPE = Thrush.PartyID; ROPE: TYPE = Thrush.ROPE; SHHH: TYPE = Thrush.SHHH; SmartsID: TYPE = Thrush.SmartsID; StateInConv: TYPE = Thrush.StateInConv; PD: TYPE = RECORD [ doReports: BOOL_FALSE, doNice: BOOL_FALSE, timeoutNoAction: INTEGER _ 30, timeoutJayConnect: INTEGER _ 1, noJayTicks: Process.Ticks _ Process.SecondsToTicks[1], encryptionRequested: BOOLEAN_TRUE, interfacesAreImported: BOOLEAN_FALSE, smartsIsExported: BOOLEAN_FALSE, waitsForConnect: NAT_6, queueIt: BOOL_FALSE, finchOn: BOOLEAN_FALSE, maxProseLength: INT_1000 ]; info: FinchInfo; pd: REF PD _ NEW[PD_[]]; Report: PROC[what: ROPE] = { IF NOT pd.doReports THEN RETURN; VoiceUtils.Report[what, $Finch]; }; BeNice: PROC[r: REF, d: INT] = { IF NOT pd.doNice THEN RETURN; Nice.BeNice[r, d, $Finch, NIL]; }; <> <<>> Progress: PUBLIC ENTRY PROC[ shh: SHHH, convEvent: Thrush.ConvEvent ] = { ENABLE UNWIND => NULL; -- RestoreInvariant; <> IF convEvent.self.partyID = convEvent.other.partyID THEN -- See below info.requests.QueueClientAction[QdProgress, convEvent]; }; QdProgress: ENTRY PROC[r: REF] = { <> <> <> <> ENABLE UNWIND => NULL; -- RestoreInvariant; [] _ NoteNewState[ NARROW[r] ]; }; Substitution: PUBLIC ENTRY PROC[ shh: SHHH, convEvent: Thrush.ConvEvent, oldPartyID: Thrush.PartyID, newPartyID: Thrush.PartyID ] = { ENABLE UNWIND => NULL; -- RestoreInvariant; info.requests.QueueClientAction[QdSubstitution, convEvent]; <<If this notice indicates that our own party is the oldPartyID, we should find a way to inform our ReportConversationState clients that we are no longer involved in this conversation. We should also pull the conv. from our active list. This happens when the same user logs in and runs Finch somewhere else.>> }; QdSubstitution: ENTRY PROC[r: REF] = { <> ENABLE UNWIND => NULL; -- RestoreInvariant; convEvent: Thrush.ConvEvent = NARROW[r]; cDesc: ConvDesc = GetConv[convEvent.self.convID, FALSE]; IF cDesc#NIL THEN cDesc.numParties _ 0; -- This will force the information update. [] _ NoteNewState[ convEvent ]; }; <> <<>> CallInfo: TYPE = REF CallInfoBody; -- needed because MBQueue requires a REF CallInfoBody: TYPE = RECORD [ convID: Thrush.ConversationID, calledPartyID: Thrush.PartyID_nullID, reason: Thrush.Reason_NIL, comment: ROPE_NIL ]; DisconnectCall: PUBLIC ENTRY PROC[ convID: Thrush.ConversationID, reason: Thrush.Reason _ $terminating, comment: ROPE_NIL] = { ENABLE UNWIND => NULL; -- RestoreInvariant; info.requests.QueueClientAction[QdDisconnect, NEW[CallInfoBody _ [convID: convID, reason: reason, comment: comment]]]; }; QdDisconnect: ENTRY PROC[r: REF] = { ENABLE UNWIND => NULL; -- RestoreInvariant; callInfo: CallInfo = NARROW[r]; cDesc: ConvDesc; state: StateInConv; IF NOT(([,cDesc, state]_FinchOn[callInfo.convID]).on) THEN RETURN; SELECT state FROM $idle, $neverWas => { info.ReportConversationState[$convNotActive, NIL, "No conversation to disconnect"]; RETURN; }; ENDCASE; []_Request[cDesc, $idle, callInfo.reason, callInfo.comment]; }; AnswerCall: PUBLIC ENTRY PROC[convID: Thrush.ConversationID] = { ENABLE UNWIND => NULL; -- RestoreInvariant; info.requests.QueueClientAction[QdAnswerCall, NEW[CallInfoBody _ [convID: convID]]]; }; QdAnswerCall: ENTRY PROC[r: REF] = { ENABLE UNWIND => NULL; -- RestoreInvariant; callInfo: CallInfo = NARROW[r]; cDesc: ConvDesc; state: StateInConv; IF NOT(([,cDesc, state]_FinchOn[callInfo.convID]).on) THEN RETURN; SELECT state FROM $ringing, $notified => NULL; ENDCASE=>RETURN; []_Request[cDesc, $active]; }; PlaceCall: PUBLIC ENTRY PROC [ convID: Thrush.ConversationID_nullConvID, rName: ROPE, -- rName or description number: ROPE, -- telephone number, if present useNumber: BOOL_FALSE ] = { ENABLE UNWIND => NULL; -- RestoreInvariant; calledPartyID: PartyID; nb: NB; reason: Thrush.Reason _ $notFound; comment: Rope.ROPE _ NIL; IF NOT (FinchOn[].on) THEN RETURN; IF ~useNumber THEN { [nb, calledPartyID] _ThParty.GetParty[shh:info.shh, partyID:info.partyID, rName:rName]; SELECT nb FROM $noSuchParty2, $noIdentSupplied => useNumber _ TRUE; ENDCASE; }; IF useNumber AND number.Length[]>0 THEN [nb, calledPartyID] _ ThParty.GetPartyFromNumber[ shh: info.shh, partyID: info.partyID, phoneNumber: number, description: rName]; SELECT nb FROM $success => reason _ NIL; -- reason: NIL, comment: NIL $noSuchParty2 => NULL; -- reason: $notFound, comment: NIL $narcissism => comment _ "Attempt to call self rejected on philosophical grounds"; ENDCASE => { info.ReportConversationState[nb, NIL, NIL]; RETURN; }; info.requests.QueueClientAction[QdPlaceCall, NEW[CallInfoBody _ [convID: convID, calledPartyID: calledPartyID, reason: reason, comment: comment]]]; }; QdPlaceCall: ENTRY PROC [r: REF] = { ENABLE { UNWIND=>NULL; -- RestoreInvariant; RPC.CallFailed => { UninitFinchSmarts["Communication Failure"]; CONTINUE; }; }; callInfo: CallInfo = NARROW[r]; IF NOT (FinchOn[].on) THEN RETURN; [--cDesc--]_Connect[callInfo.calledPartyID, callInfo.convID, callInfo.reason, callInfo.comment]; }; <> GetConv: PUBLIC PROC[convID: ConversationID, createOK: BOOL_FALSE] RETURNS [ cDesc: ConvDesc_NIL ] = --INLINE-- { IsConv: RefQ.MapType = { cDesc _ NARROW[subqueue.first]; IF cDesc.situation.self.convID = convID THEN RETURN[TRUE]; }; IF convID#nullConvID AND RefQ.Map[info.conversations, IsConv] THEN RETURN; IF ~createOK THEN RETURN; <> cDesc _ NEW[FinchSmarts.ConvDescBody_[ situation: [ self: [ convID: convID, smartsID: info.smartsID, partyID: info.partyID ]]]]; info.conversations _ RefQ.Enqueue[info.conversations, cDesc]; }; FinchOn: INTERNAL PROC[convID: ConversationID_nullConvID] RETURNS [ on: BOOL_FALSE, cDesc: ConvDesc_NIL, state: StateInConv_$idle] = { IF ~pd.finchOn OR info=NIL THEN { VoiceUtils.Report["Your Finch is not running", $Finch]; RETURN; }; on_TRUE; IF convID=nullConvID THEN RETURN; cDesc _ GetConv[convID, FALSE]; state_cDesc.situation.self.state; }; NoteNewState: INTERNAL PROC[convEvent: Thrush.ConvEvent] RETURNS[cDesc: ConvDesc]= { cInfo: ThParty.ConversationInfo; nb: NB; cDesc _ GetConv[convEvent.self.convID, TRUE]; cDesc.situation _ convEvent^; [nb, cInfo] _ ThParty.GetConversationInfo[shh: info.shh, convID: convEvent.self.convID]; <> <> <> SELECT TRUE FROM nb # $success => Problem["Can't obtain conversation information"]; cDesc.numParties#cInfo.numParties, cDesc.numActive#cInfo.numActive, cDesc.numIdle#cInfo.numIdle => { <> cDesc.subject _ cInfo.subject; cDesc.startTime _ cInfo.startTime; cDesc.numParties _ cInfo.numParties; cDesc.numActive _ cInfo.numActive; cDesc.numIdle _ cInfo.numIdle; [nb, cDesc.partyInfo] _ ThParty.GetPartyInfo[shh: info.shh, credentials: cDesc.situation.self, nameReq: $description, allParties: TRUE]; IF nb#$success THEN Problem["Can't obtain conversation information"] ELSE IF cDesc.numParties>=1 THEN cDesc.whoOriginated _ IF cDesc.partyInfo[0].partyID=cInfo.originator THEN $us ELSE $them; }; ENDCASE; SELECT cDesc.situation.self.state FROM $idle, $neverWas => info.conversations _ RefQ.Dequeue[info.conversations, cDesc]; ENDCASE => cDesc.ultimateState _ cDesc.situation.self.state; <<If we've been called due to a Substitution that's kicking us out (cf Subst.), we should find a way to inform our ReportConversationState clients that we are no longer involved in this conversation. We should also do a Dequeue as above. >> info.ReportConversationState[$success, cDesc, NIL]; }; Request: INTERNAL PROC[ cDesc: ConvDesc, state: StateInConv, reason: Thrush.Reason_NIL, comment: ROPE_NIL ] RETURNS [nb: NB] = { DO convEvent: Thrush.ConvEvent; reportToAll: BOOL = SELECT state FROM $idle, $active, $inactive, $ringing => TRUE, ENDCASE=>FALSE; [nb, convEvent] _ ThParty.Advance[shhh: info.shh, credentials: cDesc.situation.self, state: state, reportToAll: reportToAll, reason: reason, comment: comment]; SELECT nb FROM $success => []_NoteNewState[convEvent]; $stateMismatch => { cDesc_NoteNewState[convEvent]; IF state=$idle AND cDesc.situation.self.state # $idle THEN LOOP; }; ENDCASE => -- Some cases are fatal, requiring re-registration! -- info.ReportConversationState[nb, cDesc, "Telephone server action failed"]; <<Real confused about Problem (typeout only) reporting vs. client reporting. The responsibilities are unconvincingly distributed among Smarts and client.>> EXIT; ENDLOOP; }; Connect: INTERNAL PROC [calledPartyID: PartyID, convID: ConversationID_nullConvID, reason: Thrush.Reason _ NIL, comment: ROPE_NIL] RETURNS [ cDesc: ConvDesc ] = { <> state: StateInConv; newState: StateInConv =IF reason=NIL THEN $initiating ELSE $failed; nb: NB; convEvent: Thrush.ConvEvent; [,cDesc, state]_FinchOn[convID]; SELECT state FROM $idle => { [nb, convEvent] _ ThParty.CreateConversation[ shhh: info.shh, credentials: [partyID: info.partyID, smartsID: info.smartsID], state: newState, reason: reason, comment: comment ]; IF nb = $success THEN cDesc _ NoteNewState[convEvent]; }; $reserved, $parsing => nb _ Request[cDesc, newState, reason, comment]; ENDCASE => { info.ReportConversationState[$convStillActive, NIL, "Conversation already in progress"]; RETURN; }; IF nb # $success THEN { -- Do something interesting -- ERROR; }; IF newState=$failed THEN RETURN; -- not establishing a two-party conversation. cDesc.originatorRecorded _ TRUE; nb_ThParty.Alert[shhh: info.shh, credentials: cDesc.situation.self, calledPartyID: calledPartyID]; SELECT nb FROM $success => NULL; $stateMismatch => { []_Request[cDesc, $failed, $error, "Conversation already in progress"]; <<Some smarts don't do this. They probably should.>> RETURN; }; ENDCASE => { -- Do something interesting  see other smarts for more confusion -- ERROR; }; }; WaitForActive: INTERNAL PROC[cDesc: ConvDesc] = { <> FOR i: NAT IN [0..pd.waitsForConnect) DO TRUSTED { Process.SetTimeout[@info.stateChange, pd.noJayTicks]; }; WAIT info.stateChange; -- <> SELECT cDesc.situation.self.state FROM $active => RETURN; $idle, $neverWas, $failed => EXIT; ENDCASE; ENDLOOP; <<This isn't queued; does it have to be?>> []_Request[cDesc, $failed, $error, "Finch failed to connect to voice service."]; }; Problem: PROC[remark: ROPE_NIL, nb: NB_NIL] = { IF nb=NIL THEN VoiceUtils.Problem[remark, $Finch] ELSE VoiceUtils.ProblemFR["%g, reason: %g", $Finch, NIL, rope[remark], atom[nb]]; }; PutFTime: PROC[convID: ConversationID] RETURNS [IO.Value] = { ehsMemorialBool: BOOL_FALSE; -- wouldn't need if could return from catch phrase. IF convID=nullConvID OR convID=BasicTime.nullGMT THEN RETURN[rope["(not assigned)"]]; []_BasicTime.Update[convID, 0!BasicTime.OutOfRange=> { ehsMemorialBool_TRUE; CONTINUE; }]; IF ehsMemorialBool THEN RETURN[int[LOOPHOLE[convID, INT]]] ELSE RETURN[time[convID]]; }; <> InitFinchSmarts: PUBLIC PROC [ thrushInstance: Thrush.ROPE_NIL, ReportSystemState: PROC[ on: BOOL ], ReportConversationState: PROC[ nb: NB, cDesc: ConvDesc, remark: Rope.ROPE ] ] = { problem: ROPE_NIL; nb: NB; { ENABLE RPC.CallFailed => { problem _ "Communication Failure"; GOTO InitFailed; }; credentials: Thrush.Credentials; thVR: RPC.VersionRange = ThVersions.GetThrushVR; problem: Thrush.ROPE _ NIL; namesGVInstance: Thrush.ROPE_NIL; hostHint: VoiceUtils.NetAddress; UninitFinchSmarts[NIL]; info _ NEW[FinchSmarts.FinchInfoBody]; -- Dump any old one! info.requests _ MBQueue.Create[]; info.conversations _ NIL; info.ReportSystemState_ReportSystemState; info.ReportConversationState_ReportConversationState; thrushInstance _ VoiceUtils.MakeRName[style: rName, name: IF thrushInstance#NIL THEN thrushInstance ELSE UserProfile.Token[key: "ThrushClientServerInstance", default: "Strowger.Lark"]]; info.myName _ [ type: "ThSmarts.Lark", instance: VoiceUtils.InstanceFromNetAddress[netAddress: VoiceUtils.OwnNetAddress[], suffix: "0"], version: ThVersions.FinchVR]; info.myRName _ VoiceUtils.CurrentRName[]; info.myPassword _ VoiceUtils.CurrentPasskey[]; ThSmartsRpcControl.ExportInterface[ interfaceName: info.myName, user: info.myRName, password: info.myPassword]; pd.smartsIsExported_TRUE; <> namesGVInstance _ UserProfile.Token[key: "NamesGVInstance", default: "Strowger.lark"]; IF ~(PrincOpsUtils.IsBound[LOOPHOLE[NamesGVImpExp.GVImport]] AND NamesGVImpExp.GVImport[namesGVInstance]) THEN { problem _ "Couldn't import Grapevine Package"; GOTO InitFailed; }; info.shh _ IF NOT pd.encryptionRequested THEN Thrush.unencrypted ELSE NamesRPC.StartConversation [ caller: info.myRName, callee: thrushInstance, key: info.myPassword, level: --<>--CBCCheck ! RPC.AuthenticateFailed=> { problem_"Could not authenticate"; GOTO InitFailed}]; hostHint _ VoiceUtils.NetAddressFromRope[NamesGV.GVGetAttribute[thrushInstance, $connect, NIL]]; ThPartyRpcControl.ImportInterface[ interfaceName: [type: "ThParty.Lark", instance: thrushInstance, version: thVR], hostHint: hostHint! RPC.ImportFailed=> { IF why=wrongVersion THEN problem _ IO.PutFR["Finch version %d too old; import failed", card[ThVersions.FinchVersion]]; GOTO InitFailed; }]; pd.interfacesAreImported_TRUE; [nb, credentials]_ThParty.Register[ shh: info.shh, rName: info.myRName, type: $individual, interface: info.myName, properties: [$controller, VoiceUtils.OwnNetAddress[]] ]; IF nb=$success THEN nb _ ThParty.Enable[shh: info.shh, smartsID: credentials.smartsID]; IF nb#$success THEN { problem_"Can't register with server"; GOTO InitFailed; }; info.smartsID _ credentials.smartsID; info.partyID _ credentials.partyID; <<ThParty.ConversationsForParty[shh: info.shh, partyID: partyID];>> pd.finchOn_TRUE; info.ReportSystemState[pd.finchOn]; EXITS InitFailed => UninitFinchSmarts[problem, nb]; };}; UninitFinchSmarts: PUBLIC PROC[problem: ROPE_NIL, nb: NB_NIL] = { ENABLE RPC.CallFailed => GOTO Failed; IF problem#NIL THEN Problem[problem, nb]; IF info#NIL THEN { IF pd.finchOn AND info.partyID#nullID AND info.smartsID#nullID THEN [-- nb --]_ThParty.Deregister[info.shh, info.smartsID!RPC.CallFailed=>CONTINUE]; info.shh_none; info.ReportSystemState[FALSE]; { ClearConvs: RefQ.MapType = { cDesc: ConvDesc=NARROW[subqueue.first]; cDesc.clientData _ NIL; }; []_RefQ.Map[info.conversations, ClearConvs]; info.conversations _ NIL; }; }; pd.finchOn_FALSE; IF PrincOpsUtils.IsBound[LOOPHOLE[NamesGVImpExp.UnGVImport]] THEN NamesGVImpExp.UnGVImport[]; pd.interfacesAreImported_FALSE; IF pd.smartsIsExported THEN ThSmartsRpcControl.UnexportInterface[!LupineRuntime.BindingError=>CONTINUE]; pd.smartsIsExported_FALSE; EXITS Failed => pd.interfacesAreImported _ pd.smartsIsExported _ FALSE; }; FinchIsRunning: PUBLIC PROC RETURNS [finchIsRunning: BOOL] = { RETURN[pd.finchOn]; }; <> ViewCmd: Commander.CommandProc = TRUSTED { Nice.View[pd, "Finch PD"]; }; Commander.Register["VuFinch", ViewCmd, "Program Management variables Finch"]; <> <<>> <> FinchSmarts.Register[NEW[FinchSmarts.ProcsRecord _ [ <> <> <> <> <> <> <> finchIsRunning: FinchIsRunning ]]]; }. <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <<>> <> <> <> <> <> <> <> <> <<>> <> <> <> <<>> <> <> <> <<>> <> <> <> <<>>