-- FTPPupComCool.mesa, Edit: HGM December 16, 1980  1:56 AM  

-- Copyright  Xerox Corporation 1979, 1980

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

FTPPupComCool: PROGRAM
  IMPORTS
    Stream, Storage, PupDefs, PupStream, 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,
      AbortConnection: AbortConnection,
      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 PupDefs.PupPackageMake[]; END;

  DestroyCommunicationSystem: PROCEDURE [
    communicationSystem: CommunicationSystem] =
    BEGIN
    -- destroy pup package
    PupDefs.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
      PupDefs.PupNameTrouble => AbortBecauseNameLookupFailed[code, e];
      PupStream.StreamClosing => AbortBecauseStreamClosing[why, text];
      Stream.TimeOut => Abort[connectionTimedOut];
      UNWIND => Storage.Free[pupConnection];
      END;
    PupDefs.GetPupAddress[@pupAddress, remoteHost];
    -- create network stream to remote server
    pupConnection.streamHandle _ PupStream.PupByteStreamCreate[
      pupAddress,
      IF receiveSeconds = LAST[CARDINAL] THEN PupDefs.veryLongWait
      ELSE PupDefs.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;

  AbortConnection: PROCEDURE [
    communicationSystem: CommunicationSystem, connection: Connection, text: STRING] =
    BEGIN
    pupConnection: PupConnection = LOOPHOLE[connection];
    PupStream.PupByteStreamAbort[pupConnection.streamHandle,text];
    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
      PupDefs.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];
      PupDefs.AppendPupAddress[remoteHost, pupAddress];
      filter[
	remoteHost, purpose !
	RejectThisConnection => PupStream.RejectThisRequest[error]];
      END;
    pupListener _ PupStream.CreatePupByteStreamListener[
      pupLocalSocket, PupServerProcess, PupDefs.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