-- Transport Mechanism - Registration server maintenance program --
-- [Indigo]<Grapevine>Maintain>Maintainer.mesa
-- Andrew Birrell, 18-Jan-82 10:15:30
-- Philip Karlton, 25-Aug-81 10:27:04
DIRECTORY
Ascii USING[ CR, DEL ],
BodyDefs USING[ maxRNameLength ],
GlassDefs USING[ Handle, Listen ],
LaurelExecDefs USING[ FlashTypescriptRegion, GetUserCredentials,
MakeMenuCommandCallable ],
MaintainDefs USING[],
MaintainPrivate USING[ AddForward, AddFriend, AddListOfMembers, AddMailbox,
AddOwner, BadConnect, BadName, BadRemark, AddMember,
CantCheckName, Command, Confirm, CopyName,
CreateGroup, CreateIndividual, DeleteGroup,
DeleteIndividual, Handle, HandleObject,
InitializeNewName, ModifyAllOccurrences, Operate,
Parse, ProposeName, ReadWord, RemoveAllMemberships,
RemoveForward, RemoveFriend, RemoveMailbox,
RemoveMember, RemoveOwner, SetConnect,
SetDecimalPassword, SetPassword, SetRemark,
SetServer, TypeAllGroups, TypeDetails, TypeEntry,
TypeMembers, VerifyAllGroups, VerifyGroup,
VerifyName, VerifyOnOff ],
Storage USING[ Free, Node, String ],
NameInfoDefs USING[ AuthenticateKey ],
NameInfoSpecialDefs USING[ CleanUp ],
ProtocolDefs USING[ DestroyStream, Failed, Handle, Init, MakeKey,
RegServerSpareSocket ],
PupDefs USING[ PupPackageDestroy, PupPackageMake],
PupStream USING[ StreamClosing ],
Runtime USING[ IsBound, GetBcdTime ],
Stream USING[ TimeOut ],
String USING[ AppendChar, AppendString,
InvalidNumber, StringBoundsFault ],
Time USING[ Append, Packed, Unpack ];
Maintainer: PROGRAM
IMPORTS GlassDefs, LaurelExecDefs, MaintainPrivate,
Storage, NameInfoDefs,
NameInfoSpecialDefs, ProtocolDefs, PupDefs, PupStream, Runtime,
Stream, String, Time
EXPORTS MaintainDefs, MaintainPrivate =
BEGIN
OPEN BodyDefs, MaintainPrivate, ProtocolDefs;
Stopping: ERROR = CODE;
Quit: PROCEDURE[handle: MaintainPrivate.Handle] =
{ IF Confirm[handle.glass] THEN ERROR Stopping[] };
Login: PROCEDURE[handle: MaintainPrivate.Handle] =
BEGIN
OPEN handle, handle.glass;
authenticated ← FALSE;
glass.WriteChar[Ascii.CR];
ReadWord[glass, "Your Name Please: "L, caller];
FOR i: CARDINAL IN [0..caller.length)
DO IF caller[i] = '. THEN EXIT;
REPEAT FINISHED =>
{ WriteString[" ... name must include a registry"L];
ERROR Failed[] };
ENDLOOP;
glass.WriteChar[Ascii.CR];
IF glass.ReadString["Your Password: "L, callerPwd, pwd] = Ascii.DEL
THEN ERROR Del[];
callerKey ← ProtocolDefs.MakeKey[callerPwd];
IF MaintainPrivate.Operate[handle: handle,
op: IdentifyCaller, name: caller,
key: callerKey ].code = done
THEN authenticated ← TRUE;
END;
TypeVersion: PROC[str: GlassDefs.Handle, version: Time.Packed] =
BEGIN
time: STRING = [25];
Time.Append[time, Time.Unpack[version]];
str.WriteString["Version of "L];
str.WriteString[time]; str.WriteChar[Ascii.CR];
END;
Failed: PUBLIC ERROR = CODE;
Del: PUBLIC ERROR = CODE;
-- Much of the following is confused by the existence of two variants
-- of the Maintain package. The variants supported are:
-- "laurel" => Maintain.bcd running inside Laurel
-- "server" => running as, or inside, a TelNet server, or inside Cascade
variant: { laurel, server } =
SELECT TRUE FROM
Runtime.IsBound[LaurelExecDefs.FlashTypescriptRegion] => laurel,
ENDCASE => server;
DoIt: PUBLIC PROCEDURE[str: GlassDefs.Handle, user, userPwd: STRING] =
BEGIN
OPEN str;
handle: MaintainPrivate.Handle =
Storage.Node[SIZE[MaintainPrivate.HandleObject]];
FreeHandle: PROC =
BEGIN
IF handle.str # NIL THEN ProtocolDefs.DestroyStream[handle.str];
Storage.Free[handle.caller];
Storage.Free[handle.callerPwd];
Storage.Free[handle.name];
Storage.Free[handle.individual];
Storage.Free[handle.group];
Storage.Free[handle.dName];
Storage.Free[handle];
END;
handle↑ ← [
str: NIL,
serverAddr: ,
addrKnown: FALSE,
caller: Storage.String[BodyDefs.maxRNameLength],
callerPwd: Storage.String[16],
callerKey: ,
authenticated: FALSE,
verifying: TRUE,
name: Storage.String[BodyDefs.maxRNameLength],
individual: Storage.String[BodyDefs.maxRNameLength],
group: Storage.String[BodyDefs.maxRNameLength],
dName: Storage.String[BodyDefs.maxRNameLength],
glass: str];
IF userPwd # NIL THEN CopyName[from:userPwd, to:handle.callerPwd];
IF user # NIL THEN CopyName[from:user, to:handle.caller];
DoItWithHandle[handle ! UNWIND => FreeHandle[] ];
FreeHandle[];
END;
DoItWithHandle: PROC[handle: MaintainPrivate.Handle] =
BEGIN
OPEN handle.glass;
commands: ARRAY [0..33) OF MaintainPrivate.Command ← [
["Add Forwarding"L, AddForward],
["Add Friend"L, AddFriend],
["Add List of members"L, AddListOfMembers],
["Add Mailbox"L, AddMailbox],
["Add Member"L, AddMember],
["Add Owner"L, AddOwner],
["Create Group"L, CreateGroup],
["Create Individual"L, CreateIndividual],
["Delete Group"L, DeleteGroup],
["Delete Individual"L, DeleteIndividual],
["Initialize New Name"L, InitializeNewName],
["Login"L, Login],
["Modify All Occurrences"L, ModifyAllOccurrences],
["Quit"L, Quit],
["Remove All Memberships"L, RemoveAllMemberships],
["Remove Friend"L, RemoveFriend],
["Remove Forwarding"L, RemoveForward],
["Remove Mailbox"L, RemoveMailbox],
["Remove Member"L, RemoveMember],
["Remove Owner"L, RemoveOwner],
["Set Connect-site"L, SetConnect],
["Set Decimal Password"L, SetDecimalPassword],
["Set Password"L, SetPassword],
["Set Remark"L, SetRemark],
["Set Server"L, SetServer],
["Type All Groups"L, TypeAllGroups],
["Type Details"L, TypeDetails],
["Type Entry"L, TypeEntry],
["Type Members"L, TypeMembers],
["Verify All Groups"L, VerifyAllGroups],
["Verify Group"L, VerifyGroup],
["Verify Name"L, VerifyName],
["Verify on/off", VerifyOnOff]
];
WriteChar[Ascii.CR];
WriteString["Grapevine Registration Server Maintenance Program"L];
WriteChar[Ascii.CR];
IF Runtime.IsBound[Runtime.GetBcdTime]
THEN TypeVersion[handle.glass, Runtime.GetBcdTime[]]
ELSE { WriteString["Version unknown"L]; WriteChar[Ascii.CR] };
IF variant = laurel THEN SetLocalDefaults[handle];
handle.callerKey ← ProtocolDefs.MakeKey[handle.callerPwd];
CopyName[from:handle.caller, to: handle.dName];
CopyName[from:handle.caller, to: handle.individual];
CopyName[from:handle.caller, to: handle.name];
IF handle.caller.length # 0 AND handle.callerPwd.length # 0
THEN BEGIN
WriteString["Login "L];
WriteString[handle.caller];
WriteString[" ... "L]; SendNow[];
IF NameInfoDefs.AuthenticateKey[handle.caller, handle.callerKey]
= individual
THEN { WriteString["done"L]; handle.authenticated←TRUE };
END;
IF NOT handle.authenticated
THEN WriteString["You are not logged in yet"L];
WriteChar[Ascii.CR];
DO BEGIN
ENABLE
-- CONTINUE produces screen flash; RETRY doesn't.
BEGIN
Del =>
{ Flush[]; WriteString[" XXX"L]; GOTO CloseStream };
String.InvalidNumber =>
{ WriteString[" ... invalid number"L]; CONTINUE };
String.StringBoundsFault =>
{ WriteString[" ... string too long"L]; CONTINUE };
BadRemark =>
BEGIN
WriteString[" ... illegal character in remark"L];
CONTINUE
END;
BadName =>
IF handle.verifying
THEN BEGIN
WriteString[" ... """L];
WriteString[bad];
WriteString[""" is not a valid name."L];
MaintainPrivate.ProposeName[handle, bad, either];
CONTINUE
END
ELSE { WriteString[" (bad name)"L]; RESUME };
CantCheckName =>
IF handle.verifying
THEN BEGIN
WriteString[" ... can't verify name - server down"L];
CONTINUE
END
ELSE { WriteString[" (can't verify)"L]; RESUME };
BadConnect =>
IF handle.verifying
THEN BEGIN
WriteString[" ... not a host name or address"L];
CONTINUE
END
ELSE { WriteString[" (bad connect)"L]; RESUME };
Stream.TimeOut, PupStream.StreamClosing, ProtocolDefs.Failed =>
BEGIN
WriteString["communication failure - please re-try"L];
IF variant = laurel THEN LaurelExecDefs.FlashTypescriptRegion[];
GOTO CloseStream
END;
Stopping => EXIT;
Failed => CONTINUE -- command produced error message --;
END;
MaintainPrivate.Parse[handle, DESCRIPTOR[commands], "GV: "L];
EXITS CloseStream =>
BEGIN
SendNow[];
IF handle.str # NIL THEN ProtocolDefs.DestroyStream[handle.str];
handle.str ← NIL;
LOOP -- don't flash --
END;
END;
IF variant = laurel THEN LaurelExecDefs.FlashTypescriptRegion[];
ENDLOOP;
WriteChar[Ascii.CR];
END;
SetLocalDefaults: PROC[handle: MaintainPrivate.Handle] =
BEGIN
-- used for variant=laurel--
OPEN handle;
registry: STRING = [BodyDefs.maxRNameLength];
LaurelExecDefs.GetUserCredentials[caller, callerPwd, registry];
BEGIN
ENABLE String.StringBoundsFault => CONTINUE;
String.AppendChar[caller, '.];
String.AppendString[caller, registry];
END;
LaurelExecDefs.MakeMenuCommandCallable[newMail];
LaurelExecDefs.MakeMenuCommandCallable[mailFile];
LaurelExecDefs.MakeMenuCommandCallable[display];
LaurelExecDefs.MakeMenuCommandCallable[delete];
LaurelExecDefs.MakeMenuCommandCallable[undelete];
LaurelExecDefs.MakeMenuCommandCallable[moveTo];
LaurelExecDefs.MakeMenuCommandCallable[copy];
END;
ListenerWork: PROC[str: GlassDefs.Handle] =
{ DoIt[str, NIL, NIL] };
PupDefs.PupPackageMake[]; ProtocolDefs.Init[];
IF variant = laurel
THEN GlassDefs.Listen[ListenerWork, ProtocolDefs.RegServerSpareSocket];
NameInfoSpecialDefs.CleanUp[];
PupDefs.PupPackageDestroy[];
END.