WalnutNotifierImpl.mesa
Copyright © 1984, 1985 by Xerox Corporation. All rights reserved.
Contents: Notifier & restart code
created July, 1983 by Willie-Sue
Willie-Sue, March 20, 1985 9:31:51 am PST
Russ Atkinson (RRA) April 29, 1985 5:43:40 pm PDT
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, GetSegmentInfo],
FS USING [Error, ErrorDesc, ErrorFromStream],
IO,
Labels USING [Set],
MBQueue USING [Action, DequeueAction, FlushWithCallback, QueueClientAction],
Process USING [Detach],
Rope,
UserCredentials USING [Get],
UserProfile USING [Boolean, CallWhenProfileChanges, Number, ProfileChangedProc],
ViewerClasses USING [Viewer],
ViewerLocks USING [CallUnderWriteLock],
ViewerSpecs USING [openTopY],
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, Booting, IO, Process, Rope, UserCredentials, UserProfile, ViewerLocks, ViewerOps, ViewerSpecs, WalnutControlPrivate, WalnutDB, WalnutDBLog, WalnutMsgOps, WalnutExtras, WalnutLog, WalnutLogExtras, WalnutRetrieve, WalnutSendOps, WalnutWindow
EXPORTS WalnutControlPrivate, WalnutWindow
SHARES WalnutControlMonitorImpl, WalnutWindow =
BEGIN OPEN WalnutControlPrivate, WalnutExtras, WalnutWindow;
Walnut Viewers types and global data
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 =>
{ 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???
{ 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
{ 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];
MBQueue.FlushWithCallback[walnutQueue, CheckForNotify];
IF
DB.GetSegmentInfo[segmentName].trans #
NIL
THEN
DB.AbortTransaction[DB.GetSegmentInfo[segmentName].trans ! 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 can't be an ENTRY proc
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;
for WalnutWindowImpl to call
FlushWQueue:
PUBLIC
PROC =
{ MBQueue.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 =
StartOrRestartWalnut will deal with DB.Failure, IO.Error
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.GetSegmentInfo[segmentName].trans #
NIL
THEN
DB.AbortTransaction[DB.GetSegmentInfo[segmentName].trans ! 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.GetSegmentInfo[segmentName].trans];
EXITS
dbAborted => DB.AbortTransaction[DB.GetSegmentInfo[segmentName].trans];
ioErr =>
{
DB.AbortTransaction[
DB.GetSegmentInfo[segmentName].trans];
WalnutLog.AbortLogTransaction[ ! IO.Error => CONTINUE];
};
END;
db transaction is either Closed or Aborted, now for the log
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 log trans failed, segment file may be open
IF DB.GetSegmentInfo[segmentName].trans # NIL THEN CloseTransactions[FALSE];
DB.DeclareSegment[filePath: walnutSegmentFile, segment: segmentName];
database may be hopelessly mangled from an earlier scavenge attempt
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.GetSegmentInfo[segmentName].trans];
-- 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];
check how much space is left (if any) in the control window for a typescript)
IF firstTime THEN
{ dif:
INTEGER;
wH: INTEGER← ViewerSpecs.openTopY/4;
startExpungePos: INT← GetStartExpungePos[];
endOfLog: INT← LogLength[doFlush: FALSE];
LockedSetHeight: PROC = {ViewerOps.SetOpenHeight[walnut, wH - dif]};
IF (dif← (wH-walnutRulerAfter.wy) - 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;
MBQueue.FlushWithCallback[walnutQueue, CheckForNotify];
MBQueue.QueueClientAction[walnutQueue, QuitWalnut, mustQuitWalnut];
previousUser← curUser;
};
END;
--------------------------
WalnutCheckpointProc:
ENTRY Booting.CheckpointProc =
BEGIN
ENABLE
UNWIND => { CloseTS[]};
IF walnut = NIL THEN RETURN;
MBQueue.FlushWithCallback[walnutQueue, CheckForNotify];
InternalChangeMenu[workingMenu];
Report["\nDoing Checkpoint ..."];
WalnutRetrieve.CloseConnection[];
lastStateReported← unknown;
doingCheckpoint← TRUE;
DestroyAllMsgSetButtons[];
ClearMsgSetDisplayers[];
CloseTransactions[
TRUE !
DB.Failure,
IO.Error =>
GOTO failure];
EXITS
failure =>
IF
DB.GetSegmentInfo[segmentName].trans #
NIL
THEN
DB.AbortTransaction[DB.GetSegmentInfo[segmentName].trans ! 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[]]};
};
clean up Walnut at checkpoint time
TRUSTED {Booting.RegisterProcs[c: WalnutCheckpointProc, r: WalnutRollbackProc]};
UserProfile.CallWhenProfileChanges[SetWalnutProfileVars];
END.