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