-- file: FTPUserXfer.mesa, Edit: HGM July 31, 1980  5:39 PM  

-- Copyright  Xerox Corporation 1979, 1980

DIRECTORY
  FTPDefs,
  FTPPrivateDefs,
  Storage USING [Pages, FreePages];

FTPUserXfer: PROGRAM
  IMPORTS Storage, FTPDefs, FTPPrivateDefs
  EXPORTS FTPDefs
  SHARES FTPDefs =
BEGIN OPEN FTPDefs, FTPPrivateDefs;


ftpsystem: POINTER TO FTPSystem = LocateFtpSystemObject[];
 

FTPTransferFile: PUBLIC PROCEDURE [srcFtpuser: FTPUser, srcFile: STRING, dstFtpuser: FTPUser, dstFile: STRING, fileType: FileType, transferFile: POINTER TO TransferFile, transferFileData: UNSPECIFIED] RETURNS [byteCount: LONG INTEGER] =
  BEGIN
    creationDate: STRING ← NIL;
    OpenFile: PROCEDURE [fileSystem: FileSystem, file: STRING, mode: Mode,
        fileTypePlease: BOOLEAN, info: FileInfo] RETURNS [fileHandle: FileHandle, fileType: FileType] =
      BEGIN
      SELECT mode FROM
        write => creationDate ← info.creationDate;
        read => info.creationDate ← creationDate;
        ENDCASE;
      END;
    NopCloseFile: PROCEDURE [fileSystem: FileSystem, fileHandle: FileHandle, aborted: BOOLEAN] =
      BEGIN
      END;
  -- write file primitive
    WriteFile: PROCEDURE [fileSystem: FileSystem, fileHandle: FileHandle,
        receiveBlock: PROCEDURE [UNSPECIFIED, POINTER, CARDINAL]
        RETURNS [CARDINAL], receiveBlockData: UNSPECIFIED] =
      BEGIN
      -- read file primitive
        ReadFile: PROCEDURE [fileSystem: FileSystem, fileHandle: FileHandle,
            sendBlock: PROCEDURE [UNSPECIFIED, POINTER, CARDINAL],
            sendBlockData: UNSPECIFIED] =
          BEGIN
          -- local variables
            defaultTransferFile: TransferFile ← DefaultTransferFile;
          -- default file transfer primitive
            IF transferFile = NIL THEN transferFile ← @defaultTransferFile;
          -- transfer file contents
            transferFile↑[transferFileData, receiveBlock, receiveBlockData, sendBlock, sendBlockData];
          END;
      -- local constants
        fileType: FileType = DecodeFileType[srcFtpuser.propertyList];
        dstFilePrimitives: FilePrimitives = dstFtpuser.filePrimitives;
      -- local variables
        dstFilePrimitivesObject: FilePrimitivesObject ← dstFilePrimitives↑;
      -- modify destination file primitives
        dstFilePrimitivesObject.OpenFile ← OpenFile;
        dstFilePrimitivesObject.CloseFile ← NopCloseFile;
        dstFilePrimitivesObject.ReadFile ← ReadFile;
      -- store destination file
        dstFtpuser.filePrimitives ← @dstFilePrimitivesObject;
        [] ← FTPStoreFile[dstFtpuser, ""L, dstFile, fileType !
          UNWIND => dstFtpuser.filePrimitives ← dstFilePrimitives];
        dstFtpuser.filePrimitives ← dstFilePrimitives;
      END;
  -- local constants
    srcFilePrimitives: FilePrimitives = srcFtpuser.filePrimitives;
  -- local variables
    srcFilePrimitivesObject: FilePrimitivesObject ← srcFilePrimitives↑;
  -- modify source file primitives
    srcFilePrimitivesObject.OpenFile ← OpenFile;
    srcFilePrimitivesObject.CloseFile ← NopCloseFile;
    srcFilePrimitivesObject.WriteFile ← WriteFile;
  -- retrieve source file
    srcFtpuser.filePrimitives ← @srcFilePrimitivesObject;
    byteCount ← FTPRetrieveFile[srcFtpuser, ""L, srcFile, fileType !
      UNWIND => srcFtpuser.filePrimitives ← srcFilePrimitives];
    srcFtpuser.filePrimitives ← srcFilePrimitives;
  END;



-- **********************!  Default File Transfer Primitive  !***********************

DefaultTransferFile: TransferFile =
  BEGIN
  -- Note:  Double buffers.
  -- input or output process
    IOProcess: PROCEDURE [input: BOOLEAN] =
      BEGIN
      IF input THEN
        WHILE input DO
          -- notify output process of abort
            ENABLE UNWIND =>
              BEGIN
              abort ← TRUE;
              PostEvent[@outputBufferFull];
              END;
          -- fill input buffer
            inputBuffer.byteCount ←
              receiveBlock[receiveBlockData, inputBuffer.location, bufferSize];
            input ← inputBuffer.byteCount # 0;
          -- await empty output buffer
            AwaitEvent[@outputBufferEmpty];
            IF abort THEN EXIT;
          -- exchange input and output buffers
            buffer ← outputBuffer;
            outputBuffer ← inputBuffer;
            inputBuffer ← buffer; 
          -- post full output buffer
            PostEvent[@outputBufferFull];
          ENDLOOP
      ELSE
        UNTIL outputBuffer.byteCount = 0 DO
          -- notify input process of abort
            ENABLE UNWIND =>
              BEGIN
              abort ← TRUE;
              PostEvent[@outputBufferEmpty];
              END;
          -- notify empty output buffer
            PostEvent[@outputBufferEmpty];
          -- await full output buffer
            AwaitEvent[@outputBufferFull];
            IF abort THEN EXIT;
          -- empty output buffer
            sendBlock[sendBlockData, outputBuffer.location, outputBuffer.byteCount];
          ENDLOOP;
      END;
  -- local constants
    bufferSize: CARDINAL = wordsPerPage*ftpsystem.bufferSize;
  -- local variables
    inputBuffer, buffer, outputBuffer:
      RECORD [location: POINTER, byteCount: CARDINAL] ← [NIL, 1];
    outputBufferEmpty, outputBufferFull: EventObject;
    abort: BOOLEAN ← FALSE;
  -- prepare events
    PrepareEvent[@outputBufferEmpty];
    PrepareEvent[@outputBufferFull];
  -- allocate buffers
    BEGIN ENABLE UNWIND =>
      BEGIN
      IF inputBuffer.location # NIL THEN Storage.FreePages[inputBuffer.location];
      IF outputBuffer.location # NIL THEN Storage.FreePages[outputBuffer.location];
      END;
    inputBuffer.location ← Storage.Pages[ftpsystem.bufferSize];
    outputBuffer.location ← Storage.Pages[ftpsystem.bufferSize];
  -- transfer data
    ForkProcessPair[IOProcess, TRUE, FALSE];
  -- release buffers
    Storage.FreePages[inputBuffer.location];
    Storage.FreePages[outputBuffer.location];
    END; -- enable
  END;

END. -- of FTPUserXfer