-- 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