-- Copyright (C) 1983, 1985  by Xerox Corporation. All rights reserved. 
-- GateFTPServer.mesa, HGM, 25-Jun-85  4:32:14
-- Please don't forget to update the herald....

DIRECTORY
  Ascii USING [CR],
  CmFile USING [Handle, TableError],
  Event USING [aboutToSwap],
  EventTypes USING [aboutToBoot, aboutToBootPhysicalVolume],
  Format USING [StringProc],
  Heap USING [systemZone],
  Process USING [SecondsToTicks],
  Profile USING [GetDefaultRegistry],
  Put USING [Text],
  STP USING [GetProperty],
  STPExtra USING [Action, Denied, ApprovalProc, Server],
  Stream USING [Delete, Handle],
  String USING [AppendChar, AppendString, AppendNumber, CopyToNewString, Equivalent],
  StringLookUp USING [noMatch, TableDesc],
  Supervisor USING [
    AddDependency, AgentProcedure, CreateSubsystem, RemoveDependency,
    SubsystemHandle],
  Time USING [AppendCurrent],
  Token USING [Item, Octal],
  Tool USING [Create, MakeSWsProc, MakeMsgSW],
  ToolWindow USING [TransitionProcType],
  Window USING [Handle],

  Indirect USING [Close, GetParmFileName, NextValue, OpenSection],
  Password USING [Check, Encrypted, Status, ValidMemberOfGroup],
  PupDefs USING [AppendHostName],
  PupStream USING [
    CreatePupByteStreamListener, DestroyPupListener, PupAddress,
    PupPackageDestroy, PupPackageMake, PupListener, RejectThisRequest,
    SecondsToTocks];

GateFTPServer: MONITOR
  IMPORTS
    CmFile, Event, Heap, Process, Profile, Put,
    STP, STPExtra, Stream, String, Supervisor, Time,
    Token, Tool, Indirect, Password, PupDefs, PupStream =
  BEGIN

  herald: LONG STRING = "FTP Server of 25-Jun-85  4:32:03";

  myGroup: LONG STRING ¬ NIL;
  pupListener: PupStream.PupListener ¬ NIL;

  parmFileName: LONG STRING ¬ Indirect.GetParmFileName[];

  firstPassword: LONG POINTER TO PasswordBlock ¬ NIL;
  PasswordBlock: TYPE = RECORD [
    next: LONG POINTER TO PasswordBlock,
    user: LONG STRING,
    encrypted: Password.Encrypted];

  maxServers: CARDINAL = 2;
  servers: CARDINAL ¬ 0;
  scratchFileNumber: CARDINAL ¬ 0;

  tool, msg: Window.Handle ¬ NIL;
  broom: Supervisor.SubsystemHandle = Supervisor.CreateSubsystem[Broom];
  useCount: CARDINAL ¬ 0;
  pleaseStop, running: BOOLEAN ¬ FALSE;

  z: UNCOUNTED ZONE = Heap.systemZone;

  FTPServerOn: PUBLIC ENTRY PROCEDURE =
    BEGIN
    IF (useCount ¬ useCount + 1) = 1 THEN
      BEGIN
      Supervisor.AddDependency[client: broom, implementor: Event.aboutToSwap];
      running ¬ TRUE;
      Starter[];
      END;
    UpdatePicture[];
    END;

  Starter: PROCEDURE =
    BEGIN
    pleaseStop ¬ FALSE;
    Announce["Starting "L, herald];
    FindParameters[];
    CreateListener[];
    END;

  FindParameters: PROCEDURE =
    BEGIN
    cmFile: CmFile.Handle;
    Option: TYPE = MACHINE DEPENDENT{
      myGroup(0), password, noMatch(StringLookUp.noMatch)};
    DefinedOption: TYPE = Option [myGroup..password];
    CheckType: PROCEDURE [h: CmFile.Handle, table: StringLookUp.TableDesc]
      RETURNS [index: CARDINAL] = Indirect.NextValue;
    MyNextValue: PROCEDURE [
      h: CmFile.Handle,
      table: LONG DESCRIPTOR FOR ARRAY DefinedOption OF LONG STRING]
      RETURNS [index: Option] = LOOPHOLE[CheckType];
    optionTable: ARRAY DefinedOption OF LONG STRING ¬ [
      myGroup: "My Group"L,
      password: "Password"L];
    myGroup ¬ String.CopyToNewString[parmFileName, z];
    FOR i: CARDINAL DECREASING IN [0..myGroup.length) DO
      IF myGroup[i] = '. THEN myGroup.length ¬ i; ENDLOOP;
    BEGIN
    builtin: ARRAY [0..8) OF WORD = [
      172427B, 11553B, 61543B, 113154B, 161500B, 47164B, 173546B, 120250B];
    firstPassword ¬ z.NEW[PasswordBlock];
    firstPassword­ ¬ [NIL, String.CopyToNewString["Magic"L, z], LOOPHOLE[builtin]];
    END;
    cmFile ¬ Indirect.OpenSection["FTPServer"L];
    IF cmFile = NIL THEN RETURN;  -- Nothing needed, so don't complain.
    DO
      option: Option;
      option ¬ MyNextValue[cmFile, DESCRIPTOR[optionTable] !
        CmFile.TableError =>
          BEGIN
	  IF name[0] # '; THEN Message["Unrecognized parameter: ", name];
	  RETRY;
	  END];
      SELECT option FROM
        noMatch => EXIT;
        myGroup =>
          BEGIN
          z.FREE[@myGroup];
          myGroup ¬ Token.Item[cmFile, FALSE];
          Message["My Group for FTP passwords is "L, myGroup];
          END;
        password =>
          BEGIN
          user: LONG STRING;
          pwd: STRING = [8*8];
          e: Password.Encrypted;
          p: POINTER ¬ @e;
          temp: LONG POINTER TO PasswordBlock;
          user ¬ Token.Item[cmFile];
          FOR i: CARDINAL IN [0..SIZE[Password.Encrypted]) DO
            (p + i)­ ¬ Token.Octal[cmFile]; ENDLOOP;
          FOR i: CARDINAL IN [0..SIZE[Password.Encrypted]) DO
            IF i # 0 THEN String.AppendChar[pwd, ' ];
            String.AppendNumber[pwd, (p + i)­, 8];
            ENDLOOP;
          temp ¬ z.NEW[PasswordBlock ¬ [firstPassword, user, e]];
          firstPassword ¬ temp;
          Message["FTP's Password for "L, user, " is "L, pwd];
          END;
        ENDCASE => ERROR;
      ENDLOOP;
    Indirect.Close[cmFile];
    END;

  ForgetParameters: PROCEDURE =
    BEGIN
    UNTIL firstPassword = NIL DO
      temp: LONG POINTER TO PasswordBlock ¬ firstPassword;
      firstPassword ¬ firstPassword.next;
      z.FREE[@temp.user];
      z.FREE[@temp];
      ENDLOOP;
    z.FREE[@myGroup];
    END;

  FTPServerOff: PUBLIC ENTRY PROCEDURE =
    BEGIN
    IF useCount # 0 AND (useCount ¬ useCount - 1) = 0 THEN
      BEGIN
      running ¬ FALSE;
      Stopper[];
      Supervisor.RemoveDependency[client: broom, implementor: Event.aboutToSwap];
      END;
    END;

  StopperLocked: ENTRY PROCEDURE = INLINE {Stopper[]};
  Stopper: INTERNAL PROCEDURE =
    BEGIN
    pause: CONDITION ¬ [timeout: Process.SecondsToTicks[1]];
    pleaseStop ¬ TRUE;
    UNTIL servers = 0 DO WAIT pause; ENDLOOP;
    DestroyListener[];
    ForgetParameters[];
    Announce["Killed "L, herald];
    END;

  UpdatePicture: PROCEDURE = BEGIN END;

  CreateListener: PROCEDURE =
    BEGIN
    IF pupListener # NIL THEN RETURN;
    [] ¬ PupStream.PupPackageMake[];
    pupListener ¬ PupStream.CreatePupByteStreamListener[
      local: [0, 3], proc: CreateSTPServer, ticks: PupStream.SecondsToTocks[3*60],
      filter: CheckConnectionRequest];
    END;

  DestroyListener: PROCEDURE =
    BEGIN
    IF pupListener # NIL THEN
      BEGIN
      PupStream.DestroyPupListener[pupListener];
      PupStream.PupPackageDestroy[];
      pupListener ¬ NIL;
      END;
    END;

  CheckConnectionRequest: ENTRY PROCEDURE [address: PupStream.PupAddress] =
    BEGIN ENABLE UNWIND => NULL;
    IF pleaseStop THEN
      ERROR PupStream.RejectThisRequest["Sorry, we are trying to go away"];
    IF servers = maxServers THEN
      ERROR PupStream.RejectThisRequest["Sorry, we are full now"];
    servers ¬ servers + 1;
    END;

  DecrementConnections: ENTRY PROCEDURE =
    BEGIN
    servers ¬ servers - 1;
    END;
    
  CreateSTPServer: PROCEDURE [byteStream: Stream.Handle, address: PupStream.PupAddress] =
    BEGIN  -- this guy gets FORKed for every accepted RFC
    hostName: STRING = [50];
    buffer: STRING = [200];
    Write: Format.StringProc =
      BEGIN
      FOR i: CARDINAL IN [0..s.length) DO
        char: CHARACTER ¬ s[i];
	SELECT TRUE FROM
	  buffer.length = buffer.maxlength =>
	    BEGIN
	    Announce[buffer, NIL];
	    buffer.length ¬ 0;
	    String.AppendChar[buffer, char];
	    END;
	  char = Ascii.CR =>
	    BEGIN
	    Announce[buffer, NIL];
	    buffer.length ¬ 0;
	    END;
	  ENDCASE => String.AppendChar[buffer, char];
        ENDLOOP;
      END;
    Approval: STPExtra.ApprovalProc =
      BEGIN
      user: LONG STRING = STP.GetProperty[stp, userName];
      password: LONG STRING = STP.GetProperty[stp, userPassword];
IF FALSE THEN -- Barf.  Property list has been flused for retrieve and delete
      IF user = NIL THEN ERROR STPExtra.Denied["Name missing"L];
      SELECT action FROM
        retrieve => AnnounceFor["Retrieving "L, name, user, hostName];
        store =>
          BEGIN
	  AnnounceFor["Storing "L, name, user, hostName];
          InspectCredentials[user, password];
	  END;
        delete =>
          BEGIN
	  AnnounceFor["Deleting "L, name, user, hostName];
          InspectCredentials[user, password];
	  END;
        rename =>
          BEGIN
	  AnnounceFor["Renaming "L, name, user, hostName];
          InspectCredentials[user, password];
	  END;
        list => AnnounceFor["Listing "L, name, user, hostName];
        ENDCASE => ERROR;
      END;
    PupDefs.AppendHostName[hostName, address];
    STPExtra.Server[byteStream, hostName, Write, Approval ! ABORTED => CONTINUE];
    Stream.Delete[byteStream];
    DecrementConnections[];
    END;

  InspectCredentials: PROCEDURE [user, password: LONG STRING] =
    BEGIN
    registry: STRING = [100];
    CopyRegistry: PROCEDURE [s: LONG STRING] = BEGIN String.AppendString[registry, s]; END;
    Profile.GetDefaultRegistry[CopyRegistry];
    IF user = NIL OR password = NIL THEN
      ERROR STPExtra.Denied["Name or Password missing"L];
    -- check passwords from parameter file
    FOR finger: LONG POINTER TO PasswordBlock ¬ firstPassword, finger.next UNTIL
      finger = NIL DO
      IF String.Equivalent[finger.user, user] THEN
        BEGIN
        matched: BOOLEAN ¬ Password.Check[password, finger.encrypted];
        IF matched THEN RETURN
        ELSE ERROR STPExtra.Denied["Password rejected by info from parameter file"L];
        END;
      ENDLOOP;
    -- try Grapevine if that fails
    IF myGroup = NIL THEN
      ERROR STPExtra.Denied["Don't know our Grapevine group"L]
    ELSE
      BEGIN
      luser: LONG STRING ¬ MaybeAppend[user, registry];
      machine: LONG STRING ¬ MaybeAppend[myGroup, "internet"L];
      status: Password.Status;
      status ¬ Password.ValidMemberOfGroup[luser, password, machine];
      z.FREE[@machine];
      z.FREE[@luser];
      SELECT status FROM
        yes => NULL;
        nil => ERROR STPExtra.Denied["Confusion about NIL"L];
        allDown =>
          ERROR STPExtra.Denied["All Grapevine servers appear to be down"L];
        notFound =>
          ERROR STPExtra.Denied["Grapevine doesn't like your name"L];
        badPwd =>
          ERROR STPExtra.Denied["Grapevine doesn't like your password"L];
        group =>
          ERROR STPExtra.Denied["Grapevine thinks you are a group"L];
        no =>
          ERROR STPExtra.Denied["You are not in the appropriate group"L];
        notGroup =>
          ERROR STPExtra.Denied["Grapevine doesn't recognize this machine's group"L];
        error =>
          ERROR STPExtra.Denied["Error from GrapevineUser package"L];
        ENDCASE => ERROR;
      END;
    END;

  MaybeAppend: PROCEDURE [string, tail: LONG STRING] RETURNS [new: LONG STRING] =
    BEGIN
    IF tail = NIL THEN RETURN[String.CopyToNewString[string, z]];
    FOR i: CARDINAL IN [0..string.length) DO
      IF string[i] = '. THEN RETURN[String.CopyToNewString[string, z]]; ENDLOOP;
    new ¬ String.CopyToNewString[string, z, 1 + tail.length];
    String.AppendChar[new, '.];
    String.AppendString[new, tail];
    END;


  Announce: PROCEDURE [one, two: LONG STRING] =
    BEGIN OPEN String;
    text: STRING = [200];
    Time.AppendCurrent[text];
    AppendString[text, "  "L];
    AppendString[text, one];
    AppendString[text, two];
    LogString[text];
    END;

  AnnounceFor: PROCEDURE [one, two: LONG STRING, who, where: LONG STRING] =
    BEGIN OPEN String;
    text: STRING = [200];
    Time.AppendCurrent[text];
    AppendString[text, "  "L];
    AppendString[text, one];
    AppendString[text, two];
    AppendString[text, " for "L];
    AppendString[text, who];
    AppendString[text, " on "L];
    AppendString[text, where];
    LogString[text];
    END;

  Message: PROCEDURE [one, two, three, four: LONG STRING ¬ NIL] =
    BEGIN
    text: STRING = [100];
    String.AppendString[text, one];
    IF two # NIL THEN String.AppendString[text, two];
    IF three # NIL THEN String.AppendString[text, three];
    IF four # NIL THEN String.AppendString[text, four];
    LogString[text];
    END;

  LogString: PROCEDURE [text: LONG STRING] =
    BEGIN
    String.AppendChar[text, '.];
    String.AppendChar[text, Ascii.CR];
    Put.Text[NIL, text];
    IF msg # NIL THEN Put.Text[msg, text];
    END;

  MakeSWs: Tool.MakeSWsProc =
    BEGIN msg ¬ Tool.MakeMsgSW[window: window, lines: 5]; END;

  ClientTransition: ToolWindow.TransitionProcType =
    BEGIN IF new = inactive THEN msg ¬ NIL; END;

  restarting: BOOLEAN ¬ FALSE;
  Restart: ENTRY PROCEDURE = BEGIN Stopper[]; restarting ¬ FALSE; Starter[]; END;

  Broom: Supervisor.AgentProcedure =
    BEGIN
    SELECT event FROM
      EventTypes.aboutToBoot, EventTypes.aboutToBootPhysicalVolume =>
        IF running THEN StopperLocked[];
      ENDCASE => NULL;
    END;

  -- Initialization
  tool ¬ Tool.Create[
    name: herald, makeSWsProc: MakeSWs, clientTransition: ClientTransition];
  FTPServerOn[];
  END.