-- 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],
  MDSStorage USING [Node, Free],
  Time USING [Append, Packed, Unpack],
  TimeExtra USING [PackedTimeFromString];

FTPUserDump: PROGRAM
  IMPORTS Inline, String, Storage: MDSStorage, Time, FTPPrivateDefs, TimeExtra
  EXPORTS FTPDefs, FTPPrivateDefs
  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