-- file: FTPUserCommon.mesa - last edit: 
  -- MAS May 19, 1980  6:11 PM  
  -- HGM July 28, 1980  9:16 PM  
  -- JEW October 31, 1978  11:57 AM  

-- Copyright  Xerox Corporation 1979, 1980

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

FTPUserCommon: PROGRAM
  -- import list
    IMPORTS String, Storage, FTPPrivateDefs
  -- export list
    EXPORTS FTPDefs
  -- share list
    SHARES FTPDefs
  = BEGIN OPEN FTPDefs, FTPPrivateDefs;

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

ftpsystem: POINTER TO FTPSystem = LocateFtpSystemObject[];
 
-- **********************!  Program Primitives  !***********************

FTPCreateUser: PUBLIC PROCEDURE [filePrimitives: FilePrimitives, communicationPrimitives: CommunicationPrimitives] RETURNS [ftpuser: FTPUser] =
  BEGIN
    empty: PropertyList _ DESCRIPTOR[NIL,6];
  -- verify presence of communication primitives
    IF communicationPrimitives = NIL THEN Abort[communicationPrimitivesNotSpecified];
  -- allocate and initialize ftpuser object
    ftpuser _ Storage.Node[SIZE[FTPUserObject]];
    ftpuser^ _ FTPUserObject[
      filePrimitives: filePrimitives,
      fileSystem: ,
      communicationPrimitives: communicationPrimitives,
      communicationSystem: NIL,
      remoteFtpSocket: ftpSocket, remoteMtpSocket: mtpSocket,
      ftper: NIL, mtper: NIL,
      propertyList: empty, primaryPropertyList: empty, secondaryPropertyList: empty,
      purpose: filesAndMail,
      state: unconnected,
      intent: ,
      nextBlockType: ,
      numberOfRecipients: , numberOfValidRecipients: ,
      numberOfBytesExpected: , numberOfBytesReceived: ];
  -- create communication system
    BEGIN ENABLE UNWIND => FTPDestroyUser[ftpuser];
    ftpuser.communicationSystem _
      communicationPrimitives.CreateCommunicationSystem[];
  -- allocate and initialize ftper objects
    ftpuser.ftper _ CreateFTPer[communicationPrimitives, ftpuser.communicationSystem];
    ftpuser.mtper _ CreateFTPer[communicationPrimitives, ftpuser.communicationSystem];
  -- allocate and initialize property list objects
    ftpuser.propertyList _ CreatePropertyList[];
    ftpuser.primaryPropertyList _ CreatePropertyList[];
    ftpuser.secondaryPropertyList _ CreatePropertyList[];
    END; -- enable
  END;

FTPDestroyUser: PUBLIC PROCEDURE [ftpuser: FTPUser] =
  BEGIN OPEN ftpuser;
  -- close network connection if any
    FTPCloseConnection[ftpuser];
  -- release property list objects if any
    IF BASE[propertyList] # NIL THEN DestroyPropertyList[propertyList];
    IF BASE[primaryPropertyList] # NIL THEN DestroyPropertyList[primaryPropertyList];
    IF BASE[secondaryPropertyList] # NIL THEN
      DestroyPropertyList[secondaryPropertyList];
  -- release ftper objects if any
    IF ftper # NIL THEN DestroyFTPer[ftper];
    IF mtper # NIL THEN DestroyFTPer[mtper];
  -- destroy communication system
    IF communicationSystem # NIL THEN
      communicationPrimitives.DestroyCommunicationSystem[communicationSystem];
  -- release ftpuser object
    Storage.Free[ftpuser];
  END;

-- **********************!  Connection Primitives  !***********************

FTPSetContactSocket: PUBLIC PROCEDURE [ftpuser: FTPUser, socket: LONG INTEGER, purpose: Purpose] =
  BEGIN
  -- record remote ftp server's contact socket
    IF purpose # mail THEN
      ftpuser.remoteFtpSocket _ IF socket # 0 THEN socket ELSE ftpSocket;
  -- record remote mtp server's contact socket
    IF purpose # files THEN
      ftpuser.remoteMtpSocket _ IF socket # 0 THEN socket ELSE mtpSocket;
  END;

FTPOpenConnection: PUBLIC PROCEDURE [ftpuser: FTPUser, host: STRING, purpose: Purpose, remoteInsignia: STRING] =
  BEGIN OPEN ftpuser.communicationPrimitives;
  -- forked procedures
    OpenConnectionProcess: PROCEDURE [open: Open] =
      BEGIN OPEN open;
      -- open connection
        xtper.connection _ OpenConnection[
          xtper.communicationSystem, host, socket, responseFromServerSeconds];
      -- exchange version numbers
        PutGetVersion[xtper, version ! UNWIND => CloseConnectionProcess[xtper]]; 
      END;
    CloseConnectionProcess: PROCEDURE [xtper: FTPer] =
      BEGIN
      -- nop unless connection open
        IF xtper.connection = NIL THEN RETURN;
      -- close connection
        CloseConnection[xtper.communicationSystem, xtper.connection]; 
        xtper.connection _ NIL;
      END;
  -- local types
    Open: TYPE = POINTER TO OpenObject;
    OpenObject: TYPE = RECORD [
      xtper: FTPer,
      socket: LONG INTEGER,
      version: Byte];
  -- local constants
    ftper: FTPer = ftpuser.ftper;
    mtper: FTPer = ftpuser.mtper;
  -- local variables
    openObject1: OpenObject _ [
      xtper: ftper,
      socket: ftpuser.remoteFtpSocket,
      version: ftpVersion];
    openObject2: OpenObject _ [
      xtper: mtper,
      socket: ftpuser.remoteMtpSocket,
      version: mtpVersion];
  -- verify state
    IF ftpuser.state # unconnected THEN Abort[connectionAlreadyEstablished];
  -- verify presence of required modules and primitives
    IF purpose # mail THEN
      BEGIN
      IF ~ftpsystem.userFilesLoaded THEN Abort[filesModuleNotLoaded];
      IF ftpuser.filePrimitives = NIL THEN Abort[filePrimitivesNotSpecified];
      END;
    IF purpose # files AND ~ftpsystem.userMailLoaded THEN Abort[mailModuleNotLoaded];
  -- open connection(s) to remote server(s)
    BEGIN ENABLE UNWIND => ForkProcessPair[CloseConnectionProcess, ftper, mtper];
    IF purpose = filesAndMail THEN
      ForkProcessPair[OpenConnectionProcess, @openObject1, @openObject2]
    ELSE OpenConnectionProcess[
      IF purpose = files THEN @openObject1 ELSE @openObject2];
  -- construct remote insignia
    IF remoteInsignia # NIL THEN
      BEGIN
      remoteInsignia.length _ 0;
      IF purpose # mail THEN String.AppendString[remoteInsignia, ftper.inputString];
      IF purpose # files
      AND ~String.EquivalentString[remoteInsignia, mtper.inputString] THEN
        BEGIN
        IF remoteInsignia.length # 0 THEN
          String.AppendChar[remoteInsignia, insigniaSeparator];
        String.AppendString[remoteInsignia, mtper.inputString];
        END;
      END;
  -- create file system
    IF purpose # mail THEN
      ftpuser.fileSystem _ ftpuser.filePrimitives.CreateFileSystem[ftpsystem.bufferSize];
    END; -- enable
  -- record purpose of connection and note connection open
    ftpuser.purpose _ purpose;
    ftpuser.state _ connected; 
  END;

FTPRenewConnection: PUBLIC PROCEDURE [ftpuser: FTPUser] =
  BEGIN OPEN ftpuser;
  -- forked procedure
    RenewConnectionProcess: PROCEDURE [renew: Renew] =
      BEGIN OPEN renew;
      -- renew connection to remote server
        PutGetVersion[xtper, version]; 
      END;
  -- local types
    Renew: TYPE = POINTER TO RenewObject;
    RenewObject: TYPE = RECORD [xtper: FTPer, version: Byte];
  -- local variables
    renewObject1: RenewObject _ [xtper: ftper, version: ftpVersion];
    renewObject2: RenewObject _ [xtper: mtper, version: mtpVersion];
  -- verify purpose and state
    VerifyPurposeAndState[ftpuser, filesAndMail, connected];
  -- renew connection(s) to remote server(s)
    IF purpose = filesAndMail THEN
      ForkProcessPair[RenewConnectionProcess, @renewObject1, @renewObject2]
    ELSE RenewConnectionProcess[
      IF purpose = files THEN @renewObject1 ELSE @renewObject2];
  END;

FTPCloseConnection: PUBLIC PROCEDURE [ftpuser: FTPUser] =
  BEGIN OPEN ftpuser, ftpuser.communicationPrimitives;
  -- forked procedure
    CloseConnectionProcess: PROCEDURE [xtper: FTPer] =
      BEGIN
      -- close connection
        CloseConnection[xtper.communicationSystem, xtper.connection]; 
        xtper.connection _ NIL;
      END;
  -- verify purpose and state
    IF state = unconnected THEN RETURN;
  -- destroy file system
    IF purpose # mail THEN filePrimitives.DestroyFileSystem[fileSystem];
  -- close connection(s) to remote server(s)
    IF purpose = filesAndMail THEN
      ForkProcessPair[CloseConnectionProcess, ftper, mtper]
    ELSE CloseConnectionProcess[IF purpose = files THEN ftper ELSE mtper];
  -- note connection closed
    purpose _ filesAndMail;
    state _ unconnected;
  END;

-- **********************!  Access Primitive  !***********************

FTPSetCredentials: PUBLIC PROCEDURE [ftpuser: FTPUser, status: Status, user, password: STRING] =
  BEGIN OPEN ftpuser;
  -- record user and password in primary property list
    WriteProperty[primaryPropertyList,
      IF status=primary THEN userName ELSE connectName, user];
    WriteProperty[primaryPropertyList,
      IF status=primary THEN userPassword ELSE connectPassword, password];
  END;


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

-- no operation    

END. -- of FTPUserCommon