-- file: FTPUserDump.mesa, last edited by: HGM August 3, 1980  1:59 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, Unpack],
  TimeExtraDefs USING [PackedTimeFromString];

FTPUserDump: PROGRAM
  -- import list
    IMPORTS Inline, String, Storage, Time, FTPPrivateDefs, TimeExtraDefs
  -- export list
    EXPORTS FTPDefs, FTPPrivateDefs
  -- share list
    SHARES FTPDefs, FTPPrivateDefs
  = BEGIN OPEN FTPDefs, FTPPrivateDefs;

-- **********************!  Copied from InlineDefs to keep Forest happy

BcplLongNumber: TYPE = MACHINE DEPENDENT RECORD [highbits, lowbits: CARDINAL];
MesaToBcplLongNumber: PROCEDURE [LONG UNSPECIFIED] RETURNS [BcplLongNumber] =
    MACHINE CODE BEGIN Mopcodes.zEXCH END;
BcplToMesaLongNumber: PROCEDURE [BcplLongNumber] RETURNS [LONG UNSPECIFIED] =
    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: LONG CARDINAL;
                ftpuser.nextBlockType _ 0;
                tempBPO _ [@date, FALSE, 6];
                ReceiveBytes[ftper, @tempBPO];
                temp _ BcplToMesaLongNumber[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 _
      MesaToBcplLongNumber[TimeExtraDefs.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