-- Transport Mechanism - R-Name of this registration or mail server --

-- [Juniper]<DMS>MS>LocalName.mesa

-- Randy Gobbel		19-May-81 22:32:55 --
-- Andrew Birrell	17-Mar-81 15:06:46 --

DIRECTORY
Ascii,
BodyDefs	USING[ maxRNameLength, RName ],
HeapDefs	USING[ HeapEndRead, HeapEndWrite, HeapStartRead,
		       HeapStartWrite, HeapReadData, HeapReadRName,
		       HeapWriteData, HeapWriteRName,
		       HeapWriteString, ReaderHandle,
		       WriterHandle ],
IODefs,
LocalNameDefs --EXPORT only--,
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 ],
Storage	USING[ String ],
String	USING[ AppendString, EquivalentString, WordsForString];

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

OPEN IODefs;

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

MSInfo: NameInfo _ [ name: NIL,
                     password: NIL,
                     key:,
                     known: FALSE ];

RSInfo: NameInfo _ [ name: NIL,
                     password: NIL,
                     key:,
                     known: FALSE ];

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

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

ReadName: PROC[info: POINTER TO NameInfo]
       RETURNS[name: BodyDefs.RName,
               password: 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: POINTER TO NameInfo]
                     RETURNS[first: BOOLEAN] = INLINE
   { first _ NOT info.known; IF first THEN FindName[info] };

BadHeapNameObject: SIGNAL = CODE;

FindName: INTERNAL PROC[info: 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: 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 _ Storage.String[BodyDefs.maxRNameLength];
   info.password _ Storage.String[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 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: 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: POINTER TO NameInfo] =
   BEGIN
   which: {mail, reg} = IF info=@MSInfo THEN mail ELSE reg;
   name: 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.