-- FileOp.mesa
-- edited by Schroeder, March 16, 1981 6:04 PM
-- edited by Brotz, March 7, 1983 10:14 AM
-- edited by Taft, May 9, 1983 2:25 PM

DIRECTORY
AltoFile USING [DiskFull],
Core USING [Close, Delete, Open],
csD: FROM "CoreStreamDefs" USING [Close, Destroy, GetLength, Open, ReadStream,
StreamHandle, WriteBlock],
DiskIODefs USING [DiskError],
dsD: FROM "DisplayDefs" USING [ChangeCursor, CursorBitMap, cursorBM, CursorShape,
GetCursor],
exD: FROM "ExceptionDefs" USING [SysBug],
FTPDefs USING [FileHandle, FileInfo, FilePrimitives, FilePrimitivesObject, FileSystem,
FileType, FTPCreateUser, FTPDestroyUser, FTPError, FTPInitialize, FTPOpenConnection,
FTPRetrieveFile, FTPSetCredentials, FTPStoreFile, FTPUser, Mode,
PupCommunicationPrimitives],
inD: FROM "InteractorDefs" USING [realTimeClock],
Inline USING [LowHalf],
intCommon USING [user],
LaurelSendDefs USING [GetSendProtocol, ProtocolType],
opD: FROM "OperationsDefs" USING [FileErrorReason],
SendDefs USING [Expand, ExpandFailed],
Storage USING [FreePages, FreeString, Pages, String],
Stream USING [Block],
String USING [AppendChar, AppendString],
TimeDefs USING [AppendDayTime, InvalidTime, UnpackDT],
TimeExtraDefs USING [PackedTimeFromString],
VMDefs USING [AccessFailure, CantOpen, defaultTime, Error, FileHandle, FileTime,
GetFileLength, GetFileTimes, Position, Problem, SetCreationTime];

FileOp: PROGRAM
IMPORTS AltoFile, Core, csD, DiskIODefs, dsD, exD, FTPDefs, Inline, intC: intCommon,
LaurelSendDefs, SendDefs, Storage, String, TimeDefs, TimeExtraDefs, VMDefs
EXPORTS opD =

BEGIN


ftpInitialized: BOOLEAN ← FALSE;
expandProtocol: LaurelSendDefs.ProtocolType = LaurelSendDefs.GetSendProtocol[];


-- utility procedures

NameType: TYPE = {remote, dl, local, bad};

ParseName: PROCEDURE [name: STRING] RETURNS [t: NameType, part1, part2: STRING] =
BEGIN
i, upArrowIndex: CARDINAL;
upArrowSeen: BOOLEAN ← FALSE;
part1 ← NIL;
part2 ← NIL;
IF name = NIL OR name.length = 0 THEN GOTO bad;
FOR i IN [0 .. name.length) DO
SELECT name[i] FROM
’↑ => {upArrowSeen ← TRUE; upArrowIndex ← i};
’* => GOTO bad;
ENDCASE;
ENDLOOP;
SELECT TRUE FROM
name[0] = ’[ => --remote--
BEGIN
t ← remote;
[part1, i] ← MakeDelimitedString[’[, ’], 0, name];
IF part1 = NIL THEN GOTO bad;
[part2, ] ← MakeDelimitedString[’], 0C, i, name];
IF part2 = NIL THEN GOTO bad;
END;
upArrowSeen => --dl--
BEGIN
t ← dl;
IF upArrowIndex + 1 < name.length THEN --chars after ↑ must be registry--
BEGIN
[part1, ] ← MakeDelimitedString[’., 0C, upArrowIndex + 1, name];
IF part1 = NIL THEN GOTO bad;
[part2, ] ← MakeDelimitedString[0C, 0C, 0, name];
END
ELSE BEGIN
part1 ← MakeHeapString [intC.user.registry];
[part2, ] ← MakeDelimitedString[0C, 0C, 0, name, part1.length+1];
String.AppendChar[part2, ’.];
String.AppendString[part2, part1];
END;
END;
ENDCASE => --local-- {t ← local; [part1, ] ← MakeDelimitedString[0C, 0C, 0, name]};
EXITS bad => t ← bad;
END; -- of ParseName --


MakeDelimitedString: PROCEDURE [startChar, endChar: CHARACTER,
start: CARDINAL, source: STRING, space: CARDINAL ← 0]
RETURNS [target: STRING, next: CARDINAL] =
-- If source[start] = startChar and endChar appears later in source, allocates a
-- string for target and places in it all the intervening characters from
-- source. Next is index of endChar in source. (startChar = NIL means target
-- unconditionally begins with source[start]; endChar = NIL means target
-- unconditionally ends with last character of source.) IF result would be of
-- length 0 or startChar or endChar are not found then returns target = NIL.
-- When a string is returned it will have space extra character slots at the end.
BEGIN
index, length: CARDINAL;
target ← NIL;
IF source.length <= start THEN RETURN;
IF startChar # 0C THEN {IF source[start] # startChar THEN RETURN; start ← start + 1};
IF endChar # 0C THEN
FOR next IN [start .. source.length) DO
IF source[next] = endChar THEN EXIT;
REPEAT
FINISHED => RETURN;
ENDLOOP
ELSE next ← source.length;
length ← next - start;
IF length = 0 THEN RETURN;
target ← Storage.String[length+space];
FOR index IN [0 .. length) DO
target[index] ← source[index+start];
ENDLOOP;
target.length ← length;
END; -- of MakeDelimitedString --


MakeHeapString: PROCEDURE
[input1: STRING, input2: STRING ← NIL, input3: STRING ← NIL, input4: STRING ← NIL]
RETURNS [output: STRING] =
-- Concatenate string bodies into a heap string
BEGIN
length: CARDINAL;
IF input1 = NIL THEN RETURN[NIL];
length ← input1.length;
IF input2 # NIL THEN length ← length + input2.length;
IF input3 # NIL THEN length ← length + input3.length;
IF input4 # NIL THEN length ← length + input4.length;
output ← Storage.String[length];
String.AppendString[output, input1];
IF input2 # NIL THEN String.AppendString[output, input2];
IF input3 # NIL THEN String.AppendString[output, input3];
IF input4 # NIL THEN String.AppendString[output, input4];
END; -- of MakeHeapString --


MakeLocalFileErrorString: PROCEDURE [error: opD.FileErrorReason] RETURNS [STRING] =
BEGIN
RETURN[MakeHeapString["Local file "L,
SELECT error FROM
illegalName => "name illegal."L,
notFound => "name not found."L,
fileInUse => "already in use."L,
diskFull => "would overfill disk."L,
ENDCASE => "disk error."L]];
END; -- of MakeLocalFileErrorString --


MakeCantConnectMessage: PROCEDURE [h, fs: STRING]
RETURNS [opD.FileErrorReason, STRING] =
{RETURN[cantConnect, MakeHeapString["Can’t connect to """L, h, """: "L, fs]]};


ReportBadName: PROCEDURE RETURNS [opD.FileErrorReason, STRING] =
{RETURN[illegalName, MakeHeapString["Illegal name given."L]]};


MakeFTPError: PROCEDURE [h, m, e: STRING] RETURNS [s: STRING] =
BEGIN
IF e # NIL THEN Storage.FreeString[e];
s ← MakeHeapString["FTP error from """L, h, """: "L, m];
END; -- of MakeFTPError --


InitializeFilePrimitives: PROCEDURE [fp: FTPDefs.FilePrimitives] =
BEGIN
fp.CreateFileSystem ← MyCreateFileSystem;
fp.DestroyFileSystem ← MyDestroyFileSystem;
fp.CloseFile ← MyCloseFile;
END; -- of InitializeFilePrimitives --


SetUpFTP: PROCEDURE =
{IF NOT ftpInitialized THEN {FTPDefs.FTPInitialize[]; ftpInitialized ← TRUE}};


TryNextCredentials: PROCEDURE [f: FTPDefs.FTPUser, try: CARDINAL]
RETURNS [nextTry: CARDINAL] =
--first try is #1, returns 0 when client should give up
BEGIN
pr, heapName: BOOLEAN ← TRUE;
n, p: STRING;
guestString: STRING = "Guest"L;
nextTry ← try + 1;
SELECT try FROM
1 => {n ← MakeHeapString[intC.user.name, "."L, intC.user.registry]; p ← intC.user.password};
2 => {n ← intC.user.name; p ← intC.user.password; heapName ← FALSE};
3 => {n ← p ← guestString; heapName ← FALSE};
4 => {n ← intC.user.name; p ← intC.user.password; pr ← heapName ← FALSE};
ENDCASE => {nextTry ← 0; RETURN};
FTPDefs.FTPSetCredentials[f, IF pr THEN primary ELSE secondary, n, p];
IF heapName THEN Storage.FreeString[n];
END; -- of TryNextCredentials --


-- procedures and declarations of my ftp file system


MyCreateFileSystem: PROCEDURE [bufferSize: CARDINAL]
RETURNS [fileSystem: FTPDefs.FileSystem] = {RETURN[NIL]};


MyDestroyFileSystem: PROCEDURE [fileSystem: FTPDefs.FileSystem] = {};


MyCloseFile: PROCEDURE
[fileSystem: FTPDefs.FileSystem, fileHandle: FTPDefs.FileHandle, aborted: BOOLEAN] = {};


FileError: PUBLIC ERROR [reason: opD.FileErrorReason, errorString: STRING] = CODE;
-- May be raised by Expand or Stuff under various awful circumstances.


AccessFailureToCode: PROCEDURE [reason: VMDefs.AccessFailure]
RETURNS [opD.FileErrorReason] =
BEGIN
RETURN[SELECT reason FROM
notFound => notFound, alreadyExists => fileInUse, illegalFileName => illegalName,
ENDCASE => other];
END; -- of AccessFailureToCode --


VMProblemToCode: PROCEDURE [reason: VMDefs.Problem] RETURNS [opD.FileErrorReason] =
BEGIN
RETURN[IF reason = resources THEN diskFull ELSE other];
END; -- of VMProblemToCode --


Expand: PUBLIC PROCEDURE [sourceName: STRING,
AcceptBlock: PROCEDURE [POINTER, CARDINAL] RETURNS [BOOLEAN],
GetReady: PROCEDURE [LONG CARDINAL, VMDefs.FileTime] ← NIL ] =
-- sourceName is the string name of a local file, remote file, or distribution list. Retrieve
-- will attempt to provide the contents of the named object. If contents are to be
-- forthcoming, Retrieve will call the client’s procedure GetReady if not NIL,
-- passing the number of bytes to expect and the time the object was created
-- (if known, otherwise VMDefs.defaultTime).
-- The client’s GetBlock procedure will then be called over and over with
-- a buffer pointer and byte count. A final call with a zero byte count indicates the end.
-- If AcceptBlock returns FALSE then the transfer is stopped.
-- May raise FileError if any errors (including FALSE returned by AcceptBlock) are
-- encountered by Expand.
BEGIN

RetrieveLocalFile: PROCEDURE [fileName: STRING]
RETURNS [code: opD.FileErrorReason, errorString: STRING] =
-- retrieves from a local file
BEGIN

Cancel: ERROR = CODE;

BlockAcceptor: PROCEDURE [b: Stream.Block] =
BEGIN
IF b.startIndex # 0 AND b.startIndex # b.stopIndexPlusOne THEN exD.SysBug[];
SwingPendulum[];
IF ~AcceptBlock[LOOPHOLE[Inline.LowHalf[b.blockPointer], POINTER],
Inline.LowHalf[b.stopIndexPlusOne - b.startIndex]] THEN ERROR Cancel;
END; -- of BlockAcceptor --

CleanUp: PROCEDURE =
BEGIN
IF sh # NIL THEN {csD.Destroy[sh]; sh ← NIL};
IF fh # NIL THEN {Core.Close[fh]; fh ← NIL};
END; -- of CleanUp --

fh: VMDefs.FileHandle ← NIL;
sh: csD.StreamHandle ← NIL;
length: LONG CARDINAL;
code ← ok;
errorString ← NIL;
BEGIN -- block for EXITS --
fh ← Core.Open[fileName, read
! VMDefs.CantOpen => BEGIN
code ← AccessFailureToCode[reason];
GO TO destroy;
END];
sh ← csD.Open[fh, byte, read];
length ← csD.GetLength[sh];
BEGIN ENABLE
BEGIN
VMDefs.Error =>{code ← VMProblemToCode[reason]; GO TO destroy};
DiskIODefs.DiskError => {code ← other; GO TO destroy};
AltoFile.DiskFull => {code ← diskFull; GO TO destroy};
UNWIND => CleanUp[];
END;
IF GetReady # NIL THEN GetReady[length, VMDefs.GetFileTimes[fh].create];
csD.ReadStream[sh, length, BlockAcceptor ! Cancel => CONTINUE];
END; -- of ENABLE --
EXITS
destroy => errorString ← MakeLocalFileErrorString[code];
END; -- of block for EXITS --
CleanUp[];
END; -- of RetrieveLocalFile --

RetrieveRemoteFile: PROCEDURE [dlExpansion: BOOLEAN, hostName, firstName: STRING]
RETURNS [code: opD.FileErrorReason, errorString: STRING] =
BEGIN

MyOpenFile: PROCEDURE [fileSystem: FTPDefs.FileSystem, file: STRING,
mode: FTPDefs.Mode, fileTypePlease: BOOLEAN, info: FTPDefs.FileInfo]
RETURNS [fileHandle: FTPDefs.FileHandle, fileType: FTPDefs.FileType] =
BEGIN
IF GetReady # NIL THEN
BEGIN
IF info = NIL THEN GetReady[0, VMDefs.defaultTime]
ELSE GetReady[info.byteCount, TimeExtraDefs.PackedTimeFromString[info.creationDate]];
END;
RETURN[NIL, unknown];
END; -- MyOpenFile --

MyWriteFile: PROCEDURE [fileSystem: FTPDefs.FileSystem, fileHandle: FTPDefs.FileHandle,
receiveBlock: PROC [UNSPECIFIED, POINTER, CARDINAL] RETURNS [CARDINAL],
receiveBlockData: UNSPECIFIED] =
BEGIN
bytes: CARDINAL;
bp: POINTER ← Storage.Pages[2];
DO ENABLE UNWIND => Storage.FreePages[bp];
bytes ← receiveBlock[receiveBlockData, bp, 512];
IF ~AcceptBlock[bp, bytes] THEN ERROR FTPDefs.FTPError[noRoomForFile, NIL];
SwingPendulum[];
IF bytes = 0 THEN EXIT;
ENDLOOP;
Storage.FreePages[bp];
END; -- of MyWriteFile --

DestroyFTP: PROCEDURE =
BEGIN
IF ftpUser # NIL THEN {FTPDefs.FTPDestroyUser[ftpUser]; ftpUser ← NIL};
END; -- of DestroyFTP --

-- variables for RetrieveRemoteFile

ftpUser: FTPDefs.FTPUser ← NIL;
myFilePrimitivesObject: FTPDefs.FilePrimitivesObject;
myFilePrimitives: FTPDefs.FilePrimitives = @myFilePrimitivesObject;

-- code for RetrieveRemoteFile

errorString ← NIL;
SetUpFTP[];
InitializeFilePrimitives[myFilePrimitives];
myFilePrimitives.OpenFile ← MyOpenFile;
myFilePrimitives.WriteFile ← MyWriteFile;
ftpUser ← FTPDefs.FTPCreateUser
[myFilePrimitives, FTPDefs.PupCommunicationPrimitives[]];
BEGIN -- block for EXITS --
try: CARDINAL ← 1;

FTPDefs.FTPOpenConnection[ftpUser, hostName, files, NIL
! FTPDefs.FTPError =>
{[code, errorString] ← MakeCantConnectMessage[hostName, message]; GOTO stop}];
DO
IF ~dlExpansion THEN try ← TryNextCredentials[ftpUser, try];
IF try = 0 THEN {code ← ftpError; GOTO stop};
[] ← FTPDefs.FTPRetrieveFile[ftpUser, NIL, firstName, unknown
! FTPDefs.FTPError =>
BEGIN
SELECT ftpError FROM
noSuchFile => BEGIN
code ← notFound;
errorString ← MakeFTPError[hostName, message, errorString];
GO TO stop;
END;
noRoomForFile => {code ← cancel; GOTO freeOldErrorString};
noSuchPrimaryUser, incorrectPrimaryPassword, noSuchSecondaryUser,
incorrectSecondaryPassword, requestedAccessDenied =>
BEGIN
IF try = 2 THEN --save first credentials error message--
errorString ← MakeFTPError[hostName, message, errorString];
LOOP;
END;
ENDCASE;
errorString ← MakeFTPError[hostName, message, errorString];
code ← ftpError;
EXIT
END;
UNWIND => DestroyFTP[]
];
code ← ok;
GOTO freeOldErrorString;
ENDLOOP;
EXITS
freeOldErrorString => IF errorString # NIL THEN
{Storage.FreeString[errorString]; errorString ← NIL};
stop => NULL;
END; -- block for EXITS
DestroyFTP[];
END; -- of RetrieveRemoteFile --

GVExpand: PROCEDURE [dlName: STRING]
RETURNS [code: opD.FileErrorReason, errorString: STRING] =
BEGIN

Work: PROCEDURE[n: STRING] =
BEGIN
IF workCalled THEN PutString[", "L]
ELSE {IF GetReady # NIL THEN GetReady[0, VMDefs.defaultTime]; workCalled ← TRUE};
PutString[n];
END; -- of Work--

PutString: PROCEDURE [s: STRING] =
BEGIN
IF ~AcceptBlock[@s.text, s.length] THEN
{reason ← canceled; ERROR SendDefs.ExpandFailed};
SwingPendulum[];
END; -- of PutString --

workCalled: BOOLEAN ← FALSE;
reason: {canceled, failed, noGroup, noMatch, noRServers} ← failed;
BEGIN --for exits--
SELECT SendDefs.Expand[dlName, Work
! SendDefs.ExpandFailed => IF workCalled THEN GOTO error ELSE RETRY] FROM
ok => {code ← ok; errorString ← NIL};
notFound => {reason ← noMatch; GOTO error};
individual => {reason ← noGroup; GOTO error};
allDown => {reason ← noRServers; GOTO error};
ENDCASE => exD.SysBug[];
PutString[""L ! SendDefs.ExpandFailed => GOTO error];
EXITS
error => BEGIN
errorString ← MakeHeapString["GV error: "L,
SELECT reason FROM
canceled => NIL,
failed => "Communication problem."L,
noMatch, noGroup => "DL name not found."L,
noRServers => "No server for that registry responded."L,
ENDCASE => ERROR];
code ← SELECT reason FROM
canceled => cancel,
failed => ftpError,
noGroup, noMatch => notFound,
noRServers => cantConnect,
ENDCASE => ERROR;
END;
END;
END; -- of GVExpand --

ExpandCleanUp: PROCEDURE =
BEGIN
IF firstPart # NIL THEN {Storage.FreeString[firstPart]; firstPart ← NIL};
IF secondPart # NIL THEN {Storage.FreeString[secondPart]; secondPart ← NIL};
END; -- of ExpandCleanUp --

-- code for Expand --

firstPart, secondPart: STRING ← NIL;
t: NameType;
code: opD.FileErrorReason ← ok;
errorString: STRING ← NIL;
oldShape: dsD.CursorShape;
[t, firstPart, secondPart] ← ParseName[sourceName];
[oldShape, , ] ← dsD.GetCursor[];
BEGIN
ENABLE UNWIND => ExpandCleanUp[];
[code, errorString] ← SELECT t FROM
local => RetrieveLocalFile[firstPart],
remote => RetrieveRemoteFile[FALSE, firstPart, secondPart],
dl => IF expandProtocol = mtp
THEN RetrieveRemoteFile[TRUE, firstPart, secondPart] ELSE GVExpand[secondPart],
ENDCASE => ReportBadName[];
END; -- of ENABLE --
IF firstPart # NIL THEN Storage.FreeString[firstPart];
IF secondPart # NIL THEN Storage.FreeString[secondPart];
dsD.ChangeCursor[oldShape];
IF code # ok THEN ERROR FileError
[code, errorString ! UNWIND => IF errorString # NIL THEN Storage.FreeString[errorString]];
END; -- of Expand --



Stuff: PUBLIC PROCEDURE [targetName: STRING,
GetBlock: PROCEDURE RETURNS [POINTER, CARDINAL, BOOLEAN],
OverwriteOK: PROCEDURE RETURNS [BOOLEAN],
createTime: VMDefs.FileTime ← VMDefs.defaultTime,
callerFileType: FTPDefs.FileType ← binary] =
-- targetName is the string name of a local or remote file. Stuff will
-- attempt to update the contents of the named object with the bytes provided by the
-- client’s GetBlock procedure. The client’s procedure OverwriteOK is first called if the
-- Stuff will overwrite a local file, and Stuff will continue only if TRUE is returned.
-- Created object will be given the provided creation time, where the default means now.
-- Providing a zero length block with GetBlock tells Stuff that the transfer has been
-- successfully completed (ftp requirement?). If GetBlock returns FALSE then the Stuff
-- is stopped.
-- May raise FileError if any errors (including FALSE returned by GetBlock) are
-- encountered by Stuff.
BEGIN

StoreLocalFile: PROCEDURE [fileName: STRING]
RETURNS [code: opD.FileErrorReason, errorString: STRING] =
-- stores to a local file
BEGIN

CleanUp: PROCEDURE =
BEGIN
csD.Close[sh];
Core.Close[fh];
END; -- of CleanUp --

sh: csD.StreamHandle ← NIL;
fh: VMDefs.FileHandle ← NIL;
bp: POINTER;
bc: CARDINAL;
newFile: BOOLEAN ← FALSE;
worked: BOOLEAN;
errorString ← NIL;
code ← ok;
BEGIN ENABLE
BEGIN
VMDefs.Error => {code ← VMProblemToCode[reason]; GOTO delete};
DiskIODefs.DiskError => {code ← other; GOTO delete};
AltoFile.DiskFull => {code ← diskFull; GOTO delete};
UNWIND => CleanUp[];
END;
fh ← Core.Open[fileName, read
! VMDefs.CantOpen => IF reason = notFound THEN {newFile ← TRUE; CONTINUE}
ELSE {code ← AccessFailureToCode[reason]; GOTO delete}];
IF fh # NIL THEN
BEGIN
p: VMDefs.Position ← VMDefs.GetFileLength[fh];
newFile ← p.page = 0 AND p.byte = 0;
Core.Close[fh];
fh ← NIL;
END;
IF newFile OR OverwriteOK[] THEN
BEGIN
fh ← Core.Open[fileName, update
! VMDefs.CantOpen => {code ← AccessFailureToCode[reason]; GOTO delete}];
sh ← csD.Open[fh, byte, overwrite];
DO
[bp, bc, worked] ← GetBlock[];
IF ~worked THEN {csD.Destroy[sh]; code ← cancel; GOTO delete};
csD.WriteBlock[sh, bp, 0, bc];
SwingPendulum[];
IF bc = 0 THEN EXIT;
ENDLOOP;
IF createTime # VMDefs.defaultTime THEN VMDefs.SetCreationTime[fh, createTime];
CleanUp[];
RETURN;
END;
code ← cancel; -- client canceled the file overwrite--
EXITS
delete =>
BEGIN
IF code#cancel THEN errorString ← MakeLocalFileErrorString[code];
IF fh # NIL THEN Core.Delete[fh];
END;
END;
END; -- of StoreLocalFile --

StoreRemoteFile: PROCEDURE [host, fileName: STRING]
RETURNS [code: opD.FileErrorReason, errorString: STRING] =
BEGIN

MyOpenFile: PROCEDURE [fileSystem: FTPDefs.FileSystem, file: STRING,
mode: FTPDefs.Mode, fileTypePlease: BOOLEAN, info: FTPDefs.FileInfo]
RETURNS [fileHandle: FTPDefs.FileHandle, fileType: FTPDefs.FileType] =
BEGIN
IF createTime # VMDefs.defaultTime AND info # NIL AND info.creationDate # NIL
THEN TimeDefs.AppendDayTime[info.creationDate, TimeDefs.UnpackDT[createTime]
! TimeDefs.InvalidTime => CONTINUE];
RETURN[NIL, callerFileType];
END; -- of MyOpenFile --

MyReadFile: PROCEDURE [fileSystem: FTPDefs.FileSystem, fileHandle: FTPDefs.FileHandle,
sendBlock: PROC [UNSPECIFIED, POINTER, CARDINAL], sendBlockData: UNSPECIFIED] =
-- to be called by FTPStoreFile
BEGIN
bp: POINTER;
bc: CARDINAL;
worked: BOOLEAN;
DO
[bp, bc, worked] ← GetBlock[];
IF ~worked THEN {code ← cancel; ERROR FTPDefs.FTPError[fileDataError, NIL]};
sendBlock[sendBlockData, bp, bc];
SwingPendulum[];
IF bc = 0 THEN EXIT;
ENDLOOP;
END; -- of MyReadFile --

DestroyFTP: PROCEDURE =
BEGIN
IF ftpUser # NIL THEN {FTPDefs.FTPDestroyUser[ftpUser]; ftpUser ← NIL};
END; -- of DestroyFTP --

FreeErrorString: PROCEDURE =
BEGIN
IF errorString # NIL THEN {Storage.FreeString[errorString]; errorString ← NIL};
END; -- of FreeErrorString --

-- variables for StoreRemoteFile

ftpUser: FTPDefs.FTPUser ← NIL;
myFilePrimitivesObject: FTPDefs.FilePrimitivesObject;
myFilePrimitives: FTPDefs.FilePrimitives = @myFilePrimitivesObject;

-- code for StoreRemoteFile

errorString ← NIL;
code ← ok;
SetUpFTP[];
InitializeFilePrimitives[myFilePrimitives];
myFilePrimitives.OpenFile ← MyOpenFile;
myFilePrimitives.ReadFile ← MyReadFile;
ftpUser ← FTPDefs.FTPCreateUser
[myFilePrimitives, FTPDefs.PupCommunicationPrimitives[]];
BEGIN -- block for EXITS
try: CARDINAL ← 1;
FTPDefs.FTPOpenConnection[ftpUser, host, files, NIL
! FTPDefs.FTPError =>
{[code, errorString] ← MakeCantConnectMessage[host, message]; GOTO stop}];
DO
try ← TryNextCredentials[ftpUser, try];
IF try = 0 THEN {code ← ftpError; GOTO stop};
[] ← FTPDefs.FTPStoreFile[ftpUser, NIL, fileName, callerFileType
! FTPDefs.FTPError =>
BEGIN
SELECT ftpError FROM
fileDataError => GOTO deleteOldErrorString; -- code already set--
noSuchPrimaryUser, incorrectPrimaryPassword, noSuchSecondaryUser,
incorrectSecondaryPassword, requestedAccessDenied =>
BEGIN
IF try = 2 THEN errorString ← MakeFTPError[host, message, errorString];
LOOP
END;
ENDCASE;
errorString ← MakeFTPError[host, message, errorString];
code ← ftpError;
EXIT
END;
UNWIND => {DestroyFTP[]; FreeErrorString[]}
];
code ← ok;
GOTO deleteOldErrorString;
ENDLOOP;
EXITS
deleteOldErrorString => FreeErrorString[];
stop => NULL;
END; -- block for EXITS --
DestroyFTP[];
END; -- of StoreRemoteFile--

StuffCleanUp: PROCEDURE =
BEGIN
IF firstPart # NIL THEN {Storage.FreeString[firstPart]; firstPart ← NIL};
IF secondPart # NIL THEN {Storage.FreeString[secondPart]; secondPart ← NIL};
END; -- of StuffCleanUp --

-- code for Stuff

code: opD.FileErrorReason ← ok;
firstPart, secondPart, errorString: STRING;
t: NameType;
oldShape: dsD.CursorShape;
[t, firstPart, secondPart] ← ParseName[targetName];
[oldShape, , ] ← dsD.GetCursor[];
BEGIN ENABLE UNWIND => StuffCleanUp[];
[code, errorString] ← SELECT t FROM
local => StoreLocalFile[firstPart],
remote => StoreRemoteFile[firstPart, secondPart],
ENDCASE => ReportBadName[];
END; -- of ENABLE --
StuffCleanUp[];
dsD.ChangeCursor[oldShape];
IF code # ok THEN ERROR FileError
[code, errorString ! UNWIND => IF errorString # NIL THEN Storage.FreeString[errorString]];
END; -- of Stuff --

pendulumState: {left, right} ← right;
swingTime: CARDINAL ← inD.realTimeClock↑;

SwingPendulum: PROCEDURE =
BEGIN
leftPendulum: dsD.CursorBitMap =
[177740B, 147140B, 150540B, 160340B, 162340B, 165340B, 150540B, 147140B,
142140B, 142140B, 144140B, 144140B, 154140B, 154140B, 140140B, 177740B];
rightPendulum: dsD.CursorBitMap =
[177740B, 147140B, 150540B, 160340B, 162340B, 165340B, 150540B, 147140B,
142140B, 142140B, 141140B, 141140B, 141540B, 141540B, 140140B, 177740B];
IF inD.realTimeClock↑ - swingTime < 4 THEN RETURN;
swingTime ← inD.realTimeClock↑;
IF pendulumState = right THEN
BEGIN
pendulumState ← left;
dsD.cursorBM↑ ← leftPendulum;
END
ELSE BEGIN
pendulumState ← right;
dsD.cursorBM↑ ← rightPendulum;
END;
END; -- of SwingPendulum --


END. -- of RetrieveOp --