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: BOOL ← FALSE, abortMessageForLog: ROPE ← NIL, response: REF ← NIL]
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.