-- File: IFSFileControl.mesa
-- Last edited by Levin:   1-Jul-81 16:43:27

DIRECTORY
  FileDefs USING [Operations, OperationsRecord],
  FrameDefs USING [IsBound],
  IFSFilePrivate USING [
    Abandon, Close, CopyString, Destroy, Extend, FinalizeFreeList, FSInstance, FSObject,
    GetLength, GetTimes, InitializeFreeList, Open, SetCreationTime, SetLength,
    StartRead, StartWrite, Truncate],
  Leaf USING [
    Answer, AnswerObject, LeafOp, leafSocket, paramsOp, ptLeaf, Request, RequestObject],
  LogDefs USING [DisplayNumber],
  PupDefs USING [
    GetPupAddress, PupAddress, PupNameTrouble, PupPackageDestroy, PupPackageMake],
  Sequin USING [
    Broken, Buffer, Create, Destroy, Get, GetEmptyBuffer, Handle, Put,
    ReleaseBuffer, SetZone],
  Storage USING [StringLength],
    StringDefs USING [WordsForString],
  VMDefs USING [Problem, UnableToLogin],
  VMStorage USING [longTerm, shortTerm];

IFSFileControl: MONITOR
  IMPORTS
    FrameDefs, IFSFilePrivate, LogDefs, PupDefs, Sequin, Storage, StringDefs,
    VMDefs, VMStorage
  EXPORTS FileDefs, IFSFilePrivate =

  BEGIN OPEN IFSFilePrivate;


  -- Global Variables --

  loginCount: CARDINAL;
  
  ifsOps: FileDefs.Operations;

  oldZone: MDSZone;
  

  -- Miscellaneous --

  someWordsForFilename: CARDINAL = 15;

  CantCommunicateByTelepathy: ERROR = CODE;
  FilesInUse: ERROR = CODE;
  InsufficientLogouts: ERROR = CODE;
  PupBuffersTooSmall: ERROR = CODE;
  ServerNameMissing: ERROR = CODE;
  TooManyLogouts: ERROR = CODE;


  -- Types Exported to FileDefs --

  -- Unfortunately, the compiler doesn't support this just yet
  -- FSInstance: PUBLIC TYPE = IFSFilePrivate.FSInstance;

  -- Procedures Exported to FileDefs --

  InitializeIFS: PUBLIC PROCEDURE RETURNS [ops: FileDefs.Operations] =
    BEGIN
    IF (loggingEnabled _ FrameDefs.IsBound[LogDefs.DisplayNumber]) THEN
      {ifsFiles _ 0; LogDefs.DisplayNumber["Open IFS Files"L, [short[@ifsFiles]]]};
    loginCount _ 0;
    InitializeFreeList[];
    -- the LOOPHOLEs below get around non-support for multiple implementors of an
    -- exported type.
    ifsOps _ VMStorage.longTerm.NEW[FileDefs.OperationsRecord _ [
      login: LOOPHOLE[Login],
      logout: LOOPHOLE[Logout],
      checkpoint: LOOPHOLE[Checkpoint],
      abort: LOOPHOLE[Abort],
      open: LOOPHOLE[Open],
      close: LOOPHOLE[Close],
      abandon: LOOPHOLE[Abandon],
      destroy: LOOPHOLE[Destroy],
      getLength: LOOPHOLE[GetLength],
      setLength: LOOPHOLE[SetLength],
      extend: LOOPHOLE[Extend],
      truncate: LOOPHOLE[Truncate],
      startRead: LOOPHOLE[StartRead],
      startWrite: LOOPHOLE[StartWrite],
      getTimes: LOOPHOLE[GetTimes],
      setCreation: LOOPHOLE[SetCreationTime]]];
    oldZone _ Sequin.SetZone[VMStorage.shortTerm];
    RETURN[ifsOps]
    END;

  FinalizeIFS: PUBLIC PROCEDURE =
    BEGIN
    IF loginCount ~= 0 THEN ERROR InsufficientLogouts;
    VMStorage.longTerm.FREE[@ifsOps];
    FinalizeFreeList[];
    [] _ Sequin.SetZone[oldZone];
    END;


  -- Variables Exported to IFSFilePrivate --

  loggingEnabled: PUBLIC BOOLEAN;

  ifsFiles: PUBLIC CARDINAL;


  -- Internal Procedures --

  Login: PROCEDURE [
    server, userName, password, secondaryName, secondaryPassword: STRING _ NIL]
    RETURNS [fs: FSInstance] =
    BEGIN
    serverAddr: PupDefs.PupAddress _ [net: , host: , socket: Leaf.leafSocket];

    TryForConnection: PROCEDURE =
      BEGIN
      LeafStringWords: PROCEDURE [s: STRING] RETURNS [CARDINAL] =
	{RETURN[StringDefs.WordsForString[Storage.StringLength[s]] - 1]};
      sequin: Sequin.Handle;
      buffer: Sequin.Buffer _ Sequin.GetEmptyBuffer[];
      adequate: CARDINAL =
	2*(MAX[SIZE[Leaf.RequestObject], SIZE[Leaf.AnswerObject]] + 1 +
          LeafStringWords[userName] + LeafStringWords[password] +
          LeafStringWords[secondaryName] + LeafStringWords[secondaryPassword] +
	  someWordsForFilename);
      problem: VMDefs.Problem;
      IF buffer.maxBytes < adequate THEN ERROR PupBuffersTooSmall;
      sequin _ Sequin.Create[dest: serverAddr, pupType: Leaf.ptLeaf];
      LOOPHOLE[buffer.data, Leaf.Request]^ _
	[Leaf.paramsOp, params[packetDataBytes: buffer.maxBytes,
			  fileLockTimeout: 2*60/5, connectionTimeout: 10*60/5]];
      buffer.nBytes _ Leaf.paramsOp.length;
      BEGIN
      ENABLE Sequin.Broken => {problem _ io; GO TO serverDead};
      answerOp: Leaf.LeafOp;
      Sequin.Put[sequin, buffer];
      buffer _ Sequin.Get[sequin];
      answerOp _ LOOPHOLE[buffer.data, Leaf.Answer].op;
      Sequin.ReleaseBuffer[buffer];
      IF answerOp.type ~= params OR answerOp.sense ~= reply THEN
	{problem _ other; GO TO serverDead};
      EXITS
        serverDead => {Sequin.Destroy[sequin]; ERROR VMDefs.UnableToLogin[problem]};
      END;
      Sequin.Destroy[sequin];
      END;

    NoteLogin: ENTRY PROCEDURE = INLINE {loginCount _ loginCount + 1};

    IF server= NIL OR server.length = 0 THEN ERROR ServerNameMissing;
    IF FrameDefs.IsBound[PupDefs.PupPackageMake] THEN PupDefs.PupPackageMake[]
    ELSE ERROR CantCommunicateByTelepathy;
    PupDefs.GetPupAddress[@serverAddr, server
      ! PupDefs.PupNameTrouble =>
	ERROR VMDefs.UnableToLogin[
	  SELECT code FROM noRoute, noResponse => io, ENDCASE => other]];
    TryForConnection[];
    fs _ VMStorage.shortTerm.NEW[FSObject _ [
	    primaryName: CopyString[userName], primaryPassword: CopyString[password],
	    secondaryName: CopyString[secondaryName],
	    secondaryPassword: CopyString[secondaryPassword],
	    serverAddr: serverAddr]];
    NoteLogin[];
    END;

  Logout: PROCEDURE [fs: FSInstance] =
    BEGIN

    NoteLogout: ENTRY PROCEDURE = INLINE {loginCount _ loginCount - 1};

    IF loginCount = 0 THEN ERROR TooManyLogouts;
    IF fs.fileList ~= NIL THEN ERROR FilesInUse;
    IF fs.primaryName ~= NIL THEN VMStorage.shortTerm.FREE[@fs.primaryName];
    IF fs.primaryPassword ~= NIL THEN VMStorage.shortTerm.FREE[@fs.primaryPassword];
    IF fs.secondaryName ~= NIL THEN VMStorage.shortTerm.FREE[@fs.secondaryName];
    IF fs.secondaryPassword ~= NIL THEN VMStorage.shortTerm.FREE[@fs.secondaryPassword];
    VMStorage.shortTerm.FREE[@fs];
    PupDefs.PupPackageDestroy[];
    NoteLogout[];
    END;

  Checkpoint: PROCEDURE [fs: FSInstance] = {NULL};

  Abort: PROCEDURE [fs: FSInstance] = {NULL};


  END.