-- Copyright (C) 1981, 1984  by Xerox Corporation. All rights reserved. 
-- file: [Igor]<Emerson>STP>STPsA.mesa - Simple/Stream Transfer Protocol
-- Initialization and Error stuff in here
--  Edited by:
-- SXW   ,	16-Jul-81 14:54:32
-- PXK    ,	 9-Dec-81 18:23:36
-- SXE  ,	Nov 14, 1980 9:35 AM
-- BJD    ,	26-Mar-84 11:42:39
-- AOF, 	17-Jan-85  9:04:42

DIRECTORY
  Format USING [Octal, StringProc],
  Heap USING [systemZone],
  String USING [AppendString, AppendStringAndGrow, EmptyString, StringLength],
  STP USING [Error, ErrorCode, FileInfoObject],
  STPOps USING [
    CollectCode, CollectString, ErrorIfNextNotEOC, GetCommand, GetServerType,
    Handle, markComment, markIAmVersion, markNo, maxStringLength, Object,
    PList, PListArray, ProtocolError, PutCommand, UserProperties, ValidProperties],
  STPReplyCode USING [ReplyCode],
  PupStream USING [
    CloseReason, GetPupAddress, PupAddress, PupByteStreamCreate, PupNameTrouble,
    PupPackageDestroy, PupPackageMake, StreamClosing, veryLongWait],
  PupTypes USING [fillInHostID, fillInNetID],
  Stream USING [
    GetProcedure, GetSSTProcedure, Handle, InputOptions, PutProcedure,
    SetSSTProcedure, SubSequenceType, WaitAttentionProcedure];
    
STPsA: PROGRAM
  IMPORTS Format, Heap, PupStream, String, STP, STPOps
  EXPORTS STP, STPOps =
  
  BEGIN OPEN PupStream, STPOps;
  
  -- Global Data
  
  Error: PUBLIC SIGNAL [
  stp: STPOps.Handle, code: STP.ErrorCode, error: LONG STRING, reply: CHARACTER ¬ 0C] = CODE;
  Object: PUBLIC TYPE = STPOps.Object;
  z: UNCOUNTED ZONE = Heap.systemZone;
  
  -- Public Interface Routines 
  
  Close: PUBLIC PROCEDURE [stp: STPOps.Handle] =
    BEGIN
    nilByteStream: BOOLEAN;
    IF stp = NIL THEN RETURN;
    nilByteStream ¬ stp.byteStream = NIL;
    CloseInternal[stp];
    IF nilByteStream THEN
      ERROR Error[stp: stp, code: noConnection, error: "Attempt to Close a NIL connection"L];
    END;
    
  CloseInternal: PUBLIC PROCEDURE [stp: STPOps.Handle] =
    BEGIN
    IF stp = NIL THEN RETURN;
    stp.plist ¬ DestroyPList[stp.plist];
    z.FREE[@stp.info];
    z.FREE[@stp.remoteString];
    IF stp.byteStream # NIL THEN
      BEGIN
      s: Stream.Handle = stp.byteStream;
      stp.byteStream ¬ NIL;
      s.delete[s ! PupStream.StreamClosing => CONTINUE];
      END;
    END;
    
  Create: PUBLIC PROCEDURE RETURNS [stp: STPOps.Handle] =
    BEGIN OPEN PupTypes;
    ENABLE UNWIND => z.FREE[@stp];
    stp ¬ z.NEW[STPOps.Object];
    [] ¬ PupStream.PupPackageMake[];
    stp­ ¬ STPOps.Object[];
    RETURN[stp];
    END;
    
  Destroy: PUBLIC PROCEDURE [stp: STPOps.Handle] RETURNS [Handle] =
    BEGIN
    IF stp = NIL THEN RETURN[NIL];
    IF stp.byteStream # NIL THEN Close[stp];
    z.FREE[@stp.host];
    FOR i: STPOps.UserProperties IN STPOps.UserProperties DO
      z.FREE[@stp.userState[i]]; ENDLOOP;
    z.FREE[@stp];
    PupStream.PupPackageDestroy[];
    RETURN[NIL];
    END;
    
  Open: PUBLIC PROCEDURE [stp: STPOps.Handle, host: LONG STRING]
    RETURNS [herald: LONG STRING] =
    BEGIN
    reason: PupStream.CloseReason;
    IF stp = NIL THEN RETURN[NIL];
    IF stp.byteStream # NIL THEN
      ERROR Error[stp, alreadyAConnection, "You already have a connection?"L];
    BEGIN
    shortHost: STRING ¬ [40];
    server: PupStream.PupAddress ¬ [PupTypes.fillInNetID, PupTypes.fillInHostID, [0, 3]];
    stpOptions: Stream.InputOptions = [
      signalAttention: TRUE,
      terminateOnEndRecord: FALSE,
      signalLongBlock: FALSE,
      signalShortBlock: FALSE,
      signalSSTChange: TRUE,
      signalEndOfStream: TRUE];
    server.socket ¬ [0, 3];
    String.AppendString[shortHost, host];
    PupStream.GetPupAddress[
      @server, shortHost !
      PupStream.PupNameTrouble => GenerateErrorString[stp, noSuchHost, e]];
    stp.byteStream ¬ PupStream.PupByteStreamCreate[
      server, PupStream.veryLongWait !
      PupStream.StreamClosing => {reason ¬ why; GOTO streamClosing}];
    stp.byteStream.options ¬ stpOptions;
    stp.remoteString ¬ z.NEW[StringBody[maxStringLength]];
    stp.plist ¬ MakePList[];
    stp.info ¬ z.NEW[STP.FileInfoObject];
    stp.info­ ¬ [];
    stp.gotMark ¬ FALSE;
    stp.serverType ¬ GetServerType[host];
    PutCommand[stp, markIAmVersion, 1C, "STP calling"L !
      PupStream.StreamClosing => {reason ¬ why; GOTO streamClosing}];
    herald ¬ z.NEW[StringBody[80]];
    BEGIN ENABLE UNWIND => z.FREE[@herald];
    code: CHARACTER;
    mark: Stream.SubSequenceType;
    [mark, code] ¬ GetCommand[stp, @herald !
      PupStream.StreamClosing => {reason ¬ why; GOTO streamClosing}];
    IF mark # markIAmVersion THEN GenerateProtocolError[stp, badVersion, mark, code];
    ErrorIfNextNotEOC[stp];
    END;
    RETURN[herald];
    EXITS streamClosing => {CloseInternal[stp]; GenerateStreamClosingError[stp, reason]};
    END;
    END;
    
  -- PList Utilities
  
  DestroyPList: PUBLIC PROCEDURE [plist: PList] RETURNS [PList] =
    BEGIN
    i: STPOps.ValidProperties;
    IF plist # NIL THEN
      BEGIN
      FOR i IN STPOps.ValidProperties DO z.FREE[@plist[i]]; ENDLOOP;
      z.FREE[@plist];
      END;
    RETURN[NIL]
    END;
    
  MakePList: PUBLIC PROCEDURE RETURNS [plist: PList] =
    BEGIN
    i: STPOps.ValidProperties;
    plist ¬ z.NEW[PListArray];
    FOR i IN STPOps.ValidProperties DO plist[i] ¬ NIL; ENDLOOP;
    END;
    
  -- Error generation routines
  
  ErrorCodeToSTPErrorCode: PUBLIC PROCEDURE [
    errorCode: STP.ErrorCode, code: CHARACTER]
    RETURNS [STP.ErrorCode] = {
    replyCode: STPReplyCode.ReplyCode = LOOPHOLE[code];
    RETURN[SELECT replyCode FROM
      null => errorCode,
      badCommand => protocolError,
      noUserName => illegalUserName,
      illegalCommand => protocolError,
      badPList => protocolError,
      illegalServerFilename => illegalFileName,
      illegalDirectory => illegalFileName,
      illegalNameBody => illegalFileName,
      illegalVersion => illegalFileName,
      illegalType => accessError,
      illegalCharacterSize => accessError,
      illegalEOLConversion => accessError,
      illegalUserName => illegalUserName,
      illegalUserPassword => illegalUserPassword,
      illegalUserAccount => illegalUserAccount,
      illegalConnectName => illegalConnectName,
      illegalConnectPassword => illegalConnectPassword,
      illegalCreationDate => illegalFileName,
      illegalWriteDate => illegalFileName,
      illegalReadDate => illegalFileName,
      illegalAuthor => illegalFileName,
      illegalDevice => illegalFileName,
      fileNotFound => noSuchFile,
      accessDenied => accessDenied,
      inconsistent => protocolError,
      fileDataError => errorCode,
      tooLong => errorCode,
      dontSend => errorCode,
      notCompleted => errorCode,
      transientError => errorCode,
      permanentError => errorCode,
      fileBusy => errorCode,
      ENDCASE => errorCode]  -- can't do any better--};
      
  GenerateErrorString: PUBLIC PROCEDURE [
    stp: STPOps.Handle, errorCode: STP.ErrorCode, string: LONG STRING , code: CHARACTER ¬ 0C] =
    BEGIN
    ERROR Error[stp, 
      ErrorCodeToSTPErrorCode[errorCode, code],
      IF String.StringLength[string] # 0 THEN string
      ELSE
	SELECT errorCode FROM
	  noSuchHost => "No such host"L,
	  noRouteToNetwork => "No route to network"L,
	  noNameLookupResponse => "Name lookup server is not responding"L,
	  alreadyAConnection => "You already have a connection"L,
	  noConnection => "Please open a connection"L,
	  connectionClosed => "Connection closed (local or remote)"L,
	  connectionRejected => "Connection rejected by remote host"L,
	  connectionTimedOut => "Connection timed out"L,
	  accessDenied => "Access denied by remote server"L,
	  illegalUserName => "Invalid or illegal UserName"L,
	  illegalUserPassword => "Invalid or illegal UserPassword"L,
	  illegalUserAccount => "Invalid or illegal UserAccount"L,
	  illegalConnectName => "Invalid or illegal ConnectName"L,
	  illegalConnectPassword => "Invalid or illegal ConnectPassword"L,
	  credentailsMissing => "Name and/or Password not supplied"L,
	  protocolError => "Internal FTP protocol error"L,
	  illegalFileName => "Illegal filename"L,
	  noSuchFile => "File not found"L,
	  requestRefused => "Request refused by remote host"L,
	  accessError => "Illegal access attempt on remote stream"L,
	  undefinedError => "Undefined error"L,
	  ENDCASE => ERROR, code];
	  
    END;
    
  GenerateStreamClosingError: PUBLIC PROCEDURE [stp: STPOps.Handle, why: PupStream.CloseReason] =
    BEGIN
    GenerateErrorString[stp, 
      SELECT why FROM
	localClose, remoteClose => connectionClosed,
	noRouteToNetwork => noRouteToNetwork,
	transmissionTimeout => connectionTimedOut,
	remoteReject => connectionRejected,
	ENDCASE => ERROR, NIL];
    END;
    
  GenerateProtocolError: PUBLIC PROCEDURE [
    stp: STPOps.Handle, type: ProtocolError, mark: Stream.SubSequenceType, code: CHARACTER ¬ 0C] =
    BEGIN
    string: LONG STRING  ¬ NIL;
    MyAppend: Format.StringProc =
      BEGIN String.AppendStringAndGrow[to: @string, from: s, z: z]; END;
    String.AppendStringAndGrow[
      to: @string,
      from:
      SELECT type FROM
	badVersion => "Incompatable protocol version"L,
	badMark => "Invalid or undefined mark byte"L,
	badPList => "Invalid or malformed property list"L,
	eocExpected => "End-Of-Command mark byte expected"L,
	noCode => "error code is required after error mark byte"L,
	ENDCASE => ERROR,
       z: z];
    String.AppendStringAndGrow[to: @string, from: ", mark ="L, z: z];
    Format.Octal[MyAppend, mark];
    String.AppendStringAndGrow[to: @string, from: ", code ="L, z: z];
    Format.Octal[MyAppend, code];
    ERROR Error[stp, 
      protocolError, string, code ! UNWIND => z.FREE[@string]];
    END;
    
  SelectError: PUBLIC PROCEDURE [
    stp: STPOps.Handle, s: LONG STRING , mark: Stream.SubSequenceType] =
    BEGIN
    code: CHARACTER ¬ 0C;
    IF mark = markNo OR mark = markComment THEN
      BEGIN
      IF mark # markComment THEN code ¬ CollectCode[stp];
      CollectString[stp, @stp.remoteString];
      GenerateErrorString[
	stp, requestRefused,
	IF String.EmptyString[stp.remoteString] THEN s ELSE stp.remoteString,
	code];
      END
    ELSE GenerateProtocolError[stp, badMark, mark, code];
    END;
    
  -- NOP and ERROR Stream routines
  
  GetError: PUBLIC Stream.GetProcedure = {
    ERROR STP.Error[NIL, accessError, "Attempt to Get from a store stream"L]};
    
  PutError: PUBLIC Stream.PutProcedure = {
    ERROR STP.Error[NIL, accessError, "Attempt to Put on a retrieve stream"L]};
    
  SetSSTNop: PUBLIC Stream.SetSSTProcedure = BEGIN END;
  
  GetSSTNop: PUBLIC Stream.GetSSTProcedure = BEGIN RETURN[0B] END;
  
  WaitAttentionNop: PUBLIC Stream.WaitAttentionProcedure = BEGIN RETURN[0B] END;
  
  END. -- of STPsA