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

DIRECTORY
  Core USING [Close, Delete, Open],
  csD: FROM "CoreStreamDefs" USING [Close, Destroy, GetLength, Open, ReadStream,
    StreamHandle, WriteBlock],
  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 Core, csD, 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
       errorString _ MakeLocalFileErrorString[code _ AccessFailureToCode[reason]];
       GO TO destroy;
       END];
  sh _ csD.Open[fh, byte, read];
  length _ csD.GetLength[sh];
  BEGIN ENABLE
    BEGIN
    VMDefs.Error =>
      BEGIN
      errorString _ MakeLocalFileErrorString[code _ VMProblemToCode[reason]];
      GO TO destroy;
      END;
    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 => NULL;
  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 => BEGIN
      errorString _ MakeLocalFileErrorString[code _ VMProblemToCode[reason]];
      GOTO delete;
      END;
    UNWIND => CleanUp[];
    END;
  fh _ Core.Open[fileName, read
    ! VMDefs.CantOpen => IF reason = notFound THEN {newFile _ TRUE; CONTINUE}
      ELSE BEGIN
        errorString _ MakeLocalFileErrorString[code _ AccessFailureToCode[reason]];
        GOTO delete;
        END];
  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 => BEGIN
        errorString _ MakeLocalFileErrorString[code _ AccessFailureToCode[reason]];
        GOTO delete;
        END];
    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 => IF fh # NIL THEN Core.Delete[fh];
  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 --
(635)\f1