-- file: STPsF.mesa - Simple/Stream Transfer Protocol
-- Server stuff in here
--  Edited by:
-- Smokey on: 11-Mar-81 17:07:41
-- Schmidt on:  4-Apr-82 15:04:49
--	(remove Put, Tool, Window dependencies)

DIRECTORY
  Directory: TYPE USING [DeleteFile, Error, GetProps, Rename],
  Format: TYPE USING [DecimalFormat, LongNumber],
  HeapString: TYPE USING [Replace],
  PupStream: TYPE USING [
    CreatePupByteStreamListener, DestroyPupListener, PupAddress, PupPackageDestroy,
    PupPackageMake, PupListener, RejectThisRequest, StreamClosing, veryLongWait],
  Segments: TYPE USING [EnumerateDirectory, FileNameProblem, FPHandle, InsertFile, ModifyFile],
  Storage: TYPE USING [CopyString, EmptyString, FreeString, FreeStringNil],
  STP: TYPE USING [Create, Destroy, Error, GetFileTimes],
  STPOps: TYPE USING [
    CollectCode, CollectString, GetCommand, GetFile, GetPList, Handle, MakePList,
    MakeRemoteName, markDelete, markDirectory, markEOC, markHereIsPList, markIAmVersion,
    markNo, markRename, markRetrieve, markNewStore, markYes, MyGetMark, NameToPList, Object,
    PList, PutCommand, PutFile, PutPList, ResetPList, SetFileDates],
  STPReplyCode: TYPE USING[badCommand, fileBusy, fileNotFound, illegalCommand, illegalNameBody, notCompleted, null],
  Stream: TYPE USING [Handle, SetSST, SubSequenceType, TimeOut],
  Streams: TYPE USING [CreateStream, Destroy, GetLength, NewStream, Read, SetIndex, Write],
  Time: TYPE USING [Append, Packed, Unpack],
  TTY: TYPE USING [Create, Handle, PutChar, PutLine, PutOctal, PutString];
    
STPsF: PROGRAM
  IMPORTS Directory, Format, HeapString, PupStream, Segments, Storage, STP,
  	STPOps, Stream, Streams, Time, TTY
  EXPORTS STP =
  
  BEGIN OPEN PupStream, STPOps;
  
  -- Global Data
  
  Object: PUBLIC TYPE = STPOps.Object;
  OneListenerPerCustomer: ERROR = CODE;
  
  pupListener: PupListener _ NIL;
  
  PutChar: PROCEDURE [w: TTY.Handle, c: CHARACTER] = INLINE {
  	IF LOOPHOLE[w, POINTER] # NIL THEN TTY.PutChar[w, c]};
  PutLine: PROCEDURE [w: TTY.Handle, s: STRING] = INLINE {
  	IF LOOPHOLE[w, POINTER] # NIL THEN TTY.PutLine[w, s]};
  PutOctal: PROCEDURE [w: TTY.Handle, n: UNSPECIFIED] = INLINE {
  	IF LOOPHOLE[w, POINTER] # NIL THEN TTY.PutOctal[w, n]};
  PutText: PROCEDURE [w: TTY.Handle, s: STRING] = INLINE {
  	IF LOOPHOLE[w, POINTER] # NIL THEN TTY.PutString[w, s]};
  
  -- Public Interface Routines 
  
  CreateListener: PUBLIC PROCEDURE [
    server: PROCEDURE[Stream.Handle, PupAddress] _ DefaultServer,
    checker: PROCEDURE[PupAddress] _ DefaultChecker,
    connections: CARDINAL _ 1] =
    BEGIN
    IF pupListener = NIL THEN
      BEGIN
      PupStream.PupPackageMake[];
      pupListener _ CreatePupByteStreamListener[
        local: [0,3],
        proc: server,
        ticks: veryLongWait,
        filter: checker];
      maxConnections _ connections;
      END
    ELSE ERROR OneListenerPerCustomer;
    END;
    
  DestroyListener: PUBLIC PROCEDURE =
    BEGIN
    IF pupListener # NIL THEN
      BEGIN
      PupStream.DestroyPupListener[pupListener];
      PupStream.PupPackageDestroy[];
      END;
    END;
    
  -- Server stuff
  
  DefaultChecker: PUBLIC PROCEDURE [address: PupAddress] =
    BEGIN END;
    
  DefaultServer: PUBLIC PROCEDURE [byteStream: Stream.Handle, address: PupAddress] =
    BEGIN STPServer[LOOPHOLE[NIL], byteStream, address]; END;
    
  STPServer: PUBLIC PROCEDURE [w: TTY.Handle, byteStream: Stream.Handle, address: PupAddress] =
    BEGIN -- this guy gets FORKed for every accepted RFC
    file: STRING _ NIL;
    stream: Stream.Handle _ NIL;
    mark: Stream.SubSequenceType;
    stp: STPOps.Handle _ STP.Create[];
    stp.byteStream _ byteStream;
    stp.plist _ STPOps.MakePList[];
    stp.gotMark _ FALSE;
    PutText[w, "Connection opened to ["L];
    PutOctal[w, address.net];
    PutText[w, "#, "L];
    PutOctal[w, address.host];
    PutText[w, "# ["L];
    PutOctal[w, address.socket.a];
    PutText[w, "#, "L];
    PutOctal[w, address.socket.b];
    PutLine[w, "#]]"L];
    DO ENABLE PupStream.StreamClosing, Stream.TimeOut =>
      {stp.byteStream _ NIL; PutLine[w, "  ...Connection Closed"L]; EXIT};
      SELECT mark _ STPOps.MyGetMark[stp] FROM
	markDelete => DoFiles[w, stp, delete];
	markDirectory => DoFiles[w, stp, directory];
        markIAmVersion =>
	  BEGIN
	  [] _ STPOps.CollectCode[stp];
	  STPOps.CollectString[stp, @stp.remoteString];
	  IF ~NextEOC[stp] THEN EXIT;
	  STPOps.PutCommand[stp, markIAmVersion, 1C, "Cedar STP: You called?"L];
	  END; 
	markNewStore =>
	  BEGIN
          STPOps.ResetPList[stp.plist];
	  STPOps.GetPList[stp, TRUE];
	  file _ STPOps.MakeRemoteName[stp.plist, alto];
	  IF ~Segments.ModifyFile[file] THEN
	    STPOps.PutCommand[stp, markNo, STPReplyCode.fileBusy, "can't be modified"L]
	  ELSE
	    BEGIN
	    IF ~Storage.EmptyString[file] THEN stream _ Streams.NewStream[file, Streams.Write !
	      Segments.FileNameProblem[] => CONTINUE];
	    IF stream # NIL THEN 
	      BEGIN
 	      STPOps.PutPList[stp, markHereIsPList];
	      IF STPOps.GetFile[stp, stream, file ! STP.Error => EXIT] AND NextEOC[stp] THEN
	        BEGIN
	        PutCommand[stp, markYes, STPReplyCode.null, "Transfer completed"L];
		PutText[w, "  Stored: "L];
		PutProperties[w, stp.plist];
		END
	      ELSE
	        PutCommand[stp, markNo, STPReplyCode.notCompleted, "Store not completed"L];
	      STPOps.SetFileDates[stp, stream];
	      Streams.Destroy[stream];
	      stream _ NIL;
	      END
	    ELSE PutCommand[stp, markNo, STPReplyCode.illegalNameBody, "Illegal Filename"L];
	    END;
	  file _ Storage.FreeStringNil[file];
	  END;
	markRename =>
	  BEGIN
	  newName: STRING _ NIL;
	  failed: BOOLEAN _ FALSE;
          STPOps.ResetPList[stp.plist];
	  STPOps.GetPList[stp, FALSE];
	  file _ STPOps.MakeRemoteName[stp.plist, alto];
          STPOps.ResetPList[stp.plist];
	  STPOps.GetPList[stp, TRUE];
	  newName _ STPOps.MakeRemoteName[stp.plist, alto];
	  IF Segments.ModifyFile[file] THEN 
	    Directory.Rename[file, newName ! Directory.Error => {failed _ TRUE; CONTINUE}]
	  ELSE failed _ TRUE;
	  IF failed THEN PutCommand[stp, markNo, STPReplyCode.null, "Rename failed"L]
	  ELSE
	    BEGIN
	    PutCommand[stp, markYes, STPReplyCode.null, "... renamed"L];
	    PutText[w, "  Renamed: "L];
	    PutText[w, file];
	    PutText[w, " to be "L];
	    PutLine[w, newName];
	    END;
	  file _ Storage.FreeStringNil[file];
	  newName _ Storage.FreeStringNil[file];
	  END;
	markRetrieve => DoFiles[w, stp, retrieve];
	ENDCASE => 
	  BEGIN
	  STPOps.PutCommand[stp, markNo, STPReplyCode.badCommand, "Bad or Unimplemented Command"L];
	  EXIT;
	  END;
      ENDLOOP;
    Storage.FreeString[file];
    IF stream # NIL THEN Streams.Destroy[stream];
    stp _ STP.Destroy[stp];
    currentConnections _ currentConnections - 1;
    END;
    
  DoFiles: PROCEDURE [w: TTY.Handle, stp: STPOps.Handle, type : {delete, directory, retrieve}] =
    BEGIN
    file: STRING _ NIL;
    stream: Stream.Handle _ NIL;
    mark: Stream.SubSequenceType;
    code: CHARACTER;
    foundAtLeastOne: BOOLEAN _ FALSE;
    pendingName: STRING _ NIL;
    DoPendingDelete: PROCEDURE =
      BEGIN
      IF pendingName = NIL THEN RETURN;
      Directory.DeleteFile[pendingName];
      pendingName _ Storage.FreeStringNil[pendingName];
      END;
    PerFile: PROCEDURE [cap: Segments.FPHandle, name: STRING] RETURNS[BOOLEAN] =
      BEGIN ENABLE UNWIND =>
        BEGIN
	Storage.FreeString[file];
	IF stream # NIL THEN Streams.Destroy[stream];
	END;
      foundAtLeastOne _ TRUE;
      STPOps.ResetPList[stp.plist];
      SELECT type FROM
        delete =>
	  BEGIN
	  DoPendingDelete[];
          SetPropertiesFromFP[stp, name, cap];
          STPOps.PutPList[stp, markHereIsPList, TRUE];
	  [mark, code] _ STPOps.GetCommand[stp, @stp.remoteString];
	  IF ~NextEOC[stp] THEN
	    BEGIN
	    STPOps.PutCommand[stp, markNo, STPReplyCode.illegalCommand, "Protocol Error"L];
            RETURN[TRUE];
	    END;
	  IF mark = markYes THEN 
	    BEGIN
	    IF ~Segments.ModifyFile[name] THEN
	      STPOps.PutCommand[stp, markNo, STPReplyCode.fileBusy, "can't be modified"L, FALSE]
	    ELSE
	      BEGIN
	      PutText[w, "  Deleted: "L];
	      PutProperties[w, stp.plist];
	      pendingName _ Storage.CopyString[name];
	      STPOps.PutCommand[stp, markYes, STPReplyCode.null, "file deleted"L, FALSE]
	      END;
	    END;
	  END;
        directory =>
	  BEGIN
          SetPropertiesFromFP[stp, name, cap];
          STPOps.PutPList[stp, markHereIsPList, FALSE];
	  END;
        retrieve =>
	  BEGIN
	  stream _ Streams.CreateStream[Segments.InsertFile[cap, Streams.Read], Streams.Read];
	  IF stream # NIL THEN 
	    BEGIN
	    STPOps.ResetPList[stp.plist];
	    SetPropertiesFromStream[stp, name, stream];
	    STPOps.PutPList[stp, markHereIsPList];
	    [mark, code] _ STPOps.GetCommand[stp, @stp.remoteString];
	    IF ~NextEOC[stp] THEN
	      BEGIN
	      STPOps.PutCommand[stp, markNo, STPReplyCode.illegalCommand, "Protocol Error"L];
              RETURN[TRUE];
	      END;
	    IF mark = markYes THEN STPOps.PutFile[stp, stream, name, FALSE];
	    Streams.Destroy[stream];
	    stream _ NIL;
	    PutText[w, "  Retrieved: "L];
	    PutProperties[w, stp.plist];
	    END
	  ELSE PutCommand[stp, markNo, STPReplyCode.fileNotFound, "File not found"L];
	  END;
	ENDCASE => ERROR;
      RETURN[FALSE];
      END;
    STPOps.GetPList[stp, TRUE];
    file _ STPOps.MakeRemoteName[stp.plist, alto];
    Segments.EnumerateDirectory[PerFile, file];
    IF type = delete THEN DoPendingDelete[];
    file _ Storage.FreeStringNil[file];
    IF foundAtLeastOne THEN Stream.SetSST[stp.byteStream, markEOC] 
    ELSE STPOps.PutCommand[stp, markNo, STPReplyCode.fileNotFound, "File not found"L];
    END;
    
  NextEOC: PROCEDURE [stp: STPOps.Handle] RETURNS [BOOLEAN] =
    BEGIN
    IF MyGetMark[stp] = markEOC THEN RETURN[TRUE]
    ELSE 
      BEGIN
      STPOps.PutCommand[stp, markNo, STPReplyCode.illegalCommand, "Protocol Error"L];
      RETURN[FALSE];
      END;
    END;    

  PutProperties: PROCEDURE [w: TTY.Handle, plist: STPOps.PList] =
    BEGIN OPEN Storage;
    IF ~EmptyString[plist[nameBody]] THEN PutText[w, plist[nameBody]]
    ELSE IF ~EmptyString[plist[serverName]] THEN PutText[w, plist[serverName]];
    IF ~EmptyString[plist[version]] THEN {PutChar[w, '!]; PutText[w, plist[version]]};
    PutText[w, " Type "L];
    PutText[w, IF ~EmptyString[plist[type]] THEN plist[type] ELSE "unknown"L];
    IF ~EmptyString[plist[byteSize]] THEN
      {PutText[w, ", ByteSize "L]; PutText[w, plist[byteSize]]};
    PutText[w, "..."L];
    IF ~EmptyString[plist[size]] THEN {PutText[w, plist[size]]; PutText[w, " bytes"L]};
    PutChar[w, '\n];
    END;
    
  SetPropertiesFromStream: PROCEDURE [stp: STPOps.Handle, file: STRING, stream: Stream.Handle] =
    BEGIN
    length: LONG CARDINAL _ Streams.GetLength[stream];
    create, read, write: Time.Packed;
    Streams.SetIndex[stream, 0]; -- undo GetLength
    [create: create, read: read, write: write] _ STP.GetFileTimes[stream];
    SetTimesPlus[stp, file, length, create, read, write];
    END;
    
  SetPropertiesFromFP: PROCEDURE [stp: STPOps.Handle, file: STRING, fp: Segments.FPHandle] =
    BEGIN
    length: LONG CARDINAL;
    create, read, write: Time.Packed;
    [createDate: create,
      readDate: read,
      writeDate: write,
      byteLength: length,
      parent: ] _ Directory.GetProps[fp^, file];
    SetTimesPlus[stp, file, length, create, read, write];
    END;

  SetTimesPlus: PROCEDURE [
    stp: STPOps.Handle, file:STRING, length: LONG CARDINAL, create, read, write: Time.Packed] =
    BEGIN
    proc: PROCEDURE [s: STRING] = {HeapString.Replace[@stp.plist[size], s]};
    temp: STRING _ [24];
    Time.Append[temp,Time.Unpack[create]];
    HeapString.Replace[@stp.plist[createDate], temp];
    temp.length _ 0;
    Time.Append[temp,Time.Unpack[write]];
    HeapString.Replace[@stp.plist[writeDate], temp];
    temp.length _ 0;
    Time.Append[temp,Time.Unpack[read]];
    HeapString.Replace[@stp.plist[readDate], temp];
    NameToPList[stp.plist, file, alto];
    HeapString.Replace[@stp.plist[byteSize], "8"L];
    Format.LongNumber[length, Format.DecimalFormat, proc];
    END;
  
  -- Testing code
  
  currentConnections: CARDINAL _ 0;
  maxConnections: CARDINAL _ 0;
  logSW: TTY.Handle _ TTY.Create["STPServer.Log"L];
  
  CheckConnectionRequest: PUBLIC PROCEDURE [address: PupAddress] =
    BEGIN
    IF currentConnections < maxConnections THEN currentConnections _ currentConnections + 1
    ELSE ERROR RejectThisRequest["Connection rejected - Too many connections"]; 
    END;
    
  CreateSTPServer: PUBLIC PROCEDURE [byteStream: Stream.Handle, address: PupAddress] =
    BEGIN -- this guy gets FORKed for every accepted RFC
    STPServer[logSW, byteStream, address];
    END;
    
  CreateListener[CreateSTPServer, CheckConnectionRequest, 1]; 
  
  END. -- of STPsF