-- Copyright (C) 1981, 1982  by Xerox Corporation. All rights reserved. 
-- file: [Igor]<Emerson>STP>Private>STPsB.mesa - Simple/Stream Transfer Protocol 
-- Traditional FTP-like interface stuff in here
-- Edited by:
-- SXW   ,	17-Jul-81  7:48:31
-- JGS,		17-Aug-81 11:26:24
-- PXK    ,	15-Mar-82 17:26:37
-- LXR    ,	10-Nov-81 16:07:59
-- BJD    ,	24-Sep-82 10:35:49
-- AXD    ,	21-Sep-82 13:05:55

DIRECTORY
  Environment USING [Byte, bytesPerPage],
  Heap USING [systemZone],
  Inline USING [BITAND],
  PupStream USING [CloseReason, PupByteStreamAbort, StreamClosing],
  STP USING [
    Close, Completion, CompletionProcType, Confirmation, ConfirmProcType,
    CredentialsErrors, Error, FileErrors, NoteFileProcType, Type],
  STPOps USING [
    CheckConnection, CollectCode, CollectString, ErrorIfNextNotYes,
    GenerateErrorString, GenerateProtocolError, GenerateStreamClosingError, GetCommand,
    GetHereIsAndPList, Handle, LookAtMark, MakeRemoteName, markDelete,
    markDirectory, markEOC, markHereIsFile, markNo, markNewStore, markRename,
    markRetrieve, markYes, MyGetMark, NameToPList, Object, Operation, PList,
    PutCommand, PutPList, ResetPList, SelectError, SetByteSize, SetCreateTime,
    SetFileType, UserStateToPList],
  Stream USING [
    Block, CompletionCode, EndOfStream, GetByte, GetPosition, Handle,
    InvalidOperation, PutBlock, SetPosition, SetSST, SSTChange, SubSequenceType,
    TimeOut],
  Time USING [Packed];
  
STPsB: PROGRAM
  IMPORTS Heap, Inline, PupStream, STP, STPOps, Stream
  EXPORTS STP, STPOps =
  BEGIN OPEN PupStream, STPOps;
  
-- Data and types

  BytesPerPage: CARDINAL = Environment.bytesPerPage;
  PageOfStorage: TYPE = PACKED ARRAY [0..BytesPerPage) OF Environment.Byte;
  Object: PUBLIC TYPE = STPOps.Object;
  z: UNCOUNTED ZONE = Heap.systemZone;
  
-- Procedures for normal FTP-like interface 

  Delete: PUBLIC PROCEDURE [
    stp: STPOps.Handle, name: LONG STRING, confirm: STP.ConfirmProcType,
    complete: STP.CompletionProcType] =
    BEGIN DoFiles[stp, name, confirm, complete, delete]; END;
    
  Enumerate: PUBLIC PROCEDURE [
    stp: STPOps.Handle, name: LONG STRING, proc: STP.NoteFileProcType] =
    BEGIN
    Foo1: STP.ConfirmProcType =
      BEGIN
      RETURN[answer: IF proc[file] = yes THEN do ELSE abort, localStream: NIL];
      END;
    Foo2: STP.CompletionProcType = BEGIN END;
    DoFiles[stp, name, Foo1, Foo2, directory];
    END;
    
  Rename: PUBLIC PROCEDURE [
    stp: STPOps.Handle, old, new: LONG STRING] =
    BEGIN
    mark, saveMark: Stream.SubSequenceType;
    code: CHARACTER ¬ 0C;
    CheckConnection[stp];
    ResetPList[stp.plist];
    UserStateToPList[stp];
    NameToPList[stp.plist, old, alto];
    PutPList[stp, markRename, FALSE];
    ResetPList[stp.plist];
    UserStateToPList[stp];
    NameToPList[stp.plist, new, alto];
    PutPList[stp, 0B];
    [saveMark, code] ¬ GetCommand[stp, @stp.remoteString];
    IF (mark ¬ MyGetMark[stp]) # markEOC THEN
      GenerateProtocolError[stp, eocExpected, mark];
    IF saveMark # markYes THEN
      GenerateErrorString[stp, requestRefused, stp.remoteString, code];
    END;
    
  Retrieve: PUBLIC PROCEDURE [
    stp: STPOps.Handle, file: LONG STRING, confirm: STP.ConfirmProcType ¬ NIL,
    complete: STP.CompletionProcType ¬ NIL] =
    BEGIN DoFiles[stp, file, confirm, complete, retrieve]; END;
    
  Store: PUBLIC PROCEDURE [
    stp: STPOps.Handle, file: LONG STRING, stream: Stream.Handle,
    noteFile: STP.NoteFileProcType ¬ NIL,
    fileType: STP.Type, creation: Time.Packed] =
    BEGIN
    Confirm: STP.ConfirmProcType =
      {IF noteFile = NIL OR noteFile[file] = yes THEN
      RETURN[do, stream] ELSE RETURN[skip, NIL]};
    CheckConnection[stp];
    ResetPList[stp.plist];
    UserStateToPList[stp];
    NameToPList[stp.plist, file, alto];
    IF fileType = unknown THEN fileType ¬ FindFileType[stream];
    SetFileType[stp, fileType];
    STPOps.SetByteSize[stp, fileType];
    STPOps.SetCreateTime[stp, creation];
    DoFiles[stp, file, Confirm, NIL, store];
    END;
    
-- common routine for Delete, Enumerate and Retrieve

  DoFiles: PUBLIC PROCEDURE [
    stp: STPOps.Handle, file: LONG STRING, confirm: STP.ConfirmProcType,
    complete: STP.CompletionProcType, op: STPOps.Operation] =
    BEGIN
    reason: PupStream.CloseReason;
    reply: STP.Confirmation;
    string: LONG STRING ¬ NIL;
    local: Stream.Handle ¬ NIL;
    killConnection: BOOLEAN ¬ TRUE;
    CleanUp: PROCEDURE = 
      BEGIN
      IF killConnection THEN SmashClosed[stp];
      z.FREE[@string]
      END;
    {ENABLE {
      PupStream.StreamClosing => {reason ¬ why; GOTO streamClosing};
      Stream.TimeOut => {reason ¬ transmissionTimeout; GOTO streamClosing};
      UNWIND => CleanUp[]};
    IF op # store THEN
      BEGIN
      CheckConnection[stp];
      ResetPList[stp.plist];
      UserStateToPList[stp];
      NameToPList[stp.plist, file, alto];
      END;
    PutPList[
      stp,
      SELECT op FROM
	delete => markDelete,
	directory => markDirectory,
	retrieve => markRetrieve,
	store => markNewStore,
	ENDCASE => ERROR];
    DO
      IF LookAtMark[stp] = markEOC THEN {[] ¬ MyGetMark[stp]; EXIT};
      GetHereIsAndPList[stp, op # directory ! STP.Error =>
	IF code IN STP.CredentialsErrors OR code IN STP.FileErrors THEN 
	  killConnection ¬ FALSE];
      SELECT TRUE FROM
	confirm = NIL => {reply ¬ do; local ¬ NIL};
	ENDCASE => [reply, local] ¬ confirm[string ¬ MakeRemoteName[stp.plist, alto]];
      z.FREE[@string];
      SELECT reply FROM
	do => {
	  completion: STP.Completion;
	  SELECT op FROM
	    delete => {
	      code: CHARACTER ¬ 0C;
	      mark: Stream.SubSequenceType;
	      PutCommand[stp, markYes, 0C, "Yes, please"L];
	      [mark, code] ¬ GetCommand[stp, @stp.remoteString];
	      SELECT mark FROM
		markYes => completion ¬ ok;
		markNo => completion ¬ error;
		ENDCASE => GenerateErrorString[stp, protocolError, stp.remoteString, code]};
	    retrieve => {
	      PutCommand[stp, markYes, 0C, "Yes, please"L];
	      completion ¬ IF GetFile[stp, local, stp.plist[nameBody]] THEN ok ELSE error};
	    store => {
	      PutFile[stp, local, stp.plist[nameBody]];
	      ErrorIfNextNotYes[stp]};
	    ENDCASE;
	  IF complete # NIL THEN complete[completion, stp.remoteString];
	  IF LookAtMark[stp] = markEOC THEN {[] ¬ MyGetMark[stp]; EXIT}};
	skip => {
	  IF op # directory THEN
	    PutCommand[stp, markNo, 106C, "No Thanks"L];
	  IF op = store THEN {
	    mark: Stream.SubSequenceType;
	    code: CHARACTER;
	    [mark, code] ¬ GetCommand[stp, @stp.remoteString];
	    IF mark # markNo THEN
	      GenerateErrorString[stp, protocolError, stp.remoteString, code]};
	  };
	abort => {CleanUp[]; RETURN};
	ENDCASE => ERROR;
      ResetPList[stp.plist];
      ENDLOOP;
    EXITS
      streamClosing => GenerateStreamClosingError[stp, reason]};
    END;
    
-- Procedures for doing FTP protocol operations  

  GetFile: PUBLIC PROCEDURE [
    stp: STPOps.Handle, stream: Stream.Handle, file: LONG STRING]
    RETURNS[gotIt: BOOLEAN] =
    BEGIN
    mark: Stream.SubSequenceType;
    CheckConnection[stp];
    SELECT (mark ¬ MyGetMark[stp]) FROM
      markHereIsFile => NULL;
      markNo => {
	[] ¬ CollectCode[stp]; CollectString[stp, @stp.remoteString]; RETURN[FALSE]};
      ENDCASE => SelectError[stp, "HereIsFile Expected"L, mark];
    TransferTheFile[stp: stp, from: stp.byteStream, to: stream];
    ErrorIfNextNotYes[stp]; -- should do something about file on local disk
    RETURN[TRUE]
    END;
    
  PutFile: PUBLIC PROCEDURE [
    stp: STPOps.Handle, stream: Stream.Handle, file: LONG STRING, sendEOC: BOOLEAN ¬ TRUE] =
    BEGIN
    CheckConnection[stp];
    Stream.SetSST[stp.byteStream, markHereIsFile];
    TransferTheFile[stp: stp, from: stream, to: stp.byteStream];
    PutCommand[stp, markYes, 0C, "Transfer Completed"L, sendEOC];
    END;
    
  TransferTheFile: PUBLIC PROCEDURE [stp: STPOps.Handle, from, to: Stream.Handle] =
    BEGIN
    block: Stream.Block ¬ [NIL, 0, BytesPerPage];
    BEGIN
    ENABLE UNWIND => z.FREE[@block.blockPointer];
    bytesTransferred: CARDINAL;
    why: Stream.CompletionCode;
    savedSST: Stream.SubSequenceType;
    block.blockPointer ¬ LOOPHOLE[z.NEW[PageOfStorage]];
    DO
      block.startIndex ¬ 0;
      block.stopIndexPlusOne ¬ BytesPerPage;
      [bytesTransferred, why, savedSST] ¬ from.get[
	from, block, from.options !
	Stream.EndOfStream =>
	  BEGIN why ¬ endOfStream; bytesTransferred ¬ nextIndex; CONTINUE; END;
	Stream.SSTChange =>
	  BEGIN
	  why ¬ sstChange;
	  savedSST ¬ sst;
	  bytesTransferred ¬ nextIndex;
	  CONTINUE;
	  END];
      block.stopIndexPlusOne ¬ bytesTransferred;
      Stream.PutBlock[to, block, FALSE];
      SELECT why FROM
	normal => NULL;
	sstChange => {stp.mark ¬ savedSST; stp.gotMark ¬ TRUE; EXIT};
	endOfStream => EXIT;
	ENDCASE => ERROR;
      ENDLOOP;
    END;
    z.FREE[@block.blockPointer];
    END;
    
  SmashClosed: PUBLIC PROCEDURE [stp: STPOps.Handle] =
    BEGIN
    IF stp = NIL OR stp.byteStream = NIL THEN RETURN;
    -- First smash connection so it will not give us any grief, THEN close it
    PupStream.PupByteStreamAbort[stp.byteStream, "Unwinding..."L];
    STP.Close[stp ! STP.Error => IF code = noConnection THEN CONTINUE];
    END;
    
  FindFileType: PUBLIC PROCEDURE [stream: Stream.Handle]
    RETURNS [fileType: STP.Type] =
    BEGIN
    currentIndex: LONG CARDINAL;
    currentIndex ¬ Stream.GetPosition[stream !
      Stream.InvalidOperation => {fileType ¬ unknown; GOTO return}];
    Stream.SetPosition[stream, 0];
    fileType ¬ text;
    DO ENABLE Stream.EndOfStream => GOTO streamEND;
      IF (Inline.BITAND[Stream.GetByte[stream], 200B]) # 0 THEN
	{fileType ¬ binary; EXIT};
      REPEAT streamEND => NULL;
      ENDLOOP;
    Stream.SetPosition[stream, currentIndex];
    EXITS return => RETURN;
    END;
    
  END. -- of STPsB