-- FTPPupComCool.mesa, Edit: HGM July 31, 1980  5:49 PM  

-- Copyright  Xerox Corporation 1979, 1980

DIRECTORY
  FTPDefs,
  FTPPrivateDefs,
  FTPPupComDefs,
  PupDefs USING [NameLookupErrorCode],
  PupStream USING [
    AppendPupAddress, CloseReason,
    CreatePupByteStreamListener, DestroyPupListener, RejectThisRequest,
    GetPupAddress, PupAddress, PupByteStreamCreate, PupListener, PupNameTrouble,
    PupPackageDestroy, PupPackageMake, PupSocketID, SecondsToTocks, StreamClosing, veryLongWait],
  PupTypes USING [fillInHostID, fillInNetID],
  Stream USING [Handle, TimeOut],
  Storage USING [Node, Free];

FTPPupComCool: PROGRAM
  IMPORTS PupStream, Stream, Storage, FTPDefs, FTPPrivateDefs, FTPPupComDefs
  EXPORTS FTPDefs, FTPPupComDefs
  SHARES FTPDefs =
BEGIN OPEN FTPDefs, FTPPrivateDefs;
 

PupConnection: TYPE = FTPPupComDefs.PupConnection;
PupConnectionObject: TYPE = FTPPupComDefs.PupConnectionObject;

-- pup port state information
PupPort: TYPE = POINTER TO PupPortObject;
PupPortObject: TYPE = RECORD [
  deactivated: EventObject,
  pH: PROCESS];

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

ftpsystem: POINTER TO FTPSystem = LocateFtpSystemObject[];

communicationPrimitivesObject: CommunicationPrimitivesObject _ [
  CreateCommunicationSystem: CreateCommunicationSystem,
  DestroyCommunicationSystem: DestroyCommunicationSystem,
  OpenConnection: OpenConnection,
  CloseConnection: CloseConnection,
  ActivatePort: ActivatePort,
  DeactivatePort: DeactivatePort,
  SendBytes: FTPPupComDefs.SendBytes,
  ReceiveBytes: FTPPupComDefs.ReceiveBytes,
  SendByte: FTPPupComDefs.SendByte,
  ReceiveByte: FTPPupComDefs.ReceiveByte,
  ProduceDiscontinuity: FTPPupComDefs.ProduceDiscontinuity,
  ConsumeDiscontinuity: FTPPupComDefs.ConsumeDiscontinuity,
  ForceOutput: FTPPupComDefs.ForceOutput];

-- **********************!  Communication Foothold Procedure  !***********************

-- Note:  These primitives use the Pup Package in such a way as to
--   maintain compatibility with Maxc, IFS, and Juniper file systems.

PupCommunicationPrimitives,
SomeCommunicationPrimitives: PUBLIC PROCEDURE RETURNS [communicationPrimitives: CommunicationPrimitives] =
  BEGIN
  -- return communication primitives
    communicationPrimitives _ @communicationPrimitivesObject;
  END;

-- **********************!  Communication Primitives  !***********************

CreateCommunicationSystem: PROCEDURE RETURNS [communicationSystem: CommunicationSystem] =
  BEGIN
    PupStream.PupPackageMake[];
  END;

DestroyCommunicationSystem: PROCEDURE [communicationSystem: CommunicationSystem] =
  BEGIN
  -- destroy pup package
    PupStream.PupPackageDestroy[];
  END;

OpenConnection: PROCEDURE [communicationSystem: CommunicationSystem, remoteHost: STRING, remoteSocket: LONG INTEGER, receiveSeconds: CARDINAL] RETURNS [connection: Connection] =
  BEGIN
  -- local constants
  -- Note:  The transformation below assumes intimate knowledge
  --   of Mesa's LONG INTEGER implementation.
    longInteger: ARRAY {lob, hob} OF CARDINAL = LOOPHOLE[remoteSocket];
    pupRemoteSocket: PupStream.PupSocketID = [longInteger[hob], longInteger[lob]];
  -- local variables
    pupConnection: PupConnection;
    pupAddress: PupStream.PupAddress _
      [net: PupTypes.fillInNetID, host: PupTypes.fillInHostID, socket: pupRemoteSocket];
  -- allocate and initialize pup connection object
    pupConnection _ Storage.Node[SIZE[PupConnectionObject]];
    pupConnection^ _ PupConnectionObject[
      streamHandle: ,
      thirdPartyClose: FALSE, inputDiscontinuity: FALSE, outputDiscontinuity: FALSE,
      inputDiscontinuityConsumed: FALSE, terminateOnEndPhysicalRecord: FALSE,
      mark: ];
  -- locate remote server
    BEGIN ENABLE
      BEGIN
      PupStream.PupNameTrouble => AbortBecauseNameLookupFailed[code, e];
      PupStream.StreamClosing    => AbortBecauseStreamClosing[why, text];
      Stream.TimeOut               => Abort[connectionTimedOut];
      UNWIND                         => Storage.Free[pupConnection];
      END; 
    PupStream.GetPupAddress[@pupAddress, remoteHost];
  -- create network stream to remote server
    pupConnection.streamHandle _
      PupStream.PupByteStreamCreate[
        pupAddress,
        IF receiveSeconds = LAST[CARDINAL] THEN PupStream.veryLongWait
        ELSE PupStream.SecondsToTocks[receiveSeconds]];
    END; -- enable
  -- return connection
    connection _ LOOPHOLE[pupConnection];
  END;

CloseConnection: PROCEDURE [communicationSystem: CommunicationSystem, connection: Connection] =
  BEGIN
  -- local constants
    pupConnection: PupConnection = LOOPHOLE[connection];
  -- close network stream to remote server
    pupConnection.streamHandle.delete[pupConnection.streamHandle];
  -- release pup connection object
    IF ~pupConnection.thirdPartyClose THEN Storage.Free[pupConnection]
    ELSE pupConnection.streamHandle _ NIL;
  END;

ActivatePort: PROCEDURE [
    communicationSystem: CommunicationSystem, localSocket: LONG INTEGER,
    serviceConnection: PROCEDURE [UNSPECIFIED, Connection, STRING],
    serviceConnectionData: UNSPECIFIED, receiveSeconds: CARDINAL,
    filter: PROCEDURE [STRING,Purpose],
    purpose: Purpose ] RETURNS [port: Port] =
  BEGIN
  -- local variables
    pupPort: PupPort;
  -- allocate pup port object
    pupPort _ Storage.Node[SIZE[PupPortObject]];
  -- prepare deactivation event
    PrepareEvent[@pupPort.deactivated];
  -- fork listener process
    pupPort.pH _ FORK PupListenerProcess[pupPort, localSocket,
      serviceConnection, serviceConnectionData, receiveSeconds, filter, purpose];
  -- return port
    port _ LOOPHOLE[pupPort];
  END;

  PupListenerProcess: PROCEDURE [pupPort: PupPort, localSocket: LONG INTEGER,
      serviceConnection: PROCEDURE [UNSPECIFIED, Connection, STRING],
      serviceConnectionData: UNSPECIFIED, receiveSeconds: CARDINAL,
      filter: PROCEDURE [STRING,Purpose],
      purpose: Purpose] =
    BEGIN
    -- server process
      PupServerProcess: PROCEDURE [streamHandle: Stream.Handle,
          pupAddress: PupStream.PupAddress] =
        BEGIN
        -- local constants
          remoteHost: STRING  = [maxStringLength];
        -- local variables
          pupConnection: PupConnection _ NIL;
        -- allocate and initialize pup connection object
          BEGIN ENABLE ANY => IF ftpsystem.catchUnidentifiedErrors THEN CONTINUE;
          pupConnection _ Storage.Node[SIZE[PupConnectionObject]];
          pupConnection^ _ PupConnectionObject[
            streamHandle: streamHandle,
            thirdPartyClose: TRUE, inputDiscontinuity: FALSE, outputDiscontinuity: FALSE,
            inputDiscontinuityConsumed: FALSE, terminateOnEndPhysicalRecord: FALSE,
            mark: ];
        -- identify remote host
          PupStream.AppendPupAddress[remoteHost, pupAddress];
        -- dispatch client procedure
          serviceConnection[serviceConnectionData, LOOPHOLE[pupConnection], remoteHost];
          END; -- enable
        -- close connection
          IF pupConnection # NIL THEN
            BEGIN
            -- close network stream to remote server
              IF pupConnection.streamHandle # NIL THEN
                pupConnection.streamHandle.delete[pupConnection.streamHandle];
            -- release pup connection object
              Storage.Free[pupConnection];
            END;
        END;
    -- local constants
    -- Note:  The transformation below assumes intimate knowledge
    --   of Mesa's LONG INTEGER implementation.
      longInteger: ARRAY {lob, hob} OF CARDINAL = LOOPHOLE[localSocket];
      pupLocalSocket: PupStream.PupSocketID = [longInteger[hob], longInteger[lob]];
    -- local variables
      pupListener: PupStream.PupListener;
    -- backstop all signals
      BEGIN ENABLE ANY => IF ftpsystem.catchUnidentifiedErrors THEN CONTINUE;
      CheckHim: PROCEDURE [pupAddress: PupStream.PupAddress] =
        BEGIN
        remoteHost: STRING = [20];
        PupStream.AppendPupAddress[remoteHost, pupAddress];
        filter[remoteHost, purpose !
            RejectThisConnection => PupStream.RejectThisRequest[error] ];
        END;
      pupListener _
        PupStream.CreatePupByteStreamListener[pupLocalSocket, PupServerProcess,
          PupStream.SecondsToTocks[receiveSeconds],CheckHim];
    -- await deactivation
      AwaitEvent[@pupPort.deactivated];
    -- deactivate listener
      PupStream.DestroyPupListener[pupListener];
      END; -- enable
    END;

DeactivatePort: PROCEDURE [communicationSystem: CommunicationSystem, port: Port] =
  BEGIN
  -- local constants
    pupPort: PupPort = LOOPHOLE[port];
  -- post deactivation event
    PostEvent[@pupPort.deactivated];
  -- join listener process
    JOIN pupPort.pH;
  -- release pup port object
    Storage.Free[pupPort];
  END;

 
-- **********************!  Error Subroutines  !***********************

AbortBecauseNameLookupFailed: PROCEDURE [nameLookupErrorCode: PupDefs.NameLookupErrorCode, message: STRING] =
  BEGIN
  -- local constants
    ftpError: FtpError = SELECT nameLookupErrorCode FROM
      noRoute     => noRouteToNetwork,
      noResponse => noNameLookupResponse,
      ENDCASE   => noSuchHost; -- errorFromServer
  -- abort
    AbortWithExplanation[ftpError, message];
  END;

AbortBecauseStreamClosing: PUBLIC PROCEDURE [closeReason: PupStream.CloseReason, message: STRING] =
  BEGIN
  -- local constants
    ftpError: FtpError = SELECT closeReason FROM
      noRouteToNetwork  => noRouteToNetwork,
      transmissionTimeout => connectionTimedOut,
      remoteReject         => connectionRejected,
      ENDCASE              => connectionClosed; -- localClose/remoteClose
  -- abort
    AbortWithExplanation[ftpError, message];
  END;

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

-- no operation

END. -- of FTPPupComCool