-- file: FTPUserDump.mesa, last edited by: HGM January 27, 1981  8:05 PM  

-- Copyright  Xerox Corporation 1979, 1980

DIRECTORY
  FTPDefs,
  FTPPrivateDefs,
  Inline USING [DIVMOD],
  Mopcodes USING [zEXCH],
  String USING [AppendChar, AppendString],
  Storage USING [Node, Free],
  Time USING [Append, Packed, Unpack],
  TimeExtra USING [PackedTimeFromString];

FTPUserDump: PROGRAM
  -- import list


  IMPORTS Inline, String, Storage, Time, FTPPrivateDefs, TimeExtra
  -- export list

  EXPORTS FTPDefs, FTPPrivateDefs
  -- share list

  SHARES FTPDefs, FTPPrivateDefs =
  BEGIN OPEN FTPDefs, FTPPrivateDefs;

  BcplLongNumber: TYPE = RECORD [highbits, lowbits: WORD];
  GMTToBcplLongNumber: PROCEDURE [Time.Packed] RETURNS [BcplLongNumber] = MACHINE
    CODE BEGIN Mopcodes.zEXCH END;

  BcplToGMT: PROCEDURE [BcplLongNumber] RETURNS [Time.Packed] = MACHINE CODE
    BEGIN Mopcodes.zEXCH END;


  -- **********************!  Constants  !***********************

  ftpsystem: POINTER TO FTPSystem = LocateFtpSystemObject[];

  -- **********************!  Dump Primitives  !***********************

  FTPInventoryDumpFile: PUBLIC PROCEDURE [
    ftpuser: FTPUser, remoteDumpFile: STRING, intent: DumpFileIntent,
    processFile: PROCEDURE [UNSPECIFIED, STRING, VirtualFilename, FileInfo],
    processFileData: UNSPECIFIED] =
    BEGIN
    -- local constants
    ftper: FTPer = ftpuser.ftper;
    propertyList: PropertyList = ftpuser.propertyList;
    bufferSize: CARDINAL = maximumDumpBlockSize;
    serverFilename: STRING = [maxStringLength];
    file: STRING = [maxStringLength];
    creationDate: STRING = [maxDateLength];
    -- local variables
    buffer: POINTER ← NIL;
    currentBlockType, byte: Byte;
    tempBPO: BytePointerObject;
    blockByteCount: CARDINAL;
    totalByteCount: LONG INTEGER;
    fileInfoObject: FileInfoObject;
    -- verify purpose and state
    VerifyPurposeAndState[ftpuser, files, connected];
    -- send retrieve command
    PutCommand[ftper, markRetrieve, 0];
    -- construct property list containing absolute and virtual filenames and credentials
    ResetPropertyList[propertyList];
    WriteFilename[
      remoteDumpFile, propertyList, NIL, NIL, ftpuser.primaryPropertyList];
    -- send property list and EOC
    PutPropertyList[ftper, propertyList];
    PutEOC[ftper];
    -- receive property list and EOC
    GetSpecificCommand[ftper, markHereIsPropertyList];
    GetPropertyList[ftper, propertyList];
    GetEOC[ftper];
    IF propertyList[serverFilename] # NIL THEN
      String.AppendString[serverFilename, propertyList[serverFilename]];
    -- request the file and await acknowledgment
    PutCommandAndEOC[ftper, markYes, 0];
    GetSpecificCommand[ftper, markHereIsFile];
    -- erase properties of dump file so they don't confuse us during retrieve
    ResetPropertyList[propertyList];
    -- alter state in anticipation of re-entry
    ftpuser.state ← inventoryingDumpFile;
    ftpuser.intent ← intent;
    ftpuser.nextBlockType ← 0;
    BEGIN
    ENABLE
      UNWIND =>
	BEGIN
	IF buffer # NIL THEN Storage.Free[buffer];
	ftpuser.state ← connected;
	END;
    -- allocate buffer for data blocks
    buffer ← Storage.Node[bufferSize];
    -- inventory dump file
    DO
      -- consume block type
      IF ftpuser.nextBlockType # 0 THEN
	BEGIN
	currentBlockType ← ftpuser.nextBlockType;
	ftpuser.nextBlockType ← 0;
	END
	-- receive block type
	-- Note:  Block type doesn't contribute to accumulated file size.

      ELSE
	BEGIN
	totalByteCount ← ftper.totalByteCount;
	currentBlockType ← ReceiveByte[ftper];
	ftper.totalByteCount ← totalByteCount;
	END;
      -- decode block type
      SELECT currentBlockType FROM
	blockName =>
	  BEGIN
	  -- Note:  Name doesn't contribute to accumulated file size.
	  totalByteCount ← ftper.totalByteCount;
	  [] ← ReceiveWord[ftper]; -- file attributes
	  -- receive filename
	  file.length ← creationDate.length ← 0;
	  UNTIL (byte ← ReceiveByte[ftper]) = 0 DO
	    String.AppendChar[file, LOOPHOLE[byte, CHARACTER]]; ENDLOOP;
	  -- peek ahead for date block
	  ftpuser.nextBlockType ← ReceiveByte[ftper];
	  IF ftpuser.nextBlockType = blockDate THEN
	    BEGIN
	    date: RECORD [creation: BcplLongNumber, trash: WORD];
	    temp: Time.Packed;
	    ftpuser.nextBlockType ← 0;
	    tempBPO ← [@date, FALSE, 6];
	    ReceiveBytes[ftper, @tempBPO];
	    temp ← BcplToGMT[date.creation];
	    Time.Append[creationDate, Time.Unpack[temp], TRUE];
	    END;
	  ftper.totalByteCount ← totalByteCount;
	  -- present file to caller for processing
	  WriteProperty[propertyList, serverFilename, file];
	  WriteProperty[propertyList, creationDate, creationDate];
	  ReadFileInfo[propertyList, @fileInfoObject];
	  processFile[processFileData, file, NIL, @fileInfoObject];
	  END;
	blockDate =>
	  BEGIN
	  date: PACKED ARRAY [0..6) OF Byte;
	  -- flush date
	  -- Note:  Date doesn't contribute to accumulated file size.
	  totalByteCount ← ftper.totalByteCount;
	  tempBPO ← [@date, FALSE, 6];
	  ReceiveBytes[ftper, @tempBPO];
	  ftper.totalByteCount ← totalByteCount;
	  END;
	blockData =>
	  BEGIN
	  transmittedChecksum: CARDINAL;
	  checksumStateObject: ChecksumStateObject;
	  -- receive block header
	  -- Note:  Header doesn't contribute to accumulated file size.
	  totalByteCount ← ftper.totalByteCount;
	  blockByteCount ← ReceiveWord[ftper];
	  transmittedChecksum ← ReceiveWord[ftper];
	  ftper.totalByteCount ← totalByteCount;
	  -- verify block length
	  IF blockByteCount > maximumDumpBlockSize THEN
	    Abort[dumpFileBlockTooLong];
	  -- receive block
	  tempBPO ← [buffer, FALSE, blockByteCount];
	  ReceiveBytes[ftper, @tempBPO];
	  -- checksum block length and block
	  checksumStateObject ←
	    [checksum: blockByteCount, anyExcessByte: FALSE, excessByte:];
	  tempBPO ← [buffer, FALSE, blockByteCount];
	  ChecksumBytes[@checksumStateObject, @tempBPO];
	  IF checksumStateObject.checksum # transmittedChecksum THEN
	    Abort[dumpFileCheckSumInError];
	  END;
	blockError => Abort[errorBlockInDumpFile];
	blockEnd => EXIT;
	ENDCASE => Abort[unrecognizedDumpFileBlock];
      ENDLOOP;
    -- receive Yes and EOC
    WriteProperty[propertyList, serverFilename, serverFilename];
    GetSpecificCommand[ftper, markYes];
    FinishMultiFileOperation[ftpuser];
    -- release buffer and restore state

    END; -- enable
    Storage.Free[buffer];
    ftpuser.state ← connected;
    END;

  FTPBeginDumpFile: PUBLIC PROCEDURE [ftpuser: FTPUser, remoteDumpFile: STRING] =
    BEGIN OPEN ftpuser;
    -- local variables
    fileInfoObject: FileInfoObject ←
      [fileType: binary, byteSize: 8, byteCount: 0, creationDate: NIL,
	writeDate: NIL, readDate: NIL, author: NIL];
    -- verify purpose and state
    VerifyPurposeAndState[ftpuser, files, connected];
    -- send store command
    PutCommand[ftper, markNewStore, 0];
    -- construct property list containing absolute and virtual filenames, credentials, and file information
    ResetPropertyList[propertyList];
    WriteFilename[remoteDumpFile, propertyList, NIL, NIL, primaryPropertyList];
    WriteFileInfo[propertyList, @fileInfoObject];
    -- send property list and EOC
    PutPropertyList[ftper, propertyList];
    PutEOC[ftper];
    -- sustain remote store
    GetSpecificCommand[ftper, markHereIsPropertyList];
    GetPropertyList[ftper, propertyList];
    GetEOC[ftper];
    -- signal transmission of file
    PutCommand[ftper, markHereIsFile, 0];
    -- note dump in progress
    state ← dumpFileBeingSent;
    END;

  FTPEndDumpFile: PUBLIC PROCEDURE [ftpuser: FTPUser] =
    BEGIN OPEN ftpuser;
    -- verify purpose and state
    VerifyPurposeAndState[ftpuser, files, dumpFileBeingSent];
    -- send end block
    SendByte[ftper, blockEnd];
    -- send Yes and EOC
    PutCommandAndEOC[ftper, markYes, 0];
    -- receive acknowledgment
    GetYesAndEOC[ftper];
    -- reset state
    state ← connected;
    END;

  -- **********************!  Dump Send/Receive Primitives  !***********************

  SendHeaderBlock: PUBLIC PROCEDURE [
    dumpState: DumpState, fileName, creation: STRING] =
    BEGIN
    ftper: FTPer ← dumpState.ftper;
    totalByteCount: LONG CARDINAL;
    bytePointerObject: BytePointerObject;
    totalByteCount ← ftper.totalByteCount;
    SendByte[ftper, blockName];
    SendWord[ftper, 0]; -- File attributes
    bytePointerObject ← [@fileName.text, FALSE, fileName.length];
    SendBytes[ftper, @bytePointerObject];
    SendByte[ftper, 0];
    IF creation.length # 0 THEN
      BEGIN
      date: RECORD [creation: BcplLongNumber, trash: WORD];
      date.creation ← GMTToBcplLongNumber[
	TimeExtra.PackedTimeFromString[creation]];
      date.trash ← 0;
      SendByte[ftper, blockDate];
      bytePointerObject ← [@date, FALSE, 6];
      SendBytes[ftper, @bytePointerObject];
      END;
    ftper.totalByteCount ← totalByteCount;
    END;

  DumpBlock: PUBLIC PROCEDURE [
    dumpState: DumpState, source: POINTER, byteCount: CARDINAL] =
    BEGIN OPEN dumpState;
    -- Note:  byteCount=0 signifies end of file; block lengths are in the range
    --   [minimumDumpBlockSize..maximumDumpBlockSize] for Nova compatibility.
    -- local variables
    bufferBPO: BytePointerObject ← [bufferAddress, FALSE, bufferLength];
    callerBPO: BytePointerObject ← [source, FALSE, byteCount];
    tempBPO: BytePointerObject;
    availableByteCount, blockByteCount, bufferByteCount, callerByteCount:
      CARDINAL;
    checksumStateObject: ChecksumStateObject;
    totalByteCount: LONG INTEGER;
    -- send as many blocks as possible
    DO
      -- select block length
      -- Note:  The following logic assures that neither this nor subsequent blocks
      --   will violate the length constraints.
      availableByteCount ← bufferBPO.count + callerBPO.count;
      blockByteCount ←
	SELECT TRUE FROM
	  (availableByteCount >= maximumDumpBlockSize + minimumDumpBlockSize) =>
	    maximumDumpBlockSize,
	  (byteCount = 0 AND availableByteCount <= maximumDumpBlockSize) =>
	    availableByteCount,
	  (byteCount = 0) => availableByteCount - minimumDumpBlockSize,
	  ENDCASE => 0;
      IF blockByteCount = 0 THEN EXIT;
      bufferByteCount ← MIN[blockByteCount, bufferBPO.count];
      callerByteCount ← blockByteCount - bufferByteCount;
      -- checksum block length and block
      checksumStateObject ←
	[checksum: blockByteCount, anyExcessByte: FALSE, excessByte:];
      tempBPO ← [bufferBPO.address, bufferBPO.offset, bufferByteCount];
      ChecksumBytes[@checksumStateObject, @tempBPO];
      tempBPO ← [callerBPO.address, callerBPO.offset, callerByteCount];
      ChecksumBytes[@checksumStateObject, @tempBPO];
      -- send block header
      -- Note:  Header doesn't contribute to accumulated file size.
      totalByteCount ← ftper.totalByteCount;
      SendByte[ftper, blockData];
      SendWord[ftper, blockByteCount];
      SendWord[ftper, checksumStateObject.checksum];
      ftper.totalByteCount ← totalByteCount;
      -- send block
      tempBPO ← [bufferBPO.address, bufferBPO.offset, bufferByteCount];
      SendBytes[ftper, @tempBPO];
      tempBPO ← [callerBPO.address, callerBPO.offset, callerByteCount];
      SendBytes[ftper, @tempBPO];
      -- consume sent data
      AdvanceBytePointer[@bufferBPO, bufferByteCount];
      AdvanceBytePointer[@callerBPO, callerByteCount];
      ENDLOOP;
    -- left-adjust buffer contents
    tempBPO ← [bufferAddress, FALSE, bufferLength ← bufferBPO.count];
    IF bufferBPO # tempBPO THEN TransferBytes[@bufferBPO, @tempBPO];
    -- buffer remaining caller data
    bufferLength ← bufferLength + (tempBPO.count ← callerBPO.count);
    TransferBytes[@callerBPO, @tempBPO];
    END;

  LoadBlock: PUBLIC PROCEDURE [
    dumpState: DumpState, destination: POINTER, maxWordCount: CARDINAL]
    RETURNS [actualByteCount: CARDINAL] =
    BEGIN OPEN dumpState;
    -- Note:  actualByteCount=0 signifies end of file.
    -- local variables
    bufferBPO: BytePointerObject ← [bufferAddress, FALSE, bufferLength];
    callerBPO: BytePointerObject ←
      [destination, FALSE, bytesPerWord*maxWordCount];
    tempBPO: BytePointerObject;
    blockByteCount, bufferByteCount, callerByteCount, transmittedChecksum:
      CARDINAL;
    checksumStateObject: ChecksumStateObject;
    totalByteCount: LONG INTEGER;
    date: PACKED ARRAY [0..6) OF Byte;
    -- return on end-of-file
    IF blockType = blockName OR blockType = blockEnd THEN RETURN[0];
    -- deliver buffered data to caller
    TransferBytes[@bufferBPO, @callerBPO];
    -- left-adjust buffer's remaining contents
    tempBPO ← [bufferAddress, FALSE, bufferLength ← bufferBPO.count];
    TransferBytes[@bufferBPO, @tempBPO];
    bufferBPO ← tempBPO;
    -- deliver received data to caller
    UNTIL callerBPO.count = 0 DO
      -- receive block type
      -- Note:  Block type doesn't contribute to accumulated file size.
      totalByteCount ← ftper.totalByteCount;
      blockType ← ReceiveByte[ftper];
      ftper.totalByteCount ← totalByteCount;
      -- decode block type
      SELECT blockType FROM
	blockName => EXIT;
	blockDate =>
	  BEGIN
	  -- flush date
	  -- Note:  Date doesn't contribute to accumulated file size.
	  totalByteCount ← ftper.totalByteCount;
	  tempBPO ← [@date, FALSE, 6];
	  ReceiveBytes[ftper, @tempBPO];
	  ftper.totalByteCount ← totalByteCount;
	  END;
	blockData =>
	  BEGIN
	  -- receive block header
	  -- Note:  Header doesn't contribute to accumulated file size.
	  totalByteCount ← ftper.totalByteCount;
	  blockByteCount ← ReceiveWord[ftper];
	  transmittedChecksum ← ReceiveWord[ftper];
	  ftper.totalByteCount ← totalByteCount;
	  -- select block length
	  IF blockByteCount > maximumDumpBlockSize THEN
	    Abort[dumpFileBlockTooLong];
	  callerByteCount ← MIN[blockByteCount, callerBPO.count];
	  bufferByteCount ← blockByteCount - callerByteCount;
	  bufferLength ← bufferLength + bufferByteCount;
	  -- receive block
	  tempBPO ← [callerBPO.address, callerBPO.offset, callerByteCount];
	  ReceiveBytes[ftper, @tempBPO];
	  tempBPO ← [bufferBPO.address, bufferBPO.offset, bufferByteCount];
	  ReceiveBytes[ftper, @tempBPO];
	  -- checksum block length and block
	  checksumStateObject ←
	    [checksum: blockByteCount, anyExcessByte: FALSE, excessByte:];
	  tempBPO ← [callerBPO.address, callerBPO.offset, callerByteCount];
	  ChecksumBytes[@checksumStateObject, @tempBPO];
	  tempBPO ← [bufferBPO.address, bufferBPO.offset, bufferByteCount];
	  ChecksumBytes[@checksumStateObject, @tempBPO];
	  IF checksumStateObject.checksum # transmittedChecksum THEN
	    Abort[dumpFileCheckSumInError];
	  -- produce received data
	  AdvanceBytePointer[@callerBPO, callerByteCount];
	  AdvanceBytePointer[@bufferBPO, bufferByteCount];
	  END;
	blockError => Abort[errorBlockInDumpFile];
	blockEnd => EXIT;
	ENDCASE => Abort[unrecognizedDumpFileBlock];
      ENDLOOP;
    -- compute actual byte count for caller
    actualByteCount ← bytesPerWord*maxWordCount - callerBPO.count;
    END;

  -- **********************!  Checksum Primitive  !***********************

  ChecksumBytes: PROCEDURE [
    checksumState: ChecksumState, srcBytePointer: BytePointer] =
    BEGIN OPEN checksumState;
    -- NextByte procedure
    NextByte: PROCEDURE RETURNS [byte: Byte] =
      BEGIN
      -- consume excess byte
      IF anyExcessByte THEN BEGIN anyExcessByte ← FALSE; byte ← excessByte; END
	-- consume source byte

      ELSE byte ← LoadByte[sBP];
      -- decrement byte count
      sBP.count ← sBP.count - 1;
      END;
    -- local constants
    sBP: BytePointer = srcBytePointer;
    -- local variables
    wordCount: CARDINAL;
    dWordObject: WordObject;
    -- include excess byte in count
    IF anyExcessByte THEN sBP.count ← sBP.count + 1;
    -- checksum all but new excess byte
    UNTIL sBP.count < bytesPerWord DO
      IF ~anyExcessByte AND ~sBP.offset THEN
	BEGIN
	[wordCount, sBP.count] ← Inline.DIVMOD[sBP.count, bytesPerWord];
	THROUGH [0..wordCount) DO
	  checksum ← checksum + sBP.address↑;
	  sBP.address ← sBP.address + 1;
	  ENDLOOP;
	END
      ELSE
	BEGIN
	dWordObject.lhByte ← NextByte[];
	dWordObject.rhByte ← NextByte[];
	checksum ← checksum + LOOPHOLE[dWordObject, CARDINAL];
	END;
      ENDLOOP;
    -- update excess byte
    IF anyExcessByte ← (sBP.count > 0) THEN excessByte ← NextByte[];
    END;

  LoadByte: PUBLIC PROCEDURE [srcBytePointer: BytePointer] RETURNS [byte: Byte] =
    INLINE
    BEGIN
    -- Note:  Doesn't check for byte pointer exhaustion.
    -- local constants
    sBP: BytePointer = srcBytePointer;
    sWord: Word = sBP.address;
    -- load byte
    byte ← IF sBP.offset THEN sWord.rhByte ELSE sWord.lhByte;
    -- advance address and offset
    IF ~(sBP.offset ← ~sBP.offset) THEN sBP.address ← sBP.address + 1;
    -- decrement byte count
    sBP.count ← sBP.count - 1;
    END;

  -- **********************!  Main Program  !***********************

  -- no operation

  END. -- of FTPUserDump