LarkSmartsInitImpl.mesa
Last modified by D. Swinehart, February 8, 1984 11:55 am
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;
Copies
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;
Registration/Deregistration/Initialization
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;
Above converts from, say, Swinehart.pa.lark to Swinehart.pa.
Also, from Swinehart.pa to Swinehart.pa. Strips one registry if there are two or more.
DO ENABLE UNWIND=>NULL;
Loop is for restart when had to deregister first.
Produce a Party object for this RName, if none exists yet.
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 reregistration should be a no-op, if all of the supplied parameters make sense.
Otherwise, if there is a previous smartsID for this Lark, it must be eliminated.
<< 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;
};
There are no old Lark Smarts for this Lark. New ones are needed.
Get encryption taken care of
larkSh ← IF NOT ThNet.pd.encryptionRequested THEN Thrush.unencrypted
ELSE Names.StartConversation [
caller: myName.instance,
callee: fullRname,
key: serverPassword,
level: --<<ECB>>--CBCCheck !
RPC.AuthenticateFailed=>{ Log.Problem["Can't authenticate"]; GOTO NotSmart; }];
Make sure we can talk to the Lark
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. >>
larkInterface.Reset[larkSh, NIL];
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; };   
No further bad things are expected to happen.
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] = { []𡤎nableSmarts[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];
Unimport the Lark interface (automatic, via finalization.)
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 };
Other Utilities
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]; };
Initialization, export "LarkSmarts", Import "Multicast"
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];
Same as $Lark, except doesn't print at all if debugging viewer not found.
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[];
}.