-- Copyright (C) 1979, 1980, 1984  by Xerox Corporation. All rights reserved. 
-- FTPUserCommon.mesa
 
-- MAS May 19, 1980  6:11 PM  
-- HGM 15-Sep-85 15:42:49  
-- JEW October 31, 1978  11:57 AM  


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

FTPUserCommon: PROGRAM
  IMPORTS String, MDSStorage, FTPPrivateDefs
  EXPORTS FTPDefs
  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 ¬ MDSStorage.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
    MDSStorage.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 = LONG 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 = LONG 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