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