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.