-- FTPProtocol.mesa, Edit: HGM July 31, 1980  11:05 PM  

-- Copyright  Xerox Corporation 1979, 1980

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

FTPProtocol: PROGRAM
  -- import list
    IMPORTS String, Storage, FTPPrivateDefs
  -- export list
    EXPORTS FTPPrivateDefs
  -- share list
    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, markYouAreUser, 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 =>
          IF propertyList[property _ GetProperty[value]] # NIL THEN
            Abort[duplicateProtocolParameter]
          ELSE WriteProperty[propertyList, property, value];
        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