<> <> <> <> DIRECTORY <> 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 <> 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; <> pd: PUBLIC REF VoiceUtils.PD _ NEW[VoiceUtils.PD_[]]; <> ROPE: TYPE = Rope.ROPE; STREAM: TYPE = IO.STREAM; WhereToReport: TYPE = VoiceUtils.WhereToReport; WhereProc: TYPE = VoiceUtils.WhereProc; <> <<>> 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_DoReport[remark, where, whereData, TRUE])#NIL AND pd.reportMethods[priority].reportByMail THEN MailReport[reportValue, priority]; <<**PTZ PCedar conversion>> <> }; 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; <> crowbar _ IF problem THEN (problemCount_problemCount+1) >= pd.problemLimit ELSE (reportCount_reportCount+1) >= pd.reportLimit; IF crowbar THEN { reportCount_problemCount_0; 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_0; }; 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[]; <> <<>> Envelope: TYPE = REF EnvelopeBody; EnvelopeBody: TYPE = RECORD [ reportValue: ROPE, priority: VoiceUtils.ProblemPriority ]; MailReport: PROC[reportValue: ROPE, priority: VoiceUtils.ProblemPriority] = { <> 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; <> WHILE (period_BasicTime.Period[from: lastMailedReportTime, to: (now_BasicTime.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_0; problemCount: INT_0; lastMailedReportTime: BasicTime.GMT _ BasicTime.earliestGMT; currentMailPriority: VoiceUtils.ProblemPriority _ minimal; cumulativeValue: ROPE; mailbox: MBQueue.Queue _ MBQueue.Create[]; <<>> <> 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 _ ""; zipTime => ts_""; ENDCASE; IF ts#NIL THEN { stream.PutRope[ts]; RETURN; }; }; ENDCASE; IF origPrintTime#NIL THEN origPrintTime[stream, val, format, char]; }; <> <<>> 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] = { <> 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_c+('a-'A); ENDCASE}; <<>> RnameToRspec: PUBLIC PROC[name: VoiceUtils.Rname, defaultRegistry: ROPE_NIL] RETURNS [spec: VoiceUtils.Rspec] ={ j: INT_0; 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]; }; <<>> <> 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] = { <> 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]; }; <<>> <> <<>> 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_Arpa.nullAddress, port: ArpaUDP.Port_ArpaUDP.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] ]; }; <<>> <> <<>> MakeAtom: PUBLIC PROC[rName: VoiceUtils.Rname, case: BOOL_FALSE] RETURNS [ATOM] = { <> <> RETURN[Atom.MakeAtom[ IF ~case THEN LowerCaseRope[rName] ELSE rName]]; }; unique: BasicTime.GMT _ BasicTime.earliestGMT; GetUniqueID: PUBLIC ENTRY PROC RETURNS [CARD32] = { <> 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]]; }; <<>> <> <<>> CmdOrToken: PUBLIC PROC[cmd: Commander.Handle, key: ROPE, default: ROPE] <> 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]; }; <> { 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]; }. <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <<>>