-- Copyright (C) 1979, 1980, 1984  by Xerox Corporation. All rights reserved. 
-- FTPProtocol.mesa, Edit: HGM 16-Nov-84  4:37:33  
-- FTPProtocol.mesa, Edit: HGM July 31, 1980  11:05 PM  


DIRECTORY
  FTPDefs,
  FTPPrivateDefs,
  String USING [AppendChar, AppendString, EquivalentString, StringBoundsFault],
  MDSStorage USING [Node, String, Free, FreeStringNil];

FTPProtocol: PROGRAM
  IMPORTS FTPDefs, String, Storage: MDSStorage, FTPPrivateDefs
  EXPORTS FTPPrivateDefs
  SHARES FTPDefs =
  BEGIN OPEN FTPDefs, FTPPrivateDefs;

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

  ftpsystem: POINTER TO FTPSystem = LocateFtpSystemObject[];

  -- **********************!  Command/Response Shorthands  !***********************

  PutGetVersion: PUBLIC PROCEDURE [ftper: FTPer, version: Byte] =
    BEGIN
    -- Note:  Obtains local command string from ftper.outputString;
    --   returns remote command string in ftper.inputString.
    -- local variables
    mark, code: Byte;
    -- send IAmVersion command and EOC
    PutCommandAndEOC[ftper, markIAmVersion, version];
    -- receive echoing IAmVersion command and EOC in response
    [mark, code] ¬ GetCommandAndEOC[ftper];
    IF mark # markIAmVersion THEN Abort[illegalProtocolSequence];
    -- verify protocol version number
    IF code # version THEN Abort[protocolVersionMismatch];
    END;

  GetAnswerAndEOC: PUBLIC PROCEDURE [ftper: FTPer] RETURNS [answer: BOOLEAN] =
    BEGIN
    -- local variables
    mark, code: Byte;
    -- receive command and EOC
    [mark, code] ¬ GetCommandAndEOC[ftper];
    -- decode answer
    SELECT mark FROM
      markYes => answer ¬ TRUE;
      markNo => answer ¬ FALSE;
      ENDCASE => Abort[illegalProtocolSequence];
    END;

  GetYesAndEOC: PUBLIC PROCEDURE [ftper: FTPer] =
    BEGIN
    -- receive Yes command
    GetSpecificCommand[ftper, markYes];
    -- receive EOC
    GetEOC[ftper];
    END;

  GetSpecificCommand: PUBLIC PROCEDURE [ftper: FTPer, specificMark: Byte] =
    BEGIN
    -- Note:  If a No command is encountered, flushes the EOC that follows
    --   and uses No's parameters as the basis for an abort.
    -- local variables
    mark, code: Byte;
    -- receive command
    [mark, code] ¬ GetCommand[ftper];
    -- verify that expected command received
    SELECT mark FROM
      specificMark => NULL;
      markNo =>
        BEGIN
        -- receive EOC
        GetEOC[ftper];
        -- abort
        AbortWithExplanation[CodeToSignal[code], ftper.inputString];
        END;
      ENDCASE => Abort[illegalProtocolSequence];
    END;

  PutCommandAndEOC: PUBLIC PROCEDURE [ftper: FTPer, mark, code: Byte] =
    BEGIN
    -- send command
    PutCommand[ftper, mark, code];
    -- send EOC
    PutEOC[ftper];
    END;

  GetCommandAndEOC: PUBLIC PROCEDURE [ftper: FTPer] RETURNS [mark, code: Byte] =
    BEGIN
    -- receive command
    [mark, code] ¬ GetCommand[ftper];
    -- receive EOC
    GetEOC[ftper];
    END;

  PutEOC: PUBLIC PROCEDURE [ftper: FTPer] =
    BEGIN OPEN ftper;
    -- Note:  Forces transmission.
    -- send EOC
    PutCommand[ftper, markEndOfCommand, 0];
    -- force its transmission
    communicationPrimitives.ForceOutput[communicationSystem, connection];
    END;

  GetEOC: PUBLIC PROCEDURE [ftper: FTPer] =
    BEGIN
    -- receive EOC
    GetSpecificCommand[ftper, markEndOfCommand];
    END;

  -- **********************!  Command/Response Primitives  !***********************

  PutCommand: PUBLIC PROCEDURE [ftper: FTPer, mark, code: Byte] =
    BEGIN OPEN ftper;
    -- Note:  Obtains command string, whenever appropriate, from ftper.outputString.
    -- local variables
    codeAppropriate, stringAppropriate: BOOLEAN;
    -- trace change of direction (if any) and mark
    IF tracing THEN TraceOut[ftper, mark];
    -- send and classify mark
    communicationPrimitives.ProduceDiscontinuity[communicationSystem, connection];
    communicationPrimitives.SendByte[communicationSystem, connection, mark];
    [codeAppropriate, stringAppropriate] ¬ ClassifyCommand[mark];
    -- send code if any (which is traced by PutCharacter)
    IF codeAppropriate THEN PutCharacter[ftper, code];
    -- send string if any (which is traced by PutString)
    IF stringAppropriate AND outputString.length # 0 THEN
      BEGIN PutString[ftper, outputString]; outputString.length ¬ 0; END;
    END;

  GetCommand: PUBLIC PROCEDURE [ftper: FTPer] RETURNS [mark, code: Byte] =
    BEGIN OPEN ftper;
    -- Note:  Flushes comments; returns zero if no code;
    --    returns command string, whenever appropriate, in ftper.inputString.
    -- local variables
    settledForNone: BOOLEAN;
    codeAppropriate, stringAppropriate: BOOLEAN;
    -- trace change of direction (if any)
    IF tracing THEN TraceIn[ftper];
    -- initialize code to none
    code ¬ 0;
    -- receive commands until non-comment encountered
    mark ¬ markComment;
    WHILE mark = markComment DO
      -- flush until next mark
      [, settledForNone] ¬ communicationPrimitives.ReceiveByte[
        communicationSystem, connection, TRUE];
      IF ~settledForNone THEN SkipThingsFaster[ftper];
      communicationPrimitives.ConsumeDiscontinuity[
        communicationSystem, connection];
      -- receive and classify mark
      mark ¬ GetCharacter[ftper, FALSE];
      [codeAppropriate, stringAppropriate] ¬ ClassifyCommand[mark];
      -- receive code if any
      IF codeAppropriate THEN code ¬ GetCharacter[ftper, FALSE];
      -- receive string if any
      IF stringAppropriate THEN GetString[ftper, inputString, 0];
      ENDLOOP;
    END;

  -- Used to skip to the end of a file if we abort during a transfer

  SkipThingsFaster: PROCEDURE [ftper: FTPer] =
    BEGIN OPEN ftper;
    trash: ARRAY [0..100) OF WORD;
    bpo: BytePointerObject;
    DO
      bpo ¬ [@trash, FALSE, 2 * 100];
      communicationPrimitives.ReceiveBytes[
        communicationSystem, connection, @bpo, FALSE];
      IF bpo.count # 0 THEN EXIT;
      ENDLOOP;
    END;

  ClassifyCommand: PROCEDURE [mark: Byte]
    RETURNS [codeAppropriate, stringAppropriate: BOOLEAN] =
    BEGIN
    -- initialize classification
    codeAppropriate ¬ stringAppropriate ¬ FALSE;
    -- interpret mark
    SELECT mark FROM
      ~IN [markMinimum..markMaximum] => Abort[functionNotImplemented];
      markYes, markNo, markIAmVersion, markMailboxException =>
        codeAppropriate ¬ stringAppropriate ¬ TRUE;
      markComment, markAbort => stringAppropriate ¬ TRUE;
      ENDCASE;
    END;

  PutPropertyList: PUBLIC PROCEDURE [ftper: FTPer, propertyList: PropertyList] =
    BEGIN
    -- PutProperty procedure
    PutProperty: PROCEDURE [property: Property, value: STRING] =
      BEGIN
      -- local constants
      encodedValue: STRING = [maxStringLength];
      -- local variables
      i: CARDINAL;
      -- send left delimiter
      PutCharacter[ftper, propertyLeftDelimiter];
      -- send property name
      PutString[ftper, ftpsystem.propertyNames[property]];
      -- send separator
      PutCharacter[ftper, propertyNameValueSeparator];
      -- precede reserved characters with escape
      FOR i IN [0..value.length) DO
        SELECT value[i] FROM
          propertyLeftDelimiter, propertyRightDelimiter, propertyEscape =>
            String.AppendChar[encodedValue, propertyEscape];
          ENDCASE;
        String.AppendChar[encodedValue, value[i]];
        ENDLOOP;
      -- send property value
      PutString[ftper, encodedValue];
      -- send right delimiter
      PutCharacter[ftper, propertyRightDelimiter];
      END;
    -- local variables
    property: Property;
    -- send left delimiter
    PutCharacter[ftper, propertyListLeftDelimiter];
    -- send properties
    FOR property IN Property DO
      IF propertyList[property] # NIL THEN
        PutProperty[property, propertyList[property]];
      ENDLOOP;
    -- send right delimiter
    PutCharacter[ftper, propertyListRightDelimiter];
    END;

  GetPropertyList: PUBLIC PROCEDURE [ftper: FTPer, propertyList: PropertyList] =
    BEGIN
    -- Note:  Caller may handle optional property list case
    --   by intercepting protocolParameterListMissing.
    -- GetProperty procedure
    GetProperty: PROCEDURE [value: STRING] RETURNS [property: Property] =
      BEGIN OPEN ftper;
      -- local constants
      name: STRING = [maxStringLength];
      -- local variables
      character: CHARACTER;
      -- left delimiter received by GetPropertyList
      -- receive property name and separator
      GetString[ftper, name, propertyNameValueSeparator];
      -- receive property value and right delimiter
      value.length ¬ 0;
      UNTIL (character ¬ GetCharacter[ftper, FALSE]) = propertyRightDelimiter DO
        IF character = propertyEscape THEN character ¬ GetCharacter[ftper, FALSE];
        String.AppendChar[
          value, character ! String.StringBoundsFault => Abort[stringTooLong]];
        ENDLOOP;
      -- search for name among property names
      FOR property IN Property DO
        IF String.EquivalentString[name, ftpsystem.propertyNames[property]] THEN
          RETURN;
        ENDLOOP;
      -- abort if not found
      Abort[unrecognizedProtocolParameter];
      END;
    -- local constants
    value: STRING = [maxStringLength];
    -- local variables
    property: Property;
    -- initialize property list to empty
    ResetPropertyList[propertyList];
    -- receive left delimiter
    IF GetCharacter[ftper, TRUE] # propertyListLeftDelimiter THEN
      Abort[protocolParameterListMissing];
    -- receive properties until right delimiter encountered
    DO
      SELECT GetCharacter[ftper, FALSE] FROM
        propertyLeftDelimiter =>
	  BEGIN ENABLE FTPError => IF ftpError = unrecognizedProtocolParameter THEN CONTINUE;
          IF propertyList[property ¬ GetProperty[value]] # NIL THEN
            Abort[duplicateProtocolParameter]
          ELSE WriteProperty[propertyList, property, value];
	  END;
        propertyListRightDelimiter => EXIT;
        ENDCASE => Abort[illegalProtocolParameterList];
      ENDLOOP;
    END;

  PutString: PUBLIC PROCEDURE [ftper: FTPer, string: STRING] =
    BEGIN OPEN ftper;
    -- local variables
    bytePointerObject: BytePointerObject ¬ [@string.text, FALSE, string.length];
    -- trace string
    IF tracing THEN TraceString[ftper, string];
    -- send string
    communicationPrimitives.SendBytes[
      communicationSystem, connection, @bytePointerObject];
    END;

  GetString: PUBLIC PROCEDURE [
    ftper: FTPer, string: STRING, terminator: UNSPECIFIED] =
    BEGIN OPEN ftper;
    -- Note:  Declaring terminator UNSPECIFIED admits both CHARACTER and Byte;
    --   null teminator implies mark.
    -- local constants
    rathole: STRING = [maxStringLength];
    -- local variables
    byte: Byte;
    character: CHARACTER;
    bytePointerObject: BytePointerObject;
    -- initialize string
    IF string = NIL THEN string ¬ rathole ELSE string.length ¬ 0;
    -- receive characters until terminating character encountered
    IF terminator # 0 THEN
      BEGIN
      -- receive string and terminator
      DO
        [byte, ] ¬ communicationPrimitives.ReceiveByte[
          communicationSystem, connection, FALSE];
        IF (character ¬ LOOPHOLE[byte]) = terminator THEN EXIT;
        String.AppendChar[
          string, character ! String.StringBoundsFault => Abort[stringTooLong]];
        ENDLOOP;
      -- trace string and terminator
      IF tracing THEN
        BEGIN TraceString[ftper, string]; TraceCharacter[ftper, character]; END;
      END
      -- receive characters until mark encountered

    ELSE
      BEGIN
      -- receive string
      bytePointerObject ¬ [@string.text, FALSE, string.maxlength];
      communicationPrimitives.ReceiveBytes[
        communicationSystem, connection, @bytePointerObject, TRUE];
      string.length ¬ string.maxlength - bytePointerObject.count;
      -- trace string
      IF tracing THEN TraceString[ftper, string];
      -- abort if string too long
      IF string.length = string.maxlength AND GetCharacter[ftper, TRUE] # 0 THEN
        Abort[stringTooLong];
      END;
    END;

  PutCharacter: PROCEDURE [ftper: FTPer, character: UNSPECIFIED] =
    BEGIN OPEN ftper;
    -- Note:  Declaring character UNSPECIFIED admits both CHARACTER and Byte.
    -- trace character
    IF tracing THEN TraceCharacter[ftper, character];
    -- send character
    communicationPrimitives.SendByte[communicationSystem, connection, character];
    END;

  GetCharacter: PROCEDURE [ftper: FTPer, settleForNone: BOOLEAN]
    RETURNS [character: UNSPECIFIED] =
    BEGIN OPEN ftper;
    -- Note:  Declaring character UNSPECIFIED admits both CHARACTER and Byte;
    --   returns null character if mark pending.
    -- local variables
    settledForNone: BOOLEAN;
    -- receive character or discover mark pending
    [character, settledForNone] ¬ communicationPrimitives.ReceiveByte[
      communicationSystem, connection, settleForNone];
    -- trace character or supply null character 
    IF settledForNone THEN character ¬ 0
    ELSE IF tracing THEN TraceCharacter[ftper, character];
    END;


  -- **********************!  Property List Primitives  !***********************

  CreatePropertyList: PUBLIC PROCEDURE RETURNS [propertyList: PropertyList] =
    BEGIN
    -- local variables
    property: Property;
    pointer: POINTER TO PropertyListObject;
    -- allocate property list object
    pointer ¬ Storage.Node[SIZE[PropertyListObject]];
    propertyList ¬ DESCRIPTOR[pointer­];
    -- initialize property list to empty
    FOR property IN Property DO propertyList[property] ¬ NIL; ENDLOOP;
    END;

  DestroyPropertyList: PUBLIC PROCEDURE [propertyList: PropertyList] =
    BEGIN
    -- release property list values
    ResetPropertyList[propertyList];
    -- release property list object
    Storage.Free[BASE[propertyList]];
    END;

  CopyPropertyList: PUBLIC PROCEDURE [
    srcPropertyList, dstPropertyList: PropertyList] =
    BEGIN
    -- local variables
    property: Property;
    -- copy property values
    FOR property IN Property DO
      WriteProperty[dstPropertyList, property, srcPropertyList[property]];
      ENDLOOP;
    END;

  ResetPropertyList: PUBLIC PROCEDURE [propertyList: PropertyList] =
    BEGIN
    -- local variables
    property: Property;
    -- release property values and reset to NIL
    FOR property IN Property DO
      propertyList[property] ¬ Storage.FreeStringNil[propertyList[property]];
      ENDLOOP;
    END;

  WriteProperty: PUBLIC PROCEDURE [
    propertyList: PropertyList, property: Property, value: STRING] =
    BEGIN
    -- set property value to NIL
    IF value = NIL OR value.length = 0 THEN
      -- release current property value
      propertyList[property] ¬ Storage.FreeStringNil[propertyList[property]]
      -- set property value to string

    ELSE
      BEGIN
      -- allocate string to hold new property value
      IF propertyList[property] = NIL THEN
        propertyList[property] ¬ Storage.String[value.length]
        -- use current string if possible

      ELSE
        IF value.length > propertyList[property].maxlength THEN
          BEGIN
          propertyList[property] ¬ Storage.FreeStringNil[propertyList[property]];
          propertyList[property] ¬ Storage.String[value.length];
          END
        ELSE propertyList[property].length ¬ 0;
      -- record new property value
      String.AppendString[propertyList[property], value];
      END;
    END;

  EncodeBooleanProperty: PUBLIC PROCEDURE [boolean: BOOLEAN, property: STRING] =
    BEGIN
    -- Note:  Defaults to FALSE.
    -- encode boolean property
    property.length ¬ 0;
    IF boolean THEN String.AppendString[property, "Yes"L];
    END;

  DecodeBooleanProperty: PUBLIC PROCEDURE [property: STRING]
    RETURNS [boolean: BOOLEAN] =
    BEGIN
    -- Note:  Defaults to FALSE.
    -- decode boolean property
    SELECT TRUE FROM
      (property = NIL), String.EquivalentString[property, "No"L] =>
        boolean ¬ FALSE;
      String.EquivalentString[property, "Yes"L] => boolean ¬ TRUE;
      ENDCASE => Abort[illegalBooleanParameter];
    END;


  END. -- of FTPProtocol