
<<SMTPControlImpl.mesa>>
    <<Last Edited by: HGM, April 25, 1985 1:39:19 am PST>>
    <<Last Edited by: DCraft, December 21, 1983 1:30 pm>>
    <<Last Edited by: Taft, February 4, 1984 3:23:54 pm PST>>
    <<John Larson, July 26, 1987 5:50:44 pm PDT>>
DIRECTORY
BasicTime USING [GMT, UnpackedPeriod, Period, UnpackPeriod, Now],
Commander USING [CommandProc, Register],
CommandTool USING [NextArgument],
Convert USING [IntFromRope],
EditedStream USING [Rubout],
GVBasics USING [MakeKey, Password],
GVNames USING [AuthenticateInfo, AuthenticateKey, IsInList, Membership],
IO USING [EndOf, EndOfStream, Error, GetID, GetIndex, GetInt, GetLineRope, GetTokenRope, IDProc, PutChar, PutRope, PutF, Reset, 
RIS, SkipWhitespace, STREAM, int, time],
Process USING [Detach],
Rope USING [Cat, Equal, ROPE, Substr],
UserCredentials USING [Get],
ViewerIO USING [CreateViewerStreams],
IPDefs USING [DByte],
IPReassembly USING [single, arrived, merged, finished, died, bad],
IPRouter USING [SetStateChangeProc],
SMTPControl USING [AccessControlList, NoLoggedInUser],
SMTPDescr USING [Descr, EnumerateInitialItems, InitialItemProc],
SMTPGVRcvr USING [Error, Finalize, Initialize],
SMTPSend USING [totalArpaMsgsSent, totalArpaBytesSent],
SMTPGVSend USING [totalGvMsgsSent, totalGvBytesSent],
SMTPQueue USING [AddNewMessage, CountQueue, CountMessages, PrintItem, PrintQueue, SetExpressOK, StartServer],
SMTPRcvr USING [Error, Finalize, Initialize],
SMTPSupport USING [currentLogAcceptPriority, Log, LogPriority, logPriorityNames],
TCPOps USING [pktsSent, pktsRcvd, pktsRexmitted, pktsDuplicate, pktsWithNoConnection, pktsFromFuture, pktsFromPast, 
pktsWithBadChecksum];
SMTPControlImpl: CEDAR PROGRAM
IMPORTS
BasicTime, Commander, CommandTool, Convert, EditedStream, GVBasics, GVNames, IO, Process, Rope, UserCredentials, ViewerIO,
IPReassembly, IPRouter, SMTPControl, SMTPDescr, SMTPGVRcvr, SMTPGVSend, SMTPSend, SMTPQueue, SMTPRcvr, SMTPSupport, TCPOps
EXPORTS SMTPControl =
BEGIN
ROPE: TYPE = Rope.ROPE;
STREAM: TYPE = IO.STREAM;
Descr: TYPE = SMTPDescr.Descr;
xeroxDomain: PUBLIC ROPE _ "Xerox.COM";
arpaMSPort: PUBLIC IPDefs.DByte _ 25;
gvMSName: PUBLIC ROPE _ "ArpaGateway.ms";
longGVMSName: PUBLIC ROPE _ "Xerox Grapevine/ARPA SMTP MailServer";
defaultLogAcceptPriority: PUBLIC SMTPSupport.LogPriority _ verbose; -- will be noteworthy when through testing
defaultInhibitTime: PUBLIC INT _ 45*60;
itemExpiryTimeout: PUBLIC INT _ INT[4]*24*60*60;
startTime: PUBLIC BasicTime.GMT;
notifyManagerNames: PUBLIC LIST OF ROPE _ LIST["ArpaSupport^.pa"];
arpaExceptions: PUBLIC LIST OF ROPE _ LIST["ArpaExceptions.PA"]; -- Header translation mixups
deadLetterName: PUBLIC ROPE _ "DeadMessage.ms"; 
deadLetterSenderName: PUBLIC ROPE _ "Mailer.pa"; 
deadLetterPath: PUBLIC ROPE _ Rope.Cat[deadLetterSenderName, "@", xeroxDomain];
defaultRegistry: PUBLIC ROPE _ ".PA";
ReadControlData: PUBLIC PROC = {NULL}; -- should read values for the above vars from a file
<<General Control>>
loggedInUserName: ROPE _ UserCredentials.Get[].name;
loggedInUserPassword: GVBasics.Password _ GVBasics.MakeKey[UserCredentials.Get[].password];
loggedInUserACL: SMTPControl.AccessControlList _ none;
accessControlListNames: PUBLIC ARRAY SMTPControl.AccessControlList OF ROPE _
 ["none", "registry-friend", "registry-owner"];
LogRoutingChanges: PROC [rope: ROPE] =
BEGIN
SMTPSupport.Log[important, rope, "."];
END;
LoggedInUser: PUBLIC PROC RETURNS [name: ROPE, password: GVBasics.Password, acl: SMTPControl.AccessControlList] =
BEGIN
CheckAuthorization[];
IF loggedInUserName = NIL THEN ERROR SMTPControl.NoLoggedInUser;
RETURN[loggedInUserName, loggedInUserPassword, loggedInUserACL];
END;
NoLoggedInUser: PUBLIC ERROR = CODE;
OKToAcceptGVInput: PUBLIC PROC RETURNS [ok: BOOL, whyNot: ROPE] = {
RETURN[TRUE, ""]; };
OKToAcceptSMTPInput: PUBLIC PROC RETURNS [ok: BOOL, whyNot: ROPE] = {
RETURN[TRUE, ""]; };
<<Commander Commands>>
CmdEntry: TYPE = RECORD[proc: CmdProc, name, argSyntax, help: ROPE];
CmdProc: TYPE = PROC [argStream: STREAM];
numOfCmds: INT = 17;
Commands: ARRAY [0..numOfCmds) OF REF CmdEntry = [
NEW[CmdEntry _ [Help,
 "Help", "[cmd-name]", 
 "Give [minimal] help information."]],

NEW[CmdEntry _ [Login,
 "Login", NIL,
 "Accept new user for SMTP Commander. (interactive)"]],

NEW[CmdEntry _ [Logout,
 "Logout", NIL,
 "Remove authenticated user from Commander."]],

NEW[CmdEntry _ [InitServer, -- sub cmds may require some
 "InitServer", NIL,
 "Initialize the server (executes ReadInitItemFiles, GVRcvrInit, SMTPRcvrInit, StartDemon)"]],

NEW[CmdEntry _ [User,
 "User", NIL,
 "Print name and access (w.r.t. this ms) of logged in user."]],

NEW[CmdEntry _ [GVRcvrInitialize,
 "GVRcvrInit", NIL,
 "Start listeners to accept input from GV; establish this mc as ARPA MS."]],

NEW[CmdEntry _ [GVRcvrFinalize,
 "GVRcvrFinal", NIL,
 "Destroy listeners for GV input."]],

NEW[CmdEntry _ [SMTPRcvrInitialize,
 "SMTPRcvrInit", NIL,
 "Start listeners to accept SMTP input; notify Gandalf we are here."]],

NEW[CmdEntry _ [SMTPRcvrFinalize,
 "SMTPRcvrFinal", NIL,
 "Destroy listeners for SMTP input."]],

NEW[CmdEntry _ [SetExpressOK,
 "SetExpressOK", NIL,
 "Forward Express Mail to GV normally."]],

NEW[CmdEntry _ [SetExpressNO,
 "SetExpressNO", NIL,
 "Don't forward Express Mail to GV."]],

NEW[CmdEntry _ [StartDemon,
 "StartDemon", NIL,
 "Initialize processing demon."]],

NEW[CmdEntry _ [PrintQueue,
 "PrintQueue", "<queueName>\n\t\t\twhere <queueName> ::= New | Empty | GV | ARPA \n\t\t\t\t| <ArpaHostName> | Bad",
 "Print information about the given queue."]],

NEW[CmdEntry _ [PrintItem,
 "PrintItem", "<itemHandle>",
 "Print info about the mail item with the given handle."]],

NEW[CmdEntry _ [ReadInitItemFiles,
 "ReadInitItemFiles", NIL,
 "Read items left over from last MailServer run and queue ForProcessing."]],

NEW[CmdEntry _ [LogAcceptPriority,
 "LogPriority", "[verbose | noteworthy | important | attention | critical]", 
 "Examine/Set minimum priority of log messages to be accepted."]],

NEW[CmdEntry _ [Stats,
 "Stats", NIL, 
 "Show server statistics."]]

];
CLIPrompt: ROPE = "MS> "; -- yech! we're back to old line by line interaction
Help: CmdProc = { -- will need a Syntax command which prints just cmd name along with arg syntax when more extensive help messages 
{all this is only until a proper viewer interface is implemented}
all: BOOL = argStream.EndOf[];
cmdName: ROPE;
found: BOOL _ FALSE;
IF all THEN
PutLine[longGVMSName, " commands:\n"]
ELSE
cmdName _ argStream.GetID[];

FOR i: INT IN [0..numOfCmds) DO
cmd: REF CmdEntry = Commands[i];
IF all OR Rope.Equal[cmd.name, cmdName, FALSE] THEN {
PutLine[cmd.name, " ", cmd.argSyntax];
PutLine["\t\t", cmd.help]; -- may contain newlines
IF NOT all THEN {found _ TRUE; EXIT};
};
REPEAT
FINISHED =>
IF NOT found AND NOT all THEN PutLine["Unknown command (try just \"HELP\")"]
ENDLOOP;
}; -- end Help
Login: CmdProc = {
newName: ROPE;
newPassword: GVBasics.Password;
authResult: GVNames.AuthenticateInfo;
out.PutRope["User Name (include registry): "];
newName _ in.GetLineRope[];
out.PutRope["Password (reflected, sorry!): "];
newPassword _ GVBasics.MakeKey[in.GetLineRope[]];
<<Authenticate name and password, and (if auth OK) determine access list & install as new user.>>
authResult _ GVNames.AuthenticateKey[newName, newPassword];
IF authResult = individual THEN {
loggedInUserName _ newName;
loggedInUserPassword _ newPassword;
CheckAuthorization[];
PutLine["You have access ", accessControlListNames[loggedInUserACL],
 " (w.r.t. ", gvMSName, ")."]; }
ELSE PutLine["authentication failed"]; };
CheckAuthorization: PROC = {
<<Checks loggedInUserName for membership in appropriate groups and computes loggedInUserACL accordingly. loggedInUserName is 
assumed already to have been authenticated.>>
aclResult: GVNames.Membership;

<<First check if user is MS owner, failing which check if user is MS friend.>>
aclResult _ GVNames.IsInList[name: gvMSName, member: loggedInUserName,
 level: closure, grade: registry, acl: owners];
IF aclResult = yes THEN loggedInUserACL _ regOwner
ELSE {
aclResult _ GVNames.IsInList[name: gvMSName, member: loggedInUserName,
 level: closure, grade: registry, acl: friends];
IF aclResult = yes OR aclResult = allDown THEN 
loggedInUserACL _ regOwner
ELSE 
loggedInUserACL _ none; };
SMTPSupport.Log[important,
 loggedInUserName, " is now the logged in user with access ",
 accessControlListNames[loggedInUserACL],
 " (w.r.t. ", gvMSName, ")."];
};
Logout: CmdProc = {
loggedInUserName _ NIL;
loggedInUserACL _ none;
PutLine["There is now no logged in user."];
};

InitServer: CmdProc = {
PutLine[CLIPrompt, "ReadInitItemFiles"];
ReadInitItemFiles[argStream];
PutLine[CLIPrompt, "GVRcvrInit"];
GVRcvrInitialize[argStream];
PutLine[CLIPrompt, "SMTPRcvrInit"];
SMTPRcvrInitialize[argStream];
PutLine[CLIPrompt, "StartDemon"];
StartDemon[argStream];
};

InitServerCmd: Commander.CommandProc = {
ReadInitItemFiles[in];
GVRcvrInitialize[in];
SMTPRcvrInitialize[in];
StartDemon[in];
};


User: CmdProc = {
IF loggedInUserName # NIL THEN
PutLine["The logged in user is ", loggedInUserName,
 " with access (w.r.t. ", gvMSName, ") of ",
 accessControlListNames[loggedInUserACL], "."]
ELSE 
PutLine["There is no logged in user."];
};
GVRcvrInitialize: CmdProc = {SMTPGVRcvr.Initialize[]};
GVRcvrFinalize: CmdProc = {SMTPGVRcvr.Finalize[]};
SMTPRcvrInitialize: CmdProc = {SMTPRcvr.Initialize[]};
SMTPRcvrFinalize: CmdProc = {SMTPRcvr.Finalize[]};
SetExpressOK: CmdProc = {SMTPQueue.SetExpressOK[TRUE]};
SetExpressNO: CmdProc = {SMTPQueue.SetExpressOK[FALSE]};
StartDemon: CmdProc = TRUSTED {
IF queueDemonStarted THEN {PutLine["Demon already running."]; RETURN};
SMTPQueue.StartServer[];
queueDemonStarted _ TRUE;
startTime _ BasicTime.Now[];

};
queueDemonStarted: BOOL _ FALSE;
PrintQueue: CmdProc = {
queueName: ROPE;
queueName _ argStream.GetTokenRope[breakProc: IO.IDProc !
IO.EndOfStream => { queueName _ NIL; CONTINUE; } ].token;
SMTPQueue.PrintQueue[queueName, out];
};

PrintQueueCmd: Commander.CommandProc = {
queueName: ROPE;
queueName _ CommandTool.NextArgument[cmd];
SMTPQueue.PrintQueue[queueName, cmd.out];
};


PrintItem: CmdProc = {
SMTPQueue.PrintItem[argStream.GetInt[], out]; };

PrintItemCmd: Commander.CommandProc = {
SMTPQueue.PrintItem[Convert.IntFromRope[CommandTool.NextArgument[cmd]], cmd.out]; };

Stats: CmdProc = {PrintStats[out]; };
StatsCmd: Commander.CommandProc = {PrintStats[cmd.out]; };

PrintStats: PROC[s: STREAM] = {
totalMessages: INT _ SMTPGVSend.totalGvMsgsSent + SMTPSend.totalArpaMsgsSent;
totalBytes: INT  _ SMTPGVSend.totalGvBytesSent + SMTPSend.totalArpaBytesSent;
upTotalSeconds: INT _ BasicTime.Period[startTime, BasicTime.Now[]];
period: BasicTime.UnpackedPeriod _ BasicTime.UnpackPeriod[upTotalSeconds];
s.PutF["Server up at %g\n", IO.time[startTime]];
s.PutF["Current time %g,   ", IO.time[BasicTime.Now[]]];
s.PutF["Uptime %g:%g:%g\n", IO.int[period.hours], IO.int[period.minutes], IO.int[period.seconds]];

s.PutF["\nMessage stats: \n"];
s.PutF["Arpa bound messages %g,  Arpa bound bytes %g\n",  IO.int[SMTPSend.totalArpaMsgsSent], IO.int[SMTPSend.totalArpaBytesSent]];
s.PutF["GV bound messages %g,  GV bound bytes %g\n",  IO.int[SMTPGVSend.totalGvMsgsSent], IO.int[SMTPGVSend.totalGvBytesSent]];
s.PutF["Total messages %g,  Total bytes %g\n",  IO.int[totalMessages], IO.int[totalBytes]];

s.PutF["\nQueue stats: \n"];
s.PutF["Arpa queue hosts %g,  messages %g\n",  IO.int[SMTPQueue.CountQueue["Arpa"]], IO.int[SMTPQueue.CountMessages["Arpa"]]];
s.PutF["Sick queue hosts %g,  messages %g\n",  IO.int[SMTPQueue.CountQueue["Sick"]], IO.int[SMTPQueue.CountMessages["Sick"]]];
s.PutF["Express queue lists %g,  messages %g\n",  IO.int[SMTPQueue.CountQueue["Ex"]], IO.int[SMTPQueue.CountMessages["Ex"]]];
s.PutF["GV queue messages %g\n", IO.int[SMTPQueue.CountMessages["GV"]]];


s.PutF["\nTCP stats: \n"];
s.PutF["Sent %g, Rcvd %g, Retransmit %g, Duplicate %g, NoConnection %g\n",
IO.int[TCPOps.pktsSent], IO.int[TCPOps.pktsRcvd], IO.int[TCPOps.pktsRexmitted], IO.int[TCPOps.pktsDuplicate], 
IO.int[TCPOps.pktsWithNoConnection]];
s.PutF["FromFuture %g, FromPast %g, BadChecksum %g\n",
IO.int[TCPOps.pktsFromFuture], IO.int[TCPOps.pktsFromPast], IO.int[TCPOps.pktsWithBadChecksum]];


s.PutF["\nIP reassembly stats: \n"];
s.PutF["Single %g, Arrived %g, Merged %g, Finished %g, Died %g, ",
IO.int[IPReassembly.single], IO.int[IPReassembly.arrived], IO.int[IPReassembly.merged], IO.int[IPReassembly.finished], 
IO.int[IPReassembly.died]];
s.PutF["Bad %g.\n",IO.int[IPReassembly.bad]];


};

ReadInitItemFiles: CmdProc = {
QueueIt: SMTPDescr.InitialItemProc = {
SMTPQueue.AddNewMessage[descr, "OnDiskAtRestart"]};
IF initialItemsRead THEN ERROR CmdError["Initial item files already read."];
initialItemsRead _ TRUE;
SMTPDescr.EnumerateInitialItems[QueueIt];
};
initialItemsRead: BOOL _ FALSE;
LogAcceptPriority: CmdProc = {
IF argStream.EndOf[] THEN -- print current priority
PutLine["Current log minimum acceptance priority is ",
 SMTPSupport.logPriorityNames[SMTPSupport.currentLogAcceptPriority], "."]
ELSE { -- get new priority, if authorized
prioName: ROPE = argStream.GetID[];
FOR prio: SMTPSupport.LogPriority IN SMTPSupport.LogPriority DO
IF Rope.Equal[prioName, SMTPSupport.logPriorityNames[prio], FALSE] THEN {
SMTPSupport.Log[important,
 "Minimum accepted log priority set to ",
 SMTPSupport.logPriorityNames[prio], "."]; -- logging before changing the priority gives better chance of this being logged if 
priority increased, which is more important than if it is decreased
SMTPSupport.currentLogAcceptPriority _ prio;
EXIT; };
REPEAT FINISHED => PutLine["unknown priority"];
ENDLOOP; }; };
<<The Commander>>
in, out: PUBLIC STREAM;
CmdError: ERROR [reason: ROPE] = CODE;
SyntaxError: ERROR [reason: ROPE, problemAt: INT _ -1];
<<Should have and use routines to ensure no unexpected args on cmd line.>>
PutLine: PROC [r1, r2, r3, r4, r5, r6, r7, r8: ROPE _ NIL] = {
out.PutRope[r1];
out.PutRope[r2];
out.PutRope[r3];
out.PutRope[r4];
out.PutRope[r5];
out.PutRope[r6];
out.PutRope[r7];
out.PutRope[r8];
out.PutChar['\n]; };
CLI: PROC = {
cmdLineRope: ROPE;
cmdLineStream: STREAM _ NIL;
cmdName: ROPE;
cmd: REF CmdEntry;
PutLine[longGVMSName];
DO
ENABLE {
ABORTED => { out.PutRope[" ABORTED\n"]; CONTINUE; };
EditedStream.Rubout => { in.Reset[]; out.PutRope[" XXX\n"]; CONTINUE; };
IO.EndOfStream => CONTINUE; -- blank cmd line or cmd proc failed to trap it
IO.Error => {
SELECT ec FROM
StreamClosed => EXIT;
SyntaxError => out.PutRope["syntax error:\n"];
Overflow => out.PutRope["overflow in conversion:\n"];
ENDCASE => REJECT;
PutLine[cmdLineRope.Substr[len: cmdLineStream.GetIndex[]-1],
 " <!> ",
 cmdLineRope.Substr[start: cmdLineStream.GetIndex[]-1]];
CONTINUE; };
CmdError => { PutLine[reason]; CONTINUE; };
SyntaxError => {
IF problemAt >= 0 THEN
PutLine["syntax error: ", reason];
PutLine[Rope.Substr[cmdLineRope, 0, problemAt], " <!> ",
 Rope.Substr[cmdLineRope, problemAt]];
CONTINUE; };
SMTPGVRcvr.Error => { PutLine[" ****"]; PutLine[reason]; CONTINUE; };
SMTPRcvr.Error => { PutLine[" ****"]; PutLine[reason]; CONTINUE; };
};
out.PutRope[CLIPrompt];
cmdLineRope _ in.GetLineRope[! IO.EndOfStream => EXIT];
cmdLineStream _ IO.RIS[cmdLineRope];
cmdName _ cmdLineStream.GetID[];
[] _ cmdLineStream.SkipWhitespace[]; -- so cmds can use EndOf to check that there are no args
FOR i: INT IN [0..numOfCmds) DO
cmd _ Commands[i];
IF Rope.Equal[cmdName, cmd.name, FALSE] THEN {
cmd.proc[cmdLineStream];
EXIT;
};
REPEAT
FINISHED => PutLine[Rope.Cat["unknown command \"", cmdName, "\""]];
ENDLOOP;
ENDLOOP; };
NewCommander: Commander.CommandProc = {
[in, out] _ ViewerIO.CreateViewerStreams["SMTP Commander"];
TRUSTED {Process.Detach[FORK CLI[]]}; };
SMTPSupport.Log[important, "Server starting."];
Commander.Register["MailGateway", NewCommander, "Create a new SMTP (ARPA mail) command interpreter."]; -- in case the initial one 
fails
Commander.Register["PrintQueue", PrintQueueCmd, "Print queue."];  
Commander.Register["PrintItem", PrintItemCmd, "Print item."]; 
Commander.Register["Stats", StatsCmd, "Print Statistics."]; 
Commander.Register["InitServer", InitServerCmd, "Initialize Server."]; 

IPRouter.SetStateChangeProc[LogRoutingChanges];
END.