[_CDMiwok_01_]<cedarcommon2.0>VoiceUtils>VoiceUtilsImpl.mesa!4

VoiceUtilsImpl.mesa

Last modified by D. Swinehart, February 15, 1988 2:54:18 pm PST

Polle Zellweger (PTZ) August 23, 1990 4:19:48 pm PDT

DIRECTORY

AMEvents USING [ CallDebugger ],

Arpa USING [ Address, nullAddress ],

ArpaUDP USING [ Port, nullPort ],

Atom USING [ GetProp, MakeAtom, PropList, PutProp ],

Basics USING [ HFromCard16, LowHalf ],

BasicTime USING [ earliestGMT, GMT, Now, nullGMT, Period, TimeNotKnown, Unpack, Unpacked, Update ],

Commander USING [ CommandProc, GetProperty, Handle, Register ],

CommandTool USING [ NextArgument ],

Convert USING [ CardFromRope, PupAddressFromRope, RopeFromCard, RopeFromInt ],

ConvertExtras USING [ ArpaAddressFromRope ],

IO,

IOUtils USING [ CopyPFProcs, PFCodeProc, SetDefaultPFCodeProc, SetPFCodeProc ],

MBQueue USING [ Create, Queue, QueueClientAction ],

Process USING [ Pause, SecondsToTicks ],

ProcessProps USING [ GetPropList ],

Pup USING [ nullSocket ],

PupName USING [ NameLookup ],

RefTab USING [ Create, Fetch, Ref, Store ],

Rope USING [ Cat, Concat, Equal, Fetch, Find, IsEmpty, Length, MakeRope, ROPE, Size, SkipTo, Substr ],

RPC USING [ MakeKey, EncryptionKey ],

SimpleMailer USING [ SendMessage ],

ThisMachine USING [ Address ],

UserCredentials USING [ Get ],

UserProfile USING [ Token ],

ViewerIO USING [ CreateViewerStreams ],

VoiceUtils,

VoiceUtilsExtras

;

VoiceUtilsImpl: CEDAR MONITOR -- For report printing synchronization.

IMPORTS

AMEvents,

Atom,

Basics,

BasicTime,

Commander,

CommandTool,

Convert,

ConvertExtras,

IO,

IOUtils,

MBQueue,

Process,

ProcessProps,

PupName,

RefTab,

Rope,

RPC,

SimpleMailer,

ThisMachine,

UserCredentials,

UserProfile,

ViewerIO

EXPORTS VoiceUtils, VoiceUtilsExtras = {

OPEN IO;

Variables

pd: PUBLIC REF VoiceUtils.PD ← NEW[VoiceUtils.PD←[]];

Copies

ROPE: TYPE = Rope.ROPE;

STREAM: TYPE = IO.STREAM;

WhereToReport: TYPE = VoiceUtils.WhereToReport;

WhereProc: TYPE = VoiceUtils.WhereProc;

Reporting and Suspending

WP: TYPE = REF WPRec;

WPRec: TYPE = RECORD [

proc: WhereProc,

fixedWhereData: REF,

defaultIfNotFound: VoiceUtils.DNFProc←NIL

];

RegisterWhereToReport: PUBLIC PROC[

proc: WhereProc, where: WhereToReport, fixedWhereData: REF,

defaultIfNotFound: VoiceUtils.DNFProc] = {

Atom.PutProp[$ReportStreams, where, NEW[WPRec←[proc: proc, fixedWhereData: fixedWhereData, defaultIfNotFound: defaultIfNotFound]]];

};

FindWhere: PUBLIC PROC[where: WhereToReport, whereData: REF] RETURNS [s: IO.STREAM] = {

wp: WP;

IF where=NIL THEN RETURN[pd.sysOut];

wp ← NARROW[Atom.GetProp[$ReportStreams, where]];

IF wp=NIL THEN RETURN[pd.sysOut];

s←wp.proc[wp.fixedWhereData, whereData];

IF s#NIL THEN RETURN[s];

RETURN[IF s#NIL THEN s ELSE IF wp.defaultIfNotFound=NIL OR wp.defaultIfNotFound[where, whereData] THEN pd.sysOut ELSE NIL];

};

DoReport: INTERNAL PROC[remark: ROPE, where: WhereToReport, whereData: REF ←NIL, problem: BOOL]

RETURNS[reportValue: ROPE←NIL] = { -- NIL if report wasn't sent

ENABLE UNWIND => NULL;

resetTime: BOOL←FALSE;

reportS: STREAM ← FindWhere[where, whereData]; {

ENABLE IO.Error => IF ec=$StreamClosed THEN {

resetTime ← TRUE;

where ← NIL;

IF pd.sysOut # pd.ch.out AND pd.ch.out#NIL THEN pd.sysOut ← pd.ch.out

ELSE IF reportS = pd.sysOut THEN

pd.sysOut ← ViewerIO.CreateViewerStreams[name: "Voice System Messages"].out;

reportS ← pd.sysOut;

RETRY;

};

seconds: INT;

IF remark=NIL OR reportS = NIL THEN RETURN;

seconds ← LogTime[reportS, where, problem, resetTime];

IF seconds<0 THEN RETURN[NIL];

reportValue ← IO.PutFR[" %02d: %s\n", int[seconds], rope[remark]];

reportS.PutRope[reportValue]; -- wish I could afford looking up caller.

};

Report: PUBLIC ENTRY PROC[remark: ROPE, where: WhereToReport, whereData: REF ←NIL] = {

ENABLE UNWIND => NULL;

[] ← DoReport[remark, where, whereData, FALSE];

};

ReportFR: PUBLIC PROC[remark: ROPE, where: WhereToReport, whereData: REF,

a1, a2, a3: IO.Value ← VoiceUtils.nullValue] = {

Report[IO.PutFR[remark, a1, a2, a3], where, whereData];

};

Problem: PUBLIC ENTRY PROC[

remark: ROPE, where: WhereToReport, whereData: REF,

priority: VoiceUtils.ProblemPriority ← maximum] = TRUSTED {

ENABLE UNWIND => NULL;

ProblemInt[remark, where, whereData, priority];

};

ProblemInt: INTERNAL PROC[

remark: ROPE, where: WhereToReport, whereData: REF,

priority: VoiceUtils.ProblemPriority ← maximum] = TRUSTED {

reportValue: ROPE;

IF remark=NIL THEN remark←"Unspecified problem";

IF (reportValue𡤍oReport[remark, where, whereData, TRUE])#NIL AND

pd.reportMethods[priority].reportByMail THEN MailReport[reportValue, priority];

**PTZ PCedar conversion

IF pd.attended THEN AMEvents.CallDebugger[remark];

};

ProblemFR: PUBLIC PROC[

remark: ROPE, where: WhereToReport, whereData: REF, a1, a2: IO.Value,

priority: VoiceUtils.ProblemPriority ← maximum] = TRUSTED {

Problem[IO.PutFR[remark, a1, a2], where, whereData, priority];

};

CmdWhere: WhereProc = {

pl: Atom.PropList ← ProcessProps.GetPropList[];

ch: Commander.Handle;

IF pl=NIL THEN RETURN[NIL];

ch ← NARROW[Commander.GetProperty[$CommanderHandle, pl]];

IF ch=NIL THEN RETURN[NIL];

RETURN[ch.err];

};

SetAttended: Commander.CommandProc = {

pd.attended ← TRUE;

Report["Attended[TRUE]", $Cmd, NIL];

};

ClearAttended: Commander.CommandProc = {

pd.attended ← FALSE;

Report["Attended[FALSE]", $Cmd, NIL];

};

MailReports: Commander.CommandProc = {

ablement: ATOM ← NARROW[cmd.procData.clientData, ATOM];

onOff: BOOL ← SELECT ablement FROM

$on => TRUE, $off => FALSE, ENDCASE => ERROR;

pd.reportMethods ← ALL[[FALSE, "Swinehart.pa"]];

pd.reportMethods[$high].reportByMail ← onOff;

pd.reportMethods[$maximum].reportByMail ← onOff;

ReportFR["Mail reporting %g (see VoiceUtilsImpl.pd.reportMethods)",

$Cmd, NIL, atom[ablement]];

};

LogTime: INTERNAL PROC[s: IO.STREAM, where: ATOM, problem: BOOL, resetTime: BOOL] RETURNS [seconds: INT] = {

oldT: REF BasicTime.Unpacked ← NARROW[RefTab.Fetch[logTimes, where].val];

now: BasicTime.GMT ← BasicTime.Now[];

nowU: BasicTime.Unpacked ← BasicTime.Unpack[now];

i1: INT;

crowbar: BOOL←FALSE;

Determine whether any report limits have been exceeded. If so, return -1

crowbar ← IF problem THEN (problemCount←problemCount+1) >= pd.problemLimit

ELSE (reportCount←reportCount+1) >= pd.reportLimit;

IF crowbar THEN {

reportCount←problemCount𡤀

IF pd.reportingEnabled THEN ProblemInt["Report limits Exceeded", $System, NIL, maximum];

pd.reportingEnabled ← FALSE;

intervalStartTime ← now;

};

i1 ← BasicTime.Period[from: intervalStartTime, to: now];

IF i1 >= pd.limitInterval THEN {

intervalStartTime ← now;

IF (reportCount+problemCount) <= pd.problemLimit -- severe hysteresis!

THEN pd.reportingEnabled ← TRUE;

reportCount←problemCount𡤀

};

IF ~pd.reportingEnabled THEN RETURN[-1];

seconds ← nowU.second;

nowU.second ← 0;

nowU.secondsThisYear ← 0;

IF oldT=NIL THEN {

oldT←NEW[BasicTime.Unpacked];

[]←RefTab.Store[logTimes, where, oldT];

};

IF ~resetTime AND nowU=oldT^ THEN RETURN;

oldT^ ← nowU;

s.PutF["%g\n", time[now]];

};

logTimes: RefTab.Ref ← RefTab.Create[];

Associates Where atoms with print times.

Envelope: TYPE = REF EnvelopeBody;

EnvelopeBody: TYPE = RECORD [

reportValue: ROPE,

priority: VoiceUtils.ProblemPriority

];

MailReport: PROC[reportValue: ROPE, priority: VoiceUtils.ProblemPriority] = {

Queue reports, since mailing takes time.

MBQueue.QueueClientAction[mailbox, QdMailReport,

NEW[EnvelopeBody←[reportValue, priority]]];

};

Q: TYPE = RECORD [

LOCK: WORD,

notifier: WORD,

firstEvent: LIST OF REF

];

QdMailReport: PROC[r: REF ANY] = {

envelope: Envelope ← NARROW[r];

now: BasicTime.GMT;

period: INT;

to: ROPE;

Send no more than one report in one pd.maximumMailReportInterval period. Accumulate messages in the interim.

WHILE

(period�sicTime.Period[from: lastMailedReportTime, to: (now�sicTime.Now[])]) < pd.maximumMailReportInterval DO

Process.Pause[MIN[77777B,

Process.SecondsToTicks[pd.maximumMailReportInterval-period]]];

ENDLOOP;

cumulativeValue ← Rope.Concat[cumulativeValue, envelope.reportValue];

currentMailPriority ← MAX[currentMailPriority, envelope.priority];

TRUSTED {IF LOOPHOLE[mailbox, REF Q].firstEvent#NIL THEN RETURN;};

IF cumulativeValue=NIL THEN RETURN;

to ← pd.reportMethods[currentMailPriority].reportTo;

IF to#NIL THEN []←SimpleMailer.SendMessage[

to: LIST[[$gv, to]], subject: "** Voice Server Report", body: cumulativeValue, validate: FALSE]; -- PCedar conversion - check this!

lastMailedReportTime ← now;

cumulativeValue ← NIL;

currentMailPriority ← minimal;

};

intervalStartTime: BasicTime.GMT; -- these are variables computing the limit algorithm

reportCount: INT𡤀

problemCount: INT𡤀

lastMailedReportTime: BasicTime.GMT ← BasicTime.earliestGMT;

currentMailPriority: VoiceUtils.ProblemPriority ← minimal;

cumulativeValue: ROPE;

mailbox: MBQueue.Queue ← MBQueue.Create[];

Render null times harmless in printouts

origPrintTime: IOUtils.PFCodeProc ← NIL;

PrintTime: IOUtils.PFCodeProc = TRUSTED {

ts: ROPE ← NIL;

i: INT ← 0;

zipTime: BasicTime.GMT ← LOOPHOLE[i];

WITH v: val SELECT FROM

time => {

SELECT v.value FROM

BasicTime.nullGMT => ts ← "<Doomsday>";

zipTime => ts←"<BigBang>";

ENDCASE;

IF ts#NIL THEN { stream.PutRope[ts]; RETURN; };

};

ENDCASE;

IF origPrintTime#NIL THEN origPrintTime[stream, val, format, char];

};

RName management

Registrize: PUBLIC PROC[name: ROPE] RETURNS [ROPE] = {

dot: INT;

IF name=NIL THEN RETURN[NIL];

dot←Rope.SkipTo[name, 0, "."];

IF dot=name.Length[] THEN name←Rope.Concat[name, DefaultRegistry[]];

RETURN[name]; };

DefaultRegistry: PROC RETURNS [registry: ROPE] = INLINE {

name: ROPE=CurrentRName[];

dot: INT=Rope.SkipTo[name, 0, "."];

IF dot=name.Length[] THEN ERROR;

RETURN[name.Substr[dot]];

};

CurrentRName: PUBLIC PROC RETURNS [ROPE] = {

This is a hack! PTZ July 19, 1990 2:13:17 pm PDT

name: ROPE ← UserCredentials.Get[].name;

IF Rope.Find[name, "."] = -1 THEN name ← Rope.Concat[name, ".pa"];

RETURN[UserProfile.Token["Finch.GVName", name]];

};

CurrentPasskey: PUBLIC PROC[passwordText: ROPE] RETURNS [RPC.EncryptionKey] = {

IF passwordText=NIL THEN passwordText←UserCredentials.Get[].password;

RETURN[RPC.MakeKey[passwordText]]; };

LowerCaseRope: PUBLIC PROC[r: ROPE] RETURNS [ROPE] = {

RETURN[Rope.MakeRope[base: r, size: r.Size[], fetch: LCFetch]]};

LCFetch: SAFE PROC[data: REF, index: INT] RETURNS [c: CHAR] = TRUSTED {

SELECT (c←NARROW[data,ROPE].Fetch[index]) FROM IN ['A..'Z]=>c𡤌+('a-'A); ENDCASE};

RnameToRspec: PUBLIC PROC[name: VoiceUtils.Rname, defaultRegistry: ROPE←NIL] RETURNS [spec: VoiceUtils.Rspec] ={

j: INT𡤀

i: INT;

WHILE (i←Rope.SkipTo[s: name, pos: j, skip: "."])#Rope.Size[name] DO j←i+1; ENDLOOP;

IF j#0 THEN defaultRegistry←Rope.Substr[base: name, start: j] ELSE j←i+1;

IF Rope.Size[defaultRegistry]=0 THEN RETURN[NIL];

spec←NEW[VoiceUtils.RspecBody←[simpleName: Rope.Substr[name, 0, j-1],

registry: defaultRegistry]]; };

RspecToRname: PUBLIC PROC[spec: VoiceUtils.Rspec] RETURNS [name: VoiceUtils.Rname] = {

RETURN[Rope.Concat[spec.simpleName, Rope.Concat[".", spec.registry]]]; };

RspecToSortName: PUBLIC PROC[spec: VoiceUtils.Rspec] RETURNS [name: ROPE] ={

RETURN[Rope.Concat[spec.registry, Rope.Concat[".", spec.simpleName]]]; };

MakeRName: PUBLIC PROC[name: ROPE, style: VoiceUtils.RNameStyle← rNameDotLark]

RETURNS[rName: ROPE] = {

s1: VoiceUtils.Rspec = RnameToRspec[name, "lark"];

s2: VoiceUtils.Rspec = RnameToRspec[s1.simpleName];

isDotLark: BOOL = s1.registry.Equal["lark", FALSE];

RETURN[SELECT style FROM

rName => RspecToRname[s1],

nameDotLark => IF isDotLark THEN RspecToRname[s1]

ELSE RspecToRname[s1].Cat[".lark"],

rNameDotLark => IF s2#NIL THEN

IF isDotLark THEN RspecToRname[s1] ELSE ERROR

ELSE RspecToRname[s1].Cat[".lark"],

ENDCASE=>NIL];

};

Net Address Functions

OwnNetAddress: PUBLIC PROC RETURNS [netAddress: VoiceUtils.NetAddress] = {

addrRope: ROPE ← ThisMachine.Address[$Pup];

IF Rope.IsEmpty[addrRope] THEN {

arpaAddr: Arpa.Address;

addrRope ← ThisMachine.Address[$Arpa];

arpaAddr ← ConvertExtras.ArpaAddressFromRope[addrRope];

netAddress.net ← [arpaAddr.c];

netAddress.host ← [arpaAddr.d];

netAddress.socket ← Pup.nullSocket;

}

ELSE

netAddress ← Convert.PupAddressFromRope[addrRope];

};

NetAddressFromRope: PUBLIC PROC[netAddressRope: ROPE]

RETURNS [netAddress: VoiceUtils.NetAddress←VoiceUtils.nullNetAddress] = {

Shouldn't be called in the PCedar world.

IF netAddressRope=NIL THEN RETURN;

netAddress ← PupName.NameLookup[name: netAddressRope, default: Pup.nullSocket];

};

InstanceFromNetAddress: PUBLIC PROC[netAddress: VoiceUtils.NetAddress, suffix: ROPE←NIL]

RETURNS [instance: ROPE] = {

instance ← Rope.Cat[Convert.RopeFromInt[netAddress.net, 8, FALSE], "#",

Convert.RopeFromInt[netAddress.host, 8, FALSE], "#", suffix];

};

Sun RPC addresses should look like "sun#[1.2.3.4]#5", where [1.2.3.4] is the Arpa address, and 5 is the port.

SunProtocol: PUBLIC PROC [netAddressRope: ROPE] RETURNS [BOOL] ~ {

RETURN [ Rope.Equal[s1: Rope.Substr[base: netAddressRope, len: 3], s2: "sun", case: FALSE] ];

};

SunAddrFromRope: PUBLIC PROC [netAddressRope: ROPE]
RETURNS [address: Arpa.Address𡤊rpa.nullAddress, port: ArpaUDP.Port𡤊rpaUDP.nullPort] = {

i, j: INT;

protocol, addrRope, portRope: Rope.ROPE;

IF netAddressRope=NIL THEN RETURN;

i ← Rope.Find[s1: netAddressRope, s2: "#"];

protocol ← Rope.Substr[base: netAddressRope, len: i];

IF NOT Rope.Equal[protocol, "sun", FALSE] THEN RETURN; -- malformed address

j ← Rope.Find[s1: netAddressRope, s2: "#", pos1: i+1];

addrRope ← Rope.Substr[base: netAddressRope, start: i+1, len: j-i-1];

portRope ← Rope.Substr[base: netAddressRope, start: j+1];

address ← ConvertExtras.ArpaAddressFromRope[addrRope];

port ← Basics.HFromCard16[Basics.LowHalf[Convert.CardFromRope[portRope]]];

};

RopeFromSunAddr: PUBLIC PROC[address: ROPE←NIL, port: CARD] RETURNS [netAddressRope: ROPE] = {

IF address=NIL THEN

address ← ThisMachine.Address[$Arpa]; -- use Arpa address of this machine

netAddressRope ← Rope.Cat [ "sun#", address, "#", Convert.RopeFromCard[port] ];

};

Random Utilities

MakeAtom: PUBLIC PROC[rName: VoiceUtils.Rname, case: BOOL←FALSE] RETURNS [ATOM] = {

case: if FALSE, case considered not important . . . all calls that expect results to match must use FALSE, since implementation is to convert rName to lower case.

if TRUE, leave rope alone and make the ATOM as is.

RETURN[Atom.MakeAtom[

IF ~case THEN LowerCaseRope[rName] ELSE rName]]; };

unique: BasicTime.GMT ← BasicTime.earliestGMT;

GetUniqueID: PUBLIC ENTRY PROC RETURNS [CARD32] = {

Unique within a session. May be reused due to rollback or reboot, if ids were generated at more than 1 per second just before the restart. Not unique across multiple workstations.

now: BasicTime.GMT;

now ← BasicTime.Now[
! BasicTime.TimeNotKnown => { now ← BasicTime.earliestGMT; CONTINUE } ];

IF BasicTime.Period[from~unique, to~now] > 0

THEN unique ← now

ELSE unique ← BasicTime.Update[unique, 1];

RETURN[LOOPHOLE[unique]];

};

CommandTool parsing aid, to VoiceUtils

CmdOrToken: PUBLIC PROC[cmd: Commander.Handle, key: ROPE, default: ROPE]

If token read is "NIL" (or "nil"), return NIL -- allows arguments to be skipped.

RETURNS [value: ROPE←NIL] = {

value ← CommandTool.NextArgument[cmd];

IF value#NIL OR value.Equal["NIL", FALSE] THEN RETURN;

value ← UserProfile.Token[key: key, default: default];

};

Initialization

{

r: REF = Atom.GetProp[$Interfaces, $PrintTime];

origPrintTime ←

IF r=NIL THEN IOUtils.SetPFCodeProc[IOUtils.CopyPFProcs[NIL], 't, PrintTime].previous

ELSE NARROW[r, REF IOUtils.PFCodeProc]^;

IF r=NIL THEN

Atom.PutProp[$Interfaces, $PrintTime, NEW[IOUtils.PFCodeProc ← origPrintTime]];

[]←IOUtils.SetDefaultPFCodeProc['t, PrintTime];

};

pd.ch ← NARROW[Commander.GetProperty[$CommanderHandle, ProcessProps.GetPropList[]]];

IF pd.ch#NIL THEN { pd.sysIn ← NIL--obsolete--; pd.sysOut ← pd.ch.out; };

intervalStartTime ← BasicTime.Now[];

RegisterWhereToReport[CmdWhere, $Cmd, NIL, NIL];

Commander.Register["Attended", SetAttended, "Break on errors"];

Commander.Register["Unattended", ClearAttended, "Log on errors, then muddle on."];

Commander.Register["MailReports", MailReports, "Set up default mail-reporting methods for Problem routines. See pd.reportMethods.", $on];

Commander.Register["DontMailReports", MailReports, "Set up default mail-reporting methods for Problem routines. See pd.reportMethods.", $off];

Swinehart, May 9, 1986 11:06:55 am PDT

Convert to new Cedar communications package

changes to: DIRECTORY, VoiceUtilsImpl, OwnNetAddress, NetAddressFromRope, InstanceFromNetAddress

Swinehart, February 9, 1987 9:00:30 am PST

Add mail message reporting for Problem calls. Also problem priority, so that not all problems need be reported (all will be, at present, since default is maximum.) Add control over runaway reports and problem reports. A message is posted terminating reports until the number drops below some minimum.

changes to: LogTime, MailReport, Q, QdMailReport, problemCount, cumulativeValue, Commander, MailReports, IF

Polle Zellweger (PTZ) August 31, 1987 6:46:30 pm PDT

changes to: VoiceUtilsImpl, DoReport, reportS, DIRECTORY

Polle Zellweger (PTZ) July 19, 1990 3:08:44 pm PDT

Trying to eradicate Pups insofar as is possible. Fairly hacky so far.

changes to: DIRECTORY, CurrentRName, OwnNetAddress, VoiceUtilsImpl

Polle Zellweger (PTZ) August 13, 1990 2:19:52 pm PDT

Add utilities needed for Sun world (export to VoiceUtilsExtras).

changes to: SunProtocol, SunAddrFromRope, RopeFromSunAddr, unique, GetUniqueID

Polle Zellweger (PTZ) August 23, 1990 3:05:18 pm PDT

changes to: DIRECTORY, VoiceUtilsImpl, NetAddressFromRope, InstanceFromNetAddress

Polle Zellweger (PTZ) August 23, 1990 4:19:48 pm PDT

changes to: DIRECTORY, OwnNetAddress