DFInternalImpl.mesa
Copyright Ó 1984, 1985, 1986, 1991, 1992 by Xerox Corporation. All rights reserved.
Levin on December 16, 1983 2:05 pm
Russ Atkinson (RRA) January 20, 1987 5:22:59 pm PST
Michael Plass, January 23, 1992 10:39 am PST
DIRECTORY
BasicTime USING [GMT, nullGMT],
DFInternal USING [Client, LocalFileInfo, RemoteFileInfo],
DFOperations USING [AbortInteraction, DFInfoInteraction, FileInteraction, InfoClass, InfoInteraction, InteractionProc, YesNoInteraction, YesNoResponse],
DFPrivate,
DFUtilities USING [Date, DateToRope, RemoveVersionNumber],
FS USING [ComponentPositions, Error, ErrorDesc, ExpandName, FileInfo],
IO USING [PutF, PutFL, PutFR, PutFR1, rope, STREAM],
Process USING [CheckForAbort, Pause, SecondsToTicks, Ticks],
Rope USING [Concat, Flatten, Fetch, Length, ROPE];
DFInternalImpl: CEDAR PROGRAM
IMPORTS DFUtilities, FS, IO, Process, Rope
EXPORTS DFInternal, DFPrivate = BEGIN
ROPE: TYPE = Rope.ROPE;
STREAM: TYPE = IO.STREAM;
Global "variables"
retryInterval: Process.Ticks ¬ Process.SecondsToTicks[5];
abort: REF DFOperations.AbortInteraction ¬ NIL;
logically, this is constant; it is set by initialization and never changed
Exported to DFPrivate
FatalError: PUBLIC SIGNAL [message: Rope.ROPE] = CODE;
Exported to DFInternal
AbortDF: PUBLIC ERROR = CODE;
SimpleInteraction: PUBLIC PROC [client: DFInternal.Client, interaction: REF] = {
abort: BOOL;
message: ROPE;
IF client = NIL THEN RETURN;
DoLogging[interaction, client.log, client.errlog];
[abort: abort, abortMessageForLog: message] ¬ client.proc[interaction, client.data];
IF abort THEN {
[] ¬ client.proc[NEW[DFOperations.InfoInteraction ¬ [class: $abort, message: message]], client.data];
DoAbort[client.log, message, NIL, NIL];
};
};
YesOrNo: PUBLIC PROC[client: DFInternal.Client, message: ROPE, default: BOOL, blunder: BOOL ¬ FALSE] RETURNS [choice: BOOL] = {
response: REF = DoInteraction[
client,
NEW[DFOperations.YesNoInteraction ¬ [
message: message,
blunder: blunder,
default: default
]]
];
choice ¬ default;
WITH response SELECT FROM
r: REF DFOperations.YesNoResponse => choice ¬ r­;
ENDCASE;
};
DoInteraction: PUBLIC PROC [client: DFInternal.Client, interaction: REF] RETURNS [response: REF] = {
abort: BOOL;
message: ROPE;
IF client = NIL THEN RETURN [NIL];
DoLogging[interaction, client.log, client.errlog];
[abort, message, response] ¬ client.proc[interaction, client.data];
IF abort THEN {
[] ¬ client.proc[NEW[DFOperations.InfoInteraction ¬ [class: $abort, message: message]], client.data];
DoAbort[client.log, message, NIL, NIL];
};
};
CheckAbort: PUBLIC PROC [client: DFInternal.Client] = {
Process.CheckForAbort[];
SimpleInteraction[client, abort];
};
DoAbort: PUBLIC PROC [log: STREAM, message: ROPE, proc: DFOperations.InteractionProc, clientData: REF] = {
interaction: REF = NEW[DFOperations.InfoInteraction ¬ [class: $abort, message: message]];
IF proc # NIL AND message # NIL THEN [] ¬ proc[interaction, clientData];
DoLogging[interaction, log, log];
ERROR AbortDF
};
DefaultInteractionProc: PUBLIC DFOperations.InteractionProc = {
[interaction: REF, clientData: REF] RETURNS [abort: BOOLFALSE, abortMessageForLog: ROPENIL, response: REFNIL]
WITH interaction SELECT FROM
a: REF DFOperations.AbortInteraction => RETURN [abort: a.fromABORTED];
ENDCASE;
};
GetFileInfo: PUBLIC PROC [info: REF, notFoundOK: BOOL, remoteCheck: BOOL, client: DFInternal.Client, errorLevel: DFOperations.InfoClass] = {
WITH info SELECT FROM
local: REF DFInternal.LocalFileInfo => {
date: DFUtilities.Date ¬ [];
name: ROPE ¬ local.name;
IF local.date.format # $explicit THEN name ¬ DFUtilities.RemoveVersionNumber[name];
name ¬ local.name ¬ FS.ExpandName[name: name, wDir: client.workingDir].fullFName;
[fullFName: name, attachedTo: local.attachedTo, created: date.gmt, keep: local.keep] ¬
FS.FileInfo[name: name, remoteCheck: remoteCheck
! FS.Error =>
SELECT TRUE FROM
error.group = $user AND notFoundOK => CONTINUE;
RetryFSOperation[error, client] => RETRY;
client # NIL => ReportFSError[error, info, client, errorLevel];
ENDCASE
];
local.name ¬ Rope.Flatten[name]; -- to aid debug
IF date.gmt # BasicTime.nullGMT THEN date.format ¬ $explicit;
local.date ¬ date;
};
remote: REF DFInternal.RemoteFileInfo => {
date: DFUtilities.Date ¬ IF remote.date.format = $explicit THEN remote.date ELSE [];
uName: ROPE ¬ DFUtilities.RemoveVersionNumber[remote.name];
gmt: BasicTime.GMT ¬ BasicTime.nullGMT;
RRA: The preferred version, regardless of the one hinted at, is the highest version number. This crock helps avoid problems with deleting elderly (but still correct) versions using Chat. Ideally our tools would play together such that this did not happen.
[fullFName: uName, created: gmt] ¬
FS.FileInfo[name: uName, wantedCreatedTime: date.gmt, remoteCheck: TRUE
! FS.Error =>
SELECT TRUE FROM
error.group = $user AND notFoundOK => CONTINUE;
RetryFSOperation[error, client] => RETRY;
client # NIL => ReportFSError[error, info, client, errorLevel];
ENDCASE
];
remote.name ¬ Rope.Flatten[uName]; -- to aid debug
IF gmt # BasicTime.nullGMT THEN
We have found an explcit date.
date.format ¬ $explicit;
date.gmt ¬ gmt;
remote.date ¬ date;
};
ENDCASE => ERROR;
};
LocalFile: PUBLIC PROC [file: ROPE, client: DFInternal.Client] RETURNS [BOOL] = {
<<len: INT ¬ Rope.Length[file];
IF len > 2 THEN
SELECT Rope.Fetch[file, 0] FROM
'[, '/ => {
SELECT Rope.Fetch[file, 1] FROM
'], '/ => RETURN [TRUE];
ENDCASE => RETURN [FALSE];
};
ENDCASE;
Although the given file name does not start with a server, it could be a local file if the working directory is local, so we have to do this the hard way.
RETURN [FS.ExpandName[name: file, wDir: client.workingDir
! FS.Error => CONTINUE].cp.server.length = 0];>>
RETURN [TRUE]
};
ShortName: PUBLIC PROC [file: ROPE, keepVersion: BOOL ¬ FALSE] RETURNS [ROPE] = {
We do our own parsing here for efficiency.
bang: INT ¬ Rope.Length[file];
pos: INT ¬ bang;
WHILE pos # 0 DO
SELECT Rope.Fetch[file, pos ¬ pos - 1] FROM
'! => IF NOT keepVersion THEN bang ¬ pos;
'>, '/, '] => {pos ¬ pos + 1; EXIT};
ENDCASE;
ENDLOOP;
RETURN [Rope.Flatten[file, pos, bang-pos]];
};
RetryFSOperation: PUBLIC PROC [error: FS.ErrorDesc, client: DFInternal.Client] RETURNS [retry: BOOL ¬ FALSE] = {
IF error.group # $environment THEN RETURN [FALSE];
retry ¬ YesOrNo[client: client, message: error.explanation.Concat[". Retry?"], default: TRUE];
SELECT error.code FROM
$serverInaccessible, $connectionRejected, $connectionTimedOut =>
Process.Pause[retryInterval];
ENDCASE;
};
ReportFSError: PUBLIC PROC [error: FS.ErrorDesc, info: REF, client: DFInternal.Client, errorLevel: DFOperations.InfoClass] = {
name: ROPE;
WITH info SELECT FROM
remote: REF DFInternal.RemoteFileInfo => name ¬ remote.name;
local: REF DFInternal.LocalFileInfo =>
name ¬ FS.ExpandName[name ¬ local.name ! FS.Error => CONTINUE].fullFName;
ENDCASE => ERROR;
SimpleInteraction[
client,
NEW[DFOperations.InfoInteraction ¬ [
class: errorLevel,
message:
IO.PutFR["%gFS.Error: %g",
[rope[IF error.group = $user THEN NIL ELSE "Unexpected "]],
[rope[error.explanation]]]
]]
];
IF errorLevel = $abort AND client # NIL THEN DoAbort[client.log, NIL, NIL, NIL];
};
Internal Procedures
DoLogging: PROC [interaction: REF, infolog, errlog: STREAM] = {
Log: PROC [infoClass: DFOperations.InfoClass] RETURNS [STREAM] ~ INLINE {
RETURN [IF infoClass = $info OR errlog = NIL THEN infolog ELSE errlog];
};
WITH interaction SELECT FROM
info: REF DFOperations.InfoInteraction => {
log: STREAM ~ Log[info.class];
IF log = NIL THEN RETURN;
log.PutF["%g%g\N",
IO.rope[
SELECT info.class FROM
warning => "Warning: ", error => "Error: ", abort => "Abort: ", ENDCASE => NIL
],
IO.rope[info.message]
];
};
info: REF DFOperations.DFInfoInteraction => {
log: STREAM ~ Log[$info];
IF log = NIL THEN RETURN;
log.PutF["%g: %g%g\N",
IO.rope[
SELECT info.action FROM
$start => "Start", $end => "End", $abort => "Abort", ENDCASE => NIL
],
IO.rope[info.dfFile],
IO.rope[IF info.message = NIL THEN NIL ELSE IO.PutFR1[" (%g)", IO.rope[info.message]]]
];
};
file: REF DFOperations.FileInteraction => {
log: STREAM ~ Log[$info];
IF log = NIL THEN RETURN;
log.PutFL["%g %g %g {%g}%g\N", LIST[
IO.rope[file.localFile],
IO.rope[
SELECT file.action FROM
$fetch => "<--", $store => "-->", $check => "<-->", ENDCASE => NIL],
IO.rope[file.remoteFile],
IO.rope[DFUtilities.DateToRope[[$explicit, file.date]]],
IO.rope[
IF file.dateFormat = $explicit THEN NIL
ELSE IO.PutFR1[" ('%g')",
SELECT file.dateFormat FROM
$greaterThan => [character['>]],
$notEqual => [rope["#"]],
ENDCASE => [null[]]
]
]
]];
};
ENDCASE;
};
Initialization
Initialize: PROC = {
abort ¬ NEW[DFOperations.AbortInteraction ¬ [FALSE]];
};
Initialize[];
END.