-- 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.