<> <> <> <> <> <> <> DIRECTORY AlpFile USING [AccessFailed], AlpineFS USING [ErrorFromStream], Booting USING [RegisterProcs, CheckpointProc, RollbackProc], BasicTime USING [OutOfRange, GMT], Convert USING [RopeFromTime], DB USING [Aborted, Error, Failure, InternalError, AbortTransaction, CloseTransaction, DeclareSegment, TransactionOf], FS USING [Error, ErrorDesc, ErrorFromStream], IO, Labels USING [Set], MBQueue USING [Action, DequeueAction, QueueClientAction], MBQueueExtras USING [FlushWithCallback], Process USING [Detach], Rope, UserCredentials USING [Get], UserProfile USING [Boolean, CallWhenProfileChanges, Number, ProfileChangedProc], ViewerClasses USING [Viewer], ViewerLocks USING [CallUnderWriteLock], ViewerSpecs USING [openRightTopY], ViewerOps, WalnutControlMonitorImpl, WalnutControlPrivate USING [doingCheckpoint, forceQuitMenu, lastStateReported, mailDBMenu, maybeQuitMenu, mustQuitWalnut, nonMailDBMenu, previousUser, readOnlyDBMenu, rollbackFinished, scavMenu, segmentName, CloseDownWalnut, InternalConfirm], WalnutDB USING [activeMsgSet, NumInMsgSet], WalnutDBLog USING [SchemaMismatch, SchemaVersionTime, GetCopyInProgress, GetCurrentLogFile, GetExpectedDBLogPos, GetExpectedLogLength, GetStartExpungePos, SetStartExpungePos], WalnutMsgOps USING [BuildListOfMsgsViewer, FixUpMsgSetViewer, FixUpMsgViewer], WalnutLog USING [AbortLogTransaction, CloseLogStream, CloseWalnutTransaction, FinishExpunge, InitializeLog, LogLength, MarkWalnutTransaction, OpenWalnutTransaction, UpdateFromLog], WalnutLogExtras USING [QuietlyMarkTransaction], WalnutExtras USING [ CheckForAutoCommit, CloseTS, ChangeWalnutMenu, ClearMsgSetDisplayers, DoScavenge, EnumWalnutViewers, InternalChangeMenu, NotifyIfAppropriate, OpenTS, TakeDownWalnutViewers], WalnutRetrieve USING [CloseConnection, OpenConnection], WalnutSendOps USING [userRName], WalnutWindow USING [enableTailRewrite, excessBytesInLogFile, initialActiveIconic, initialActiveOpen, initialActiveRight, logIsAlpineFile, mailNotifyLabel, msgSetBorders, personalMailDB, readOnlyAccess, walnut, walnutLogName, walnutMenu, walnutQueue, walnutRulerAfter, walnutSegmentFile, workingMenu, DestroyAllMsgSetButtons, DisplayMsgSet, Report, ReportRope, ShowMsgSetButtons]; WalnutNotifierImpl: CEDAR MONITOR LOCKS walnutControlLock IMPORTS walnutControlLock: WalnutControlMonitorImpl, BasicTime, Convert, AlpFile, AlpineFS, DB, FS, Labels, MBQueue, MBQueueExtras, Booting, IO, Process, Rope, UserCredentials, UserProfile, ViewerLocks, ViewerOps, WalnutControlPrivate, WalnutDB, WalnutDBLog, WalnutMsgOps, WalnutExtras, WalnutLog, WalnutLogExtras, WalnutRetrieve, WalnutSendOps, WalnutWindow EXPORTS WalnutControlPrivate, WalnutWindow SHARES WalnutControlMonitorImpl, WalnutWindow = BEGIN OPEN WalnutControlPrivate, WalnutExtras, WalnutWindow; <> ROPE: TYPE = Rope.ROPE; Viewer: TYPE = ViewerClasses.Viewer; failureRope: ROPE = "\nDB.Failure: what: %g; info: %g at %g"; abortRope: ROPE = " \n Database transaction was aborted at %g ... restarting\n"; scavengeMsg: ROPE = "Click Scavenge or Quit"; forceQuitRope: ROPE = "You must quit out of Walnut; Click Quit when ready"; waitingToQuit: BOOL_ FALSE; -- co-ordinate rollback & userchanged procs!!! WaitForGVLabel: ROPE = "Waiting for Grapevine response..."; NoMailLabel: ROPE = "Cannot retrieve mail using this database"; ROAccessLabel: ROPE = "You only have Read access to this database"; LogNotOpen: SIGNAL = CODE; <<* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *>> WalnutNotifier: PUBLIC PROC = BEGIN OPEN MBQueue, IO; DO BEGIN ENABLE BEGIN ABORTED => { MBQueueExtras.FlushWithCallback[walnutQueue, CheckForNotify]; ChangeWalnutMenu[walnutMenu]; LOOP }; AlpFile.AccessFailed => { IF missingAccess = spaceQuota THEN ReportRope["\nOut of space"] ELSE ReportRope["\nOther alpine file error"]; GOTO outOfSpace; }; DB.Aborted => { ReportRope[PutFR[abortRope, time[]]]; GOTO aborted}; DB.Failure => { Report[PutFR[failureRope, atom[what], rope[info], time[]]]; GOTO failure}; IO.Error => IF ec = Failure THEN { ed: FS.ErrorDesc_ GetErrorDesc[stream]; ReportRope[ed.explanation]; IF ed.code = $transAborted THEN Report[PutFR[" at %g", time[]]] ELSE Report[""]; IF ed.code = $quotaExceeded THEN GOTO outOfSpace; IF ed.code = $transAborted THEN GOTO aborted ELSE GOTO failure; } ELSE --is this the right hing to do here??? { MBQueueExtras.FlushWithCallback[walnutQueue, CheckForNotify]; ChangeWalnutMenu[walnutMenu]; LOOP }; END; action: Action_ DequeueAction[walnutQueue]; WITH action SELECT FROM e1: Action.user => e1.proc[e1.parent, e1.clientData, e1.mouseButton, e1.shift, e1.control]; e2: Action.client => { IF e2.proc = ClosingWalnut THEN { MBQueueExtras.FlushWithCallback[walnutQueue, CheckForNotify]; RETURN}; e2.proc[e2.data]; }; ENDCASE => ERROR; WalnutExtras.CheckForAutoCommit[]; EXITS aborted => { CleanUpState[]; RestartWalnut[] }; failure => { CleanUpState[]; IF ShallWeQuit[] THEN CloseDownWalnut[TRUE] ELSE RestartWalnut[]; }; outOfSpace => { NeedAnEntry: ENTRY PROC = BEGIN ENABLE UNWIND => NULL; []_ InternalConfirm[forceQuitMenu]; END; Report[""]; -- end the line CleanUpState[]; Report[forceQuitRope]; waitingToQuit_ TRUE; NeedAnEntry[]; waitingToQuit_ FALSE; CloseDownWalnut[FALSE]; }; END; ENDLOOP; END; GetErrorDesc: PROC[stream: IO.STREAM] RETURNS[FS.ErrorDesc] = BEGIN SELECT IO.GetInfo[stream].class FROM $AlpineFS => RETURN[AlpineFS.ErrorFromStream[stream]]; $FS, $File => RETURN[FS.ErrorFromStream[stream]]; ENDCASE => ERROR; END; CleanUpState: ENTRY PROC = BEGIN ENABLE UNWIND => NULL; ViewerOps.BlinkIcon[walnut]; MBQueueExtras.FlushWithCallback[walnutQueue, CheckForNotify]; IF DB.TransactionOf[segmentName] # NIL THEN DB.AbortTransaction[DB.TransactionOf[segmentName] ! DB.Failure, IO.Error => CONTINUE]; END; ShallWeQuit: ENTRY PROC RETURNS[doQuit: BOOL] = BEGIN ENABLE UNWIND => NULL; Report["Click Quit or Retry"]; waitingToQuit_ TRUE; doQuit_ InternalConfirm[maybeQuitMenu]; waitingToQuit_ FALSE; END; <> CheckForNotify: PROC[action: MBQueue.Action] = BEGIN OPEN MBQueue; WITH action SELECT FROM e1: Action.user => NULL; e2: Action.client => IF e2.proc # ClosingWalnut THEN NotifyIfAppropriate[e2.data]; ENDCASE => ERROR; END; <> FlushWQueue: PUBLIC PROC = { MBQueueExtras.FlushWithCallback[walnutQueue, CheckForNotify] }; <<* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *>> AbandonStartup: INTERNAL PROC[s: ROPE_ NIL] RETURNS[BOOL] = BEGIN IF s # NIL THEN {ReportRope[s]; Report[" you only have Read access"]}; Report[forceQuitRope]; waitingToQuit_ TRUE; []_ InternalConfirm[forceQuitMenu]; waitingToQuit_ FALSE; CloseDownWalnut[FALSE]; RETURN[FALSE] END; RestartWalnut: PUBLIC ENTRY PROC = <> BEGIN ENABLE UNWIND => NULL; BEGIN OpenTS["Restart after rollback\n"]; -- displayed if ts not already open CloseTransactions[ TRUE ! DB.Failure, IO.Error => GOTO failure]; EXITS failure => IF DB.TransactionOf[segmentName] # NIL THEN DB.AbortTransaction[DB.TransactionOf[segmentName ! IO.Error, ABORTED => CONTINUE]]; END; IF ~StartOrRestartWalnut[FALSE] THEN RETURN; Report["Restart finished"]; END; <<* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *>> CloseTransactions: PUBLIC INTERNAL PROC[doCommit: BOOL] = BEGIN BEGIN ENABLE BEGIN DB.Aborted, UNWIND => GOTO dbAborted; IO.Error => GOTO ioErr; END; IF doCommit THEN WalnutLog.CloseWalnutTransaction[] -- can cause FileIOAlpine.Aborted ELSE DB.AbortTransaction[DB.TransactionOf[segmentName]]; EXITS dbAborted => DB.AbortTransaction[DB.TransactionOf[segmentName]]; ioErr => { DB.AbortTransaction[DB.TransactionOf[segmentName]]; WalnutLog.AbortLogTransaction[ ! IO.Error => CONTINUE]; }; END; <> BEGIN ENABLE IO.Error, UNWIND => GOTO ioError; WalnutLog.CloseLogStream[]; -- can cause FileIOAlpine.Aborted EXITS ioError => WalnutLog.AbortLogTransaction[ ! IO.Error, UNWIND => CONTINUE]; END; END; StartOrRestartWalnut: PUBLIC INTERNAL PROC[firstTime: BOOL_ FALSE, scavengeFirst: BOOL_ FALSE] RETURNS[BOOL] = BEGIN OPEN WalnutLog, WalnutDBLog; DO BEGIN ENABLE BEGIN UNWIND => GOTO mustQuit; AlpFile.AccessFailed => { IF missingAccess = spaceQuota THEN Report["\nOut of space"] ELSE Report["\nOther alpine file error"]; GOTO mustQuit; }; DB.Aborted => GOTO mustQuit; DB.Failure => { Report[IO.PutFR[failureRope, IO.atom[what], IO.rope[info], IO.time[]]]; GOTO mustQuit }; IO.Error => IF ec = Failure THEN { ed: FS.ErrorDesc_ GetErrorDesc[stream]; Report[ed.explanation]; GOTO mustQuit } ELSE GOTO mustQuit; FS.Error => { Report[error.explanation]; GOTO mustQuit}; END; transOK: BOOL_ TRUE; curVersion: BasicTime.GMT; curLength, expectedLength: INT; openTries: INTEGER_ 0; logFromDB: ROPE; wasReadOnly: BOOL_ readOnlyAccess; logFileNotFound, noDB: BOOL_ FALSE; notFoundRope: ROPE = " not found and can't be created"; didScavenge: BOOL_ FALSE; readOnlyAccess_ FALSE; <> IF DB.TransactionOf[segmentName] # NIL THEN CloseTransactions[FALSE]; DB.DeclareSegment[filePath: walnutSegmentFile, segment: segmentName]; <> IF scavengeFirst THEN { Report["Doing scavenge"]; BEGIN DoScavenge[startPos: 0 ! DB.Error => IF code = ProtectionViolation THEN GOTO pvError]; didScavenge_ TRUE; EXITS pvError => { Report["Protection violation, aborting"]; RETURN[FALSE]}; END; Report[" ...done"] }; OpenWalnutTransaction[segmentName, NIL, FALSE ! -- does InitializeDBVars DB.InternalError => {transOK_ FALSE; CONTINUE}; WalnutDBLog.SchemaMismatch => {curVersion_ schemaVersion.time; transOK_ FALSE; CONTINUE}; DB.Aborted => {IF (openTries_ openTries + 1) < 3 THEN RETRY ELSE REJECT}; DB.Error => IF code = ProtectionViolation THEN {readOnlyAccess_ TRUE; CONTINUE} ELSE IF code = FileNotFound THEN {noDB_ TRUE; CONTINUE } ELSE REJECT; ]; IF noDB THEN { Report[" Database file ", walnutSegmentFile, notFoundRope]; RETURN[AbandonStartup[]] }; IF readOnlyAccess THEN { DB.CloseTransaction[DB.TransactionOf[segmentName]]; -- ugh DB.DeclareSegment[filePath: walnutSegmentFile, segment: segmentName, readonly: TRUE, createIfNotFound: FALSE]; -- need both BOOL's OpenWalnutTransaction[segmentName, NIL, FALSE ! -- does InitializeDBVars DB.InternalError => {transOK_ FALSE; CONTINUE}; WalnutDBLog.SchemaMismatch => {curVersion_ schemaVersion.time; transOK_ FALSE; CONTINUE}; DB.Aborted => {IF (openTries_ openTries + 1) < 3 THEN RETRY ELSE REJECT}; DB.Error => { IF code = ProtectionViolation OR code = FileNotFound THEN {noDB_ TRUE; CONTINUE } ELSE REJECT }; ]; walnutMenu_ readOnlyDBMenu; personalMailDB_ FALSE; } ELSE walnutMenu_ IF personalMailDB THEN mailDBMenu ELSE nonMailDBMenu; IF noDB THEN { Report[" ReadOnly Database ", walnutSegmentFile, notFoundRope]; RETURN[AbandonStartup[]] }; IF ~transOK THEN { xx: ROPE; xx_ Convert.RopeFromTime[curVersion ! BasicTime.OutOfRange => CONTINUE]; IF xx # NIL THEN Report[ IO.PutFR["\nDatabase schema is of %g, but Walnut wants it to be %g", IO.rope[xx], IO.time[WalnutDBLog.SchemaVersionTime]]] ELSE Report["Database has wrong time format"]; IF readOnlyAccess THEN RETURN[AbandonStartup[]]; Report[scavengeMsg]; IF ~InternalConfirm[scavMenu] THEN { CloseDownWalnut[FALSE]; waitingToQuit_ FALSE; RETURN[FALSE]}; DoScavenge[startPos: 0]; scavengeFirst_ FALSE; didScavenge_ TRUE; }; logFromDB_ GetCurrentLogFile[]; IF logFromDB.Length[] # 0 AND ~personalMailDB THEN walnutLogName_ logFromDB; WalnutLogExtras.QuietlyMarkTransaction[]; -- in case had to create database BEGIN curLength_ InitializeLog[walnutLogName ! FS.Error => {IF error.group # user THEN {Report[error.explanation]; GOTO cantOpen}; IF error.code = $unKnownFile THEN {logFileNotFound_ TRUE; CONTINUE} ELSE REJECT; }]; EXITS cantOpen => RETURN[AbandonStartup[]]; END; IF curLength < 0 THEN { SIGNAL LogNotOpen; RETURN[AbandonStartup[]]}; IF logFileNotFound AND readOnlyAccess THEN { Report["Log file ", walnutLogName, notFoundRope]; RETURN[AbandonStartup[]] }; IF GetCopyInProgress[] THEN { IF readOnlyAccess THEN RETURN[AbandonStartup["This database needs to finish a copyInProgress"]]; ReportRope[" Recovering from interrupted Expunge ..."]; WalnutLog.FinishExpunge[]; Report[" done"]; curLength_ LogLength[FALSE]; }; expectedLength_ GetExpectedLogLength[]; IF curLength < expectedLength THEN { ReportRope["Log length is less than expected; "]; IF readOnlyAccess THEN RETURN[AbandonStartup[" .. A scavenge is necessary but .."]]; Report["You Must Scavenge"]; Report[scavengeMsg]; IF ~InternalConfirm[scavMenu] THEN { CloseDownWalnut[FALSE]; waitingToQuit_ FALSE; RETURN[FALSE]}; DoScavenge[startPos: 0]; didScavenge_ TRUE; }; IF personalMailDB THEN WalnutRetrieve.OpenConnection[WalnutSendOps.userRName]; Labels.Set[mailNotifyLabel, IF personalMailDB THEN WaitForGVLabel ELSE IF readOnlyAccess THEN ROAccessLabel ELSE NoMailLabel]; InternalChangeMenu[workingMenu]; IF (expectedLength_ GetExpectedDBLogPos[]) # curLength THEN { IF readOnlyAccess THEN RETURN[AbandonStartup["Log file is longer than expected; updating is necessary but "]]; ReportRope["Updating database from log file ..."]; IF expectedLength = 0 THEN {DoScavenge[startPos: 0]; didScavenge_ TRUE} ELSE { []_ WalnutLog.UpdateFromLog[expectedLength]; WalnutLog.MarkWalnutTransaction[]; -- commit what's been read }; }; ShowMsgSetButtons[]; IF ~walnut.iconic THEN ViewerOps.PaintViewer[walnut, client]; <> IF firstTime THEN { dif: INTEGER; wH: INTEGER_ ViewerSpecs.openRightTopY/4; startExpungePos: INT_ GetStartExpungePos[]; endOfLog: INT_ LogLength[doFlush: FALSE]; LockedSetHeight: PROC = {ViewerOps.SetOpenHeight[walnut, wH - dif]}; IF (dif_ (wH-walnutRulerAfter.cy) - 100) # 0 THEN { ViewerLocks.CallUnderWriteLock[LockedSetHeight, walnut]; IF ~walnut.iconic THEN ViewerOps.ComputeColumn[walnut.column] }; IF didScavenge THEN { Report["Do you want to set the StartExpungePos to the current end of your log?"]; IF InternalConfirm[] THEN { SetStartExpungePos[endOfLog]; MarkWalnutTransaction[]; Report[IO.PutFR["StartExpungePos set to %g", IO.int[endOfLog]]]; } ELSE Report["StartExpungePos is at zero"]; } ELSE IF logIsAlpineFile AND enableTailRewrite AND (expectedLength_ (curLength - startExpungePos)) > excessBytesInLogFile THEN Report[IO.PutFR[ "There are %g bytes (%g pages) in the tail of your log file;\nconsider doing an expunge", IO.int[expectedLength], IO.int[(expectedLength/512)+1]]]; }; FixUpWalnutViewers[]; IF initialActiveOpen AND firstTime THEN { IF personalMailDB OR WalnutDB.NumInMsgSet[WalnutDB.activeMsgSet] # 0 THEN []_ DisplayMsgSet[WalnutDB.activeMsgSet] }; InternalChangeMenu[walnutMenu]; doingCheckpoint_ FALSE; BROADCAST rollbackFinished; walnut.inhibitDestroy_ FALSE; RETURN[TRUE]; EXITS mustQuit => { Report["Start or Restart failed; click Quit or Retry"]; IF InternalConfirm[maybeQuitMenu] THEN { CloseDownWalnut[TRUE]; waitingToQuit_ FALSE; RETURN[FALSE]}; }; END; ENDLOOP; END; FixUpWalnutViewers: PROC = BEGIN msgSetList, msgList, queryList: LIST OF Viewer; mL: LIST OF ROPE; v: Viewer; fullName: ROPE; [msgSetList, msgList, queryList]_ EnumWalnutViewers[TRUE]; FOR vL: LIST OF Viewer_ msgSetList, vL.rest UNTIL vL=NIL DO fullName_ NARROW[ViewerOps.FetchProp[v_ vL.first, $Entity]]; WalnutMsgOps.FixUpMsgSetViewer[fullName, v]; ENDLOOP; FOR vL: LIST OF Viewer_ queryList, vL.rest UNTIL vL=NIL DO mL_ NARROW[ViewerOps.FetchProp[v_ vL.first, $WalnutQuery]]; []_ WalnutMsgOps.BuildListOfMsgsViewer[mL, v.name, v]; ENDLOOP; FOR vL: LIST OF Viewer_ msgList, vL.rest UNTIL vL=NIL DO fullName_ NARROW[ViewerOps.FetchProp[v_ vL.first, $Entity]]; WalnutMsgOps.FixUpMsgViewer[fullName, v]; ENDLOOP; END; <<* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *>> QuitWalnut: PUBLIC ENTRY PROC[ra: REF ANY ] = BEGIN ENABLE UNWIND => NULL; IF ra # NIL THEN { msg: ROPE_ NARROW[ra]; IF walnut = NIL THEN RETURN; -- something funny OpenTS[]; -- if after rollback, may not be open walnut.inhibitDestroy_ TRUE; TakeDownWalnutViewers[]; -- make the user notice ViewerOps.BlinkIcon[walnut, IF walnut.iconic THEN 0 ELSE 1]; Report["**********", msg]; Report["You MUST quit out of Walnut; Click Quit when ready"]; []_ InternalConfirm[forceQuitMenu]; }; CloseDownWalnut[TRUE]; waitingToQuit_ FALSE; END; ClosingWalnut: PUBLIC PROC[ra: REF ANY] = {NULL}; <<-------------------------->> mustQuitMessage: ROPE = "Logged-in user changed"; SetWalnutProfileVars: ENTRY UserProfile.ProfileChangedProc = CHECKED BEGIN ENABLE UNWIND => NULL; curUser: ROPE_ UserCredentials.Get[].name; enableTailRewrite_ UserProfile.Boolean[key: "Walnut.EnableTailRewrite", default: FALSE]; initialActiveIconic_ UserProfile.Boolean[key: "Walnut.InitialActiveIconic", default: FALSE]; initialActiveRight_ UserProfile.Boolean[key: "Walnut.InitialActiveRight", default: TRUE]; initialActiveOpen_ UserProfile.Boolean[key: "Walnut.InitialActiveOpen", default: FALSE]; msgSetBorders_ UserProfile.Boolean[key: "Walnut.MsgSetButtonBorders", default: FALSE]; excessBytesInLogFile_ UserProfile.Number[key: "Walnut.ExcessBytesInLogFile", default: 300000]; IF walnut = NIL OR waitingToQuit THEN {previousUser_ curUser; RETURN}; IF ~Rope.Equal[previousUser, curUser, FALSE] THEN { mustQuitWalnut_ mustQuitMessage; waitingToQuit_ TRUE; MBQueueExtras.FlushWithCallback[walnutQueue, CheckForNotify]; MBQueue.QueueClientAction[walnutQueue, QuitWalnut, mustQuitWalnut]; previousUser_ curUser; }; END; <<-------------------------->> WalnutCheckpointProc: ENTRY Booting.CheckpointProc = BEGIN ENABLE UNWIND => { CloseTS[]}; IF walnut = NIL THEN RETURN; MBQueueExtras.FlushWithCallback[walnutQueue, CheckForNotify]; InternalChangeMenu[workingMenu]; Report["\nDoing Checkpoint ..."]; WalnutRetrieve.CloseConnection[]; lastStateReported_ unknown; doingCheckpoint_ TRUE; DestroyAllMsgSetButtons[]; ClearMsgSetDisplayers[]; BEGIN CloseTransactions[ TRUE ! DB.Failure, IO.Error => GOTO failure]; EXITS failure => IF DB.TransactionOf[segmentName] # NIL THEN DB.AbortTransaction[DB.TransactionOf[segmentName ! IO.Error => CONTINUE]]; END; CloseTS[]; END; WalnutRollbackProc: ENTRY Booting.RollbackProc = { ENABLE UNWIND => NULL; IF walnut = NIL THEN RETURN; IF waitingToQuit THEN RETURN; -- probably user changed, already handled CloseTS[]; -- to be very sure IF ~Rope.Equal[UserCredentials.Get[].name, previousUser, FALSE] THEN { waitingToQuit_ TRUE; TRUSTED { Process.Detach[FORK QuitWalnut[mustQuitMessage]]}} ELSE TRUSTED { Process.Detach[FORK RestartWalnut[]]}; }; <> TRUSTED {Booting.RegisterProcs[c: WalnutCheckpointProc, r: WalnutRollbackProc]}; UserProfile.CallWhenProfileChanges[SetWalnutProfileVars]; END.