<> <> <> <> DIRECTORY BasicTime USING [ Now, nullGMT, OutOfRange, Update ], Commander USING [ CommandProc, Register ], FinchSmarts, IO, Lark USING [ SHHH ], 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, SmartsID, StateInConv, unencrypted ], ThSmarts, ThSmartsRpcControl, ThVersions USING [ GetThrushVR, FinchVersion, FinchVR ], UserProfile USING [ Token], VoiceUtils USING [ CurrentPasskey, CurrentRName, InstanceFromNetAddress, OwnNetAddress, Problem, ProblemFR, Report ] ; FinchSmartsImpl: CEDAR MONITOR IMPORTS BasicTime, Commander, IO, FinchSmarts, LupineRuntime, MBQueue, NamesGV, NamesGVImpExp, NamesRPC, Nice, PrincOpsUtils, Process, RefQ, 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 = Lark.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] ]; }; <> <<>> 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, $failed, $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[QdDisconnect, 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; IF NOT (FinchOn[].on) THEN RETURN; IF ~useNumber THEN { [nb, calledPartyID] _ThParty.GetParty[shh:info.shh, partyID:info.partyID, rName:rName]; IF nb = $noSuchParty2 THEN useNumber _ TRUE; }; IF useNumber THEN [nb, calledPartyID] _ ThParty.GetPartyFromNumber[ shh: info.shh, partyID: info.partyID, phoneNumber: number, description: rName]; IF nb # $success THEN { info.ReportConversationState[nb, NIL, NIL]; RETURN; }; info.requests.QueueClientAction[QdPlaceCall, NEW[CallInfoBody _ [convID: convID, calledPartyID: calledPartyID]]]; }; 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]; }; <> 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; info.ReportConversationState[$success, cDesc, NIL]; }; Request: INTERNAL PROC[ cDesc: ConvDesc, state: StateInConv, reason: Thrush.Reason_NIL, comment: ROPE_NIL ] = { DO nb: NB; 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"]; <> EXIT; ENDLOOP; }; Connect: INTERNAL PROC [calledPartyID: PartyID, convID: ConversationID_nullConvID] RETURNS [ cDesc: ConvDesc ] = { state: StateInConv; 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: $initiating ]; IF nb # $success THEN { -- Do something interesting -- ERROR; }; cDesc _ NoteNewState[convEvent]; }; $reserved, $parsing => NULL; ENDCASE => { info.ReportConversationState[$convStillActive, NIL, "Conversation already in progress"]; RETURN; }; 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"]; <> 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; <> 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; UninitFinchSmarts[NIL]; info _ NEW[FinchSmarts.FinchInfoBody]; -- Dump any old one! info.requests _ MBQueue.Create[]; info.conversations _ NIL; info.ReportSystemState_ReportSystemState; info.ReportConversationState_ReportConversationState; IF thrushInstance = NIL THEN thrushInstance _ 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[]; info.serverInstanceName _ thrushInstance; 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}]; IF (info.serverInstance _ NamesGV.GVGetAttribute[rName: info.serverInstanceName, attribute: $connect, default: NIL]) = NIL THEN { problem_"Telephone server not found"; GOTO InitFailed}; ThPartyRpcControl.ImportInterface[ interfaceName: [type: "ThParty.Lark", instance: info.serverInstance, version: thVR] ! -- 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; <> 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 ]]]; }. <> <> <> <> <> <> <> <<};>> <<>> <> <> <>> <> <> <> <> <