-- file: [Igor]<Emerson>STP>Private>UnsafeSTPsB.mesa - Simple/Stream Transfer Protocol 
-- Traditional FTP-like interface stuff in here
-- Edited by:
-- Smokey,	17-Jul-81  7:48:31
-- JGS,		17-Aug-81 11:26:24
-- Karlton,	15-Mar-82 17:26:37
-- Loretta,	10-Nov-81 16:07:59
-- Davirro,	24-Sep-82 10:35:49
-- Daniels,	21-Sep-82 13:05:55

DIRECTORY
  Environment USING [Byte, bytesPerPage],
  FileStream USING[GetIndex, SetIndex],
  Heap USING [systemZone],
  Inline USING [BITAND],
  PupStream USING [CloseReason, PupByteStreamAbort, StreamClosing],
  UnsafeSTP USING [
    Close, Completion, CompletionProcType, Confirmation, ConfirmProcType,
    CredentialsErrors, Error, ErrorCode, FileErrors, NoteFileProcType, Type],
  UnsafeSTPOps USING [
    CheckConnection, CollectCode, CollectString, ErrorIfNextNotYes, ErrorIfNextNotEOC,
    ErrorCodeToSTPErrorCode, 
    GenerateErrorString, GenerateProtocolError, GenerateStreamClosingError, GetCommand,
    GetHereIsAndPList, GetPList, Handle, LookAtMark, MarkEncountered, 
    MakeRemoteName, markComment, markDelete,
    markDirectory, markEOC, markHereIsFile, markHereIsPList, markNo, markNewDirectory, 
    markNewStore, markRename,
    markRetrieve, markYes, MyGetMark, NameToPList, Object, Operation, PList,
    PutCommand, PutPList, ResetPList, SelectError, SetByteSize, SetCreateTime,
    SetFileType, UserStateToPList],
  UnsafeSTPReplyCode USING[ReplyCode],
  Stream USING [
    Block, CompletionCode, EndOfStream, GetByte,  Handle,
    PutBlock, SetSST, SSTChange, SubSequenceType,
    TimeOut],
  Time USING [Packed];
  
UnsafeSTPsB: PROGRAM
  IMPORTS FileStream, Heap, Inline, PupStream, STP: UnsafeSTP, STPOps: UnsafeSTPOps, Stream
  EXPORTS UnsafeSTP, UnsafeSTPOps =
  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];
      IF string ~= NIL THEN 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;
    IF op = directory THEN 
    	SELECT TryNewDirectory[stp, confirm  ! STP.Error =>
				IF code IN STP.CredentialsErrors OR code IN STP.FileErrors THEN 
	  				killConnection _ FALSE] FROM
    	finished => RETURN;
    	aborted => {CleanUp[]; RETURN};	
    	tryOldDirectory => NULL;	-- just falls thru
    	ENDCASE => ERROR;
   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]];
      IF string ~= NIL THEN 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;
    
TryNewDirectory: PROC[stp: STPOps.Handle, confirm: STP.ConfirmProcType] 
	RETURNS[{finished, aborted, tryOldDirectory}] = {
	mark: Stream.SubSequenceType;
	PutPList[stp, markNewDirectory];
	DO
		SELECT (mark _ MyGetMark[stp]) FROM
		markComment => CollectString[stp, @stp.remoteString];
		markHereIsPList => {
			string: LONG STRING;
			reply: STP.Confirmation;
			DO
				GetPList[stp: stp, gobbleEOC: FALSE, propertiesOk: TRUE
					! MarkEncountered => {
						mark: Stream.SubSequenceType _ LookAtMark[stp];
						IF mark = markEOC THEN EXIT
						ELSE GenerateProtocolError[stp, eocExpected, mark]
						}];
				string _ MakeRemoteName[stp.plist, alto];
				[answer: reply] _ confirm[string];
				IF string ~= NIL THEN z.FREE[@string];
				IF reply = abort THEN RETURN[aborted];
				ENDLOOP;
			ErrorIfNextNotEOC[stp];
			RETURN[finished];
			};
		markNo =>
	  		BEGIN
	  		code: CHARACTER = CollectCode[stp];
	  		errorCode: STP.ErrorCode =
	    		ErrorCodeToSTPErrorCode[requestRefused, code]; 
	  		CollectString[stp, @stp.remoteString];
	  		ErrorIfNextNotEOC[stp];
	  		IF LOOPHOLE[code, UnsafeSTPReplyCode.ReplyCode] = badCommand THEN
	  			RETURN[tryOldDirectory];
	  		GenerateErrorString[stp, errorCode, stp.remoteString, code];
	  		END;
		ENDCASE => GenerateProtocolError[stp, badMark, mark, 0C];
		ENDLOOP;
    };

-- 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 => IF block.blockPointer ~= NIL THEN 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;
    IF block.blockPointer ~= NIL THEN 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 _ FileStream.GetIndex[stream -- !-- 
      -- Stream.InvalidOperation => {fileType _ unknown; GOTO return}-- ];
    FileStream.SetIndex[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;
    FileStream.SetIndex[stream, currentIndex];
    -- EXITS return => RETURN;
    END;
    
  END. -- of STPsB