-- Copyright (C) 1981, 1984, 1985  by Xerox Corporation. All rights reserved. 
-- LocalName.mesa - R-Name of this registration or mail server

-- HGM, 15-Sep-85  4:24:11
-- Randy Gobbel		19-May-81 22:32:55 --
-- Andrew Birrell	17-Mar-81 15:06:46 --

DIRECTORY
  Ascii,
  BodyDefs USING [maxRNameLength, RName],
  Heap USING [systemMDSZone, systemZone],
  HeapDefs USING [
    HeapEndRead, HeapEndWrite, HeapStartRead, HeapStartWrite, HeapReadData,
    HeapReadRName, HeapWriteData, HeapWriteRName, HeapWriteString, ReaderHandle,
    WriterHandle],
  IODefs,
  LocalNameDefs USING [],
  LocateDefs USING [FindLocalServer, FindRegServer, FoundServerInfo],
  NameInfoDefs USING [Authenticate, GetConnect, NameType],
  ObjectDirDefs USING [Enumerate, FreeObject, noObject, ObjectNumber, UseObject],
  ProtocolDefs,
  PupDefs USING [
    AppendPupAddress, GetPupAddress, PupAddress, PupNameTrouble, PupSocketID],
  String USING [AppendString, EquivalentString, WordsForString];

LocalName: MONITOR [initHeap: BOOLEAN] LOCKS info USING info: LONG POINTER TO NameInfo
  IMPORTS
    Heap, HeapDefs, IODefs, LocateDefs, NameInfoDefs, ObjectDirDefs, ProtocolDefs,
    PupDefs, String
  EXPORTS LocalNameDefs =
  BEGIN

  OPEN IODefs;

  NameInfo: TYPE = MONITORED RECORD [
    name: BodyDefs.RName ¬ NIL,
    password: LONG STRING ¬ NIL,
    key: ProtocolDefs.Password,
    known: BOOLEAN ¬ FALSE];

  MSInfo: LONG POINTER TO NameInfo ¬ Heap.systemZone.NEW[NameInfo];

  RSInfo: LONG POINTER TO NameInfo ¬ Heap.systemZone.NEW[NameInfo];

  ReadMSName: PUBLIC PROCEDURE
    RETURNS [name: BodyDefs.RName, password: LONG STRING, key: ProtocolDefs.Password] =
    {[name, password, key] ¬ ReadName[MSInfo]};

  ReadRSName: PUBLIC PROCEDURE
    RETURNS [name: BodyDefs.RName, password: LONG STRING, key: ProtocolDefs.Password] =
    {[name, password, key] ¬ ReadName[RSInfo]};

  ReadName: PROC [info: LONG POINTER TO NameInfo]
    RETURNS [name: BodyDefs.RName, password: LONG STRING, key: ProtocolDefs.Password] =
    BEGIN
    IF PossiblyFindName[info] THEN CheckConnect[info]
    --this call must be outside the monitor-- ;
    RETURN[info.name, info.password, info.key]
    END;

  PossiblyFindName: ENTRY PROC [info: LONG POINTER TO NameInfo]
    RETURNS [first: BOOLEAN] = {
    first ¬ NOT info.known; IF first THEN FindName[info]};

  BadHeapNameObject: SIGNAL = CODE;

  FindName: INTERNAL PROC [info: LONG POINTER TO NameInfo] =
    BEGIN
    which: {mail, reg} = IF info = MSInfo THEN mail ELSE reg;
    changed: BOOLEAN ¬ FALSE;
    oldObj: ObjectDirDefs.ObjectNumber ¬ ObjectDirDefs.noObject;
    text: STRING = IF which = reg THEN "R-Server"L ELSE "M-Server"L;
    FindObject: PROCEDURE [obj: ObjectDirDefs.ObjectNumber] RETURNS [BOOLEAN] =
      BEGIN
      reader: HeapDefs.ReaderHandle = HeapDefs.HeapStartRead[obj];
      Read: PROCEDURE [to: LONG POINTER, amount: CARDINAL] =
        BEGIN
        used: CARDINAL;
        [, used] ¬ HeapDefs.HeapReadData[reader, [to, amount]];
        IF used # amount THEN
          BEGIN SIGNAL BadHeapNameObject[]; info.known ¬ FALSE END;
        END;
      temp: STRING = [0];
      info.known ¬ TRUE;
      [] ¬ HeapDefs.HeapReadRName[reader, info.name];
      Read[temp, String.WordsForString[0]];
      IF temp.length > info.password.maxlength THEN
        BEGIN SIGNAL BadHeapNameObject[]; info.known ¬ FALSE END;
      info.password.length ¬ temp.length;
      Read[
        @(info.password.text),
        String.WordsForString[info.password.length] - String.WordsForString[0]];
      Read[@(info.key), SIZE[ProtocolDefs.Password]];
      HeapDefs.HeapEndRead[reader];
      IF info.known THEN {
        ObjectDirDefs.UseObject[oldObj ¬ obj]; RETURN[TRUE] -- terminate -- }
      ELSE RETURN[FALSE]  --keep going--
      END;
    AskOthers: INTERNAL PROCEDURE =
      BEGIN
      info.name.length ¬ 0;
      WriteLine["Consulting registration servers ... "L];
      SELECT LocateDefs.FindLocalServer[
      IF which = reg THEN "GV.GV"L ELSE "MailDrop.MS"L, info.name] FROM
        allDown => WriteLine["all down"L];
        notFound => WriteLine["no local name found"L];
        found => info.known ¬ TRUE;
        ENDCASE => ERROR;
      IF NOT info.known THEN
        BEGIN
        ConfirmSystem[];
        String.AppendString[info.name, "Anon.GV"L];
        info.known ¬ TRUE;
        END;
      WriteString["My "L];
      WriteString[text];
      WriteString[" name appears to be "L];
      WriteLine[info.name];
      WriteString["If you are certain the name is correct, type my password: "L];
      info.key ¬ ReadPassword[info.password];
      WriteLine[""L];
      changed ¬ TRUE;
      END;
    info.name ¬ Heap.systemMDSZone.NEW[StringBody[BodyDefs.maxRNameLength]];
    info.password ¬ Heap.systemZone.NEW[StringBody[32]];
    [] ¬ ObjectDirDefs.Enumerate[
      IF which = reg THEN RSname ELSE MSname, FindObject];
    IF NOT info.known THEN
      BEGIN
      WriteString["No "];
      WriteString[text];
      WriteLine[" name is recorded in the heap"L];
      IF NOT initHeap THEN ConfirmSystem[]
      END
    ELSE
      BEGIN
      WriteString[text];
      WriteString[" name recorded in the heap is "L];
      WriteLine[info.name];
      END;
    DO
      UNTIL info.known DO AskOthers[]; ENDLOOP;
      SELECT NameInfoDefs.Authenticate[info.name, info.password] FROM
        individual => EXIT;
        notFound, group =>
          BEGIN
          WriteString[text];
          WriteLine[" name is not valid"L];
          ConfirmSystem[];
          info.known ¬ FALSE;
          END;
        allDown =>
          BEGIN
          WriteString["No authentication server available"L];
          ConfirmSystem[];
          EXIT
          END;
        badPwd =>
          BEGIN
          WriteString["My password is incorrect; please re-type it: "L];
          info.key ¬ ReadPassword[info.password];
          WriteLine[""L];
          changed ¬ TRUE;
          END;
        ENDCASE => ERROR;
      ENDLOOP;
    IF changed THEN
      BEGIN  -- create the heap object --
      writer: HeapDefs.WriterHandle = HeapDefs.HeapStartWrite[
        IF which = reg THEN RSname ELSE MSname];
      Keep: PROCEDURE [obj: ObjectDirDefs.ObjectNumber] =
        BEGIN ObjectDirDefs.UseObject[obj]; END;
      HeapDefs.HeapWriteRName[writer, info.name];
      HeapDefs.HeapWriteString[writer, info.password];
      HeapDefs.HeapWriteData[writer, [@(info.key), SIZE[ProtocolDefs.Password]]];
      HeapDefs.HeapEndWrite[writer, Keep];
      IF oldObj # ObjectDirDefs.noObject THEN ObjectDirDefs.FreeObject[oldObj];
      END;
    END;

  system: BOOLEAN ¬ FALSE;

  ConfirmSystem: PROCEDURE =
    BEGIN
    -- In principle, we should keep only a one-way function of the
    -- system password in this source (e.g. [0,0,0,0] encrypted with the
    -- system password), and then check for equality with what the user
    -- types.  In practice, the system password is only there to prevent
    -- idiots messing up the system in some error cases (when the idiot
    -- has physical access to the computer), so proper security isn't
    -- worth the trouble.
    sysPwd: STRING = "Botrytis"L;
    hisAttempt: STRING = [32];
    IF system THEN
      BEGIN
      WriteString["Continue? [confirm] "L];
      UNTIL
        SELECT IODefs.ReadChar[] FROM Ascii.CR, 'y, 'Y => TRUE, ENDCASE => FALSE
        DO NULL ENDLOOP;
      WriteLine["yes"L];
      END
    ELSE
      DO
        WriteLine["*****"L];
        WriteLine["*****  Something horrible has happened."L];
        WriteLine["*****  You should probably consult a Wizard."L];
        WriteLine["*****"L];
        WriteString["Type the system password to continue: "L];
        [] ¬ ReadPassword[hisAttempt];
        IF String.EquivalentString[hisAttempt, sysPwd] THEN {
          system ¬ TRUE; WriteLine[" ... ok"L]; EXIT}
        ELSE WriteLine[" ... incorrect"L];
        ENDLOOP;
    END;

  ReadPassword: PROCEDURE [pwd: LONG STRING] RETURNS [key: ProtocolDefs.Password] =
    BEGIN
    pwd.length ¬ 0;
    DO
      BEGIN
      c: CHARACTER = IODefs.ReadChar[];
      SELECT c FROM
        Ascii.SP, Ascii.TAB, Ascii.CR, Ascii.ESC => EXIT;
        Ascii.BS, Ascii.ControlA =>
          IF pwd.length > 0 THEN
            BEGIN pwd.length ¬ pwd.length - 1; WriteChar[Ascii.BS]; END;
        ENDCASE =>
          IF pwd.length < pwd.maxlength THEN
            BEGIN
            pwd[pwd.length] ¬ c;
            pwd.length ¬ pwd.length + 1;
            WriteChar['*];
            END;
      END;
      ENDLOOP;
    RETURN[ProtocolDefs.MakeKey[pwd]]
    END;

  FindConnect: PROCEDURE [
    name: BodyDefs.RName, addr: POINTER TO PupDefs.PupAddress] RETURNS [BOOLEAN] =
    BEGIN
    connect: ProtocolDefs.Connect = [ProtocolDefs.maxConnectLength];
    info: NameInfoDefs.NameType = NameInfoDefs.GetConnect[name, connect];
    SELECT info FROM
      individual =>
        PupDefs.GetPupAddress[
          addr, connect ! PupDefs.PupNameTrouble => GOTO couldnt];
      ENDCASE => GOTO couldnt;
    RETURN[TRUE];
    EXITS couldnt => RETURN[FALSE];
    END;

  SetConnectLocal: PROCEDURE [
    name: BodyDefs.RName, key: ProtocolDefs.Password, socket: PupDefs.PupSocketID]
    RETURNS [BOOLEAN] =
    BEGIN
    info: LocateDefs.FoundServerInfo;
    str: ProtocolDefs.Handle ¬ NIL;
    Action: PROCEDURE [serverAddr: PupDefs.PupAddress] RETURNS [BOOLEAN] =
      BEGIN
      ENABLE ProtocolDefs.Failed => GOTO no;
      serverAddr.socket ¬ ProtocolDefs.RegServerEnquirySocket;
      str ¬ ProtocolDefs.CreateStream[serverAddr];
      RETURN[TRUE];
      EXITS no => RETURN[FALSE]
      END;
    info ¬ LocateDefs.FindRegServer[name, Action];
    IF str = NIL THEN GOTO couldnt;
    BEGIN
    ENABLE ProtocolDefs.Failed => GOTO badAnswer;
    rc: ProtocolDefs.ReturnCode;
    myAddr: PupDefs.PupAddress;
    connect: ProtocolDefs.Connect = [ProtocolDefs.maxConnectLength];
    PupDefs.GetPupAddress[@myAddr, "ME"L];
    myAddr.socket ¬ socket;
    PupDefs.AppendPupAddress[connect, myAddr];
    ProtocolDefs.SendRSOperation[str, IdentifyCaller];
    ProtocolDefs.SendRName[str, name];
    ProtocolDefs.SendPassword[str: str, pw: key, key: [0, 0, 0, 0]];
    ProtocolDefs.SendNow[str];
    rc ¬ ProtocolDefs.ReceiveRC[str];
    IF rc.code # done THEN GOTO badAnswer;
    ProtocolDefs.SendRSOperation[str, ChangeConnect];
    ProtocolDefs.SendRName[str, name];
    ProtocolDefs.SendConnect[str, connect];
    ProtocolDefs.SendNow[str];
    rc ¬ ProtocolDefs.ReceiveRC[str];
    IF rc.code # done THEN GOTO badAnswer;
    EXITS badAnswer => BEGIN ProtocolDefs.DestroyStream[str]; GOTO couldnt END;
    END;
    ProtocolDefs.DestroyStream[str];
    RETURN[TRUE];
    EXITS couldnt => RETURN[FALSE];
    END;

  CheckConnect: PROC [info: LONG POINTER TO NameInfo] =
    BEGIN
    which: {mail, reg} = IF info = MSInfo THEN mail ELSE reg;
    name: LONG STRING = ReadName[info].name;
    key: ProtocolDefs.Password = ReadName[info].key;
    foundAddr: PupDefs.PupAddress;
    IF NOT FindConnect[name, @foundAddr] OR NOT ProtocolDefs.IsLocal[foundAddr]
      OR
        (foundAddr.socket #
          (IF which = reg THEN ProtocolDefs.RegServerPollingSocket
           ELSE ProtocolDefs.mailServerPollingSocket)) THEN
      BEGIN
      WriteString["Re-setting my "L];
      WriteString[IF which = mail THEN "M-Server"L ELSE "R-Server"L];
      WriteString[" connect-site ... "L];
      IF SetConnectLocal[
        name, key,
        IF which = reg THEN ProtocolDefs.RegServerPollingSocket
        ELSE ProtocolDefs.mailServerPollingSocket] THEN WriteLine["done"L]
      ELSE BEGIN WriteLine["couldn't"L]; ConfirmSystem[]; END;
      END;
    END;


  END.