[Pixel]<NCP>ArpaSMTP>ArpaSMTPSupportImpl.mesa!5

ArpaSMTPSupportImpl.mesa

Last Edited by: DCraft, December 20, 1983 5:54 pm

Last Edited by: Taft, January 23, 1984 1:27:58 pm PST

Hal Murray June 17, 1985 11:28:06 am PDT

John Larson, August 1, 1988 0:45:39 am PDT

DIRECTORY

ArpaMT USING [CheckFromField, Info, ParseHeaders, PrintHeaders, TranslateToArpa, TranslateToGrapevine],

ArpaSMTPControl USING [arpaExceptions, deadLetterName, deadLetterSenderName, defaultLogAcceptPriority, longGVMSName, notifyManagerNames],

ArpaSMTPDescr USING [CopyForReturn, Create, CreateFailed, Descr, EnumerateRawRecipients, GetArpaReversePath, GetFormat, GetGvSender, GetPrecedeMsgText, GetReturnPathLine, RawRecipProc, RetrieveMsgStream, Unparse, WrongState],

ArpaSMTPQueue USING [AddNewMessage],

ArpaSMTPSupport USING [LogPriority],

ArpaSMTPSyntax USING [EnumerateGVItems, GVItemProc],

BasicTime USING [GMT, MonthOfYear, Now, nullGMT, Unpack, Unpacked],

Convert USING [RopeFromInt, RopeFromTime],

IO USING [BreakProc, Close, CreateStream, CreateStreamProcs, EndOfStream, Error, Flush, GetBlock, GetChar, GetIndex, GetInfo, GetLength, GetTokenRope, int, PutChar, PutFR, PutRope, RIS, rope, RopeFromROS, ROS, SetIndex, STREAM, StreamProcs],

GVBasics USING [RName],

GVNames USING [IsMemberDirect, Membership],

Process USING [Detach],

RefText USING [AppendChar, ObtainScratch, ReleaseScratch],

Rope USING [Cat, Concat, Equal, Fetch, Find, FromRefText, IsEmpty, Length, ROPE, Substr],

SimpleMailer USING [SendMessage],

ViewerIO USING [CreateViewerStreams, GetViewerFromStream];

ArpaSMTPSupportImpl: CEDAR MONITOR

IMPORTS ArpaMT, ArpaSMTPControl, ArpaSMTPDescr, ArpaSMTPQueue, ArpaSMTPSyntax, BasicTime, Convert, IO, GVNames, Process, RefText, Rope, SimpleMailer, ViewerIO

EXPORTS ArpaSMTPSupport =

BEGIN

ROPE: TYPE = Rope.ROPE;

STREAM: TYPE = IO.STREAM;

Descr: TYPE = ArpaSMTPDescr.Descr;

Logging Information

currentLogAcceptPriority: PUBLIC ArpaSMTPSupport.LogPriority ← ArpaSMTPControl.defaultLogAcceptPriority;

Log: PUBLIC PROC [priority: ArpaSMTPSupport.LogPriority,
note1, note2, note3, note4, note5, note6, note7, note8, note9, note10: Rope.ROPE ← NIL] = {

now: BasicTime.GMT ← BasicTime.Now[];

IF priority >= currentLogAcceptPriority THEN

WriteToLog[priority, now,
note1, note2, note3, note4, note5, note6, note7, note8, note9, note10];

IF priority >= ATTENTION THEN { -- notify managers

date: ROPE ← RFC822Date[now];

from: ROPE ← ArpaSMTPControl.deadLetterSenderName;

to: LIST OF GVBasics.RName ← ArpaSMTPControl.notifyManagerNames;

subject: ROPE ← "Confusion in Mail Gateway";

body1: ROPE ← Rope.Cat[note1, note2, note3, note4, note5];

body2: ROPE ← Rope.Cat[note1, note2, note3, note4, note5];

body: ROPE ← Rope.Cat[body1, body2];

[] ← SimpleMailer.SendMessage[from: from, returnTo: from, to: to, subject: subject, body: body]
};

};

ForkNewMessage: PROC [descr: Descr, queue: ROPE] = TRUSTED {

Process.Detach[FORK ArpaSMTPQueue.AddNewMessage[descr, queue]]; };

HeaderParseError: PUBLIC PROC [recipList: LIST OF ROPE, descr: Descr] = {

ENABLE ArpaSMTPDescr.CreateFailed => CONTINUE;

now: BasicTime.GMT ← BasicTime.Now[];

date: ROPE ← Rope.Cat["Date: ", RFC822Date[now], "\n"];

from: ROPE ← Rope.Cat["From: ", ArpaSMTPControl.deadLetterSenderName, "\n"];

to: ROPE ← Rope.Cat["To: ", ArpaSMTPControl.arpaExceptions.first, "\n"];

subject: ROPE ← "Subject: Parsing Error in Message Header\n\n";

header: ROPE ← Rope.Cat[date, from, to, subject];

getReturnPathLine: ROPE ← ArpaSMTPDescr.GetReturnPathLine[descr];

getPrecedeMsgText: ROPE ← ArpaSMTPDescr.GetPrecedeMsgText[descr];

msgStream: IO.STREAM;

errors: IO.STREAM ← IO.ROS[];

before: IO.STREAM ← IO.ROS[];

after: IO.STREAM ← IO.ROS[];

info: ArpaMT.Info;

body: ROPE;

new: Descr;

msgStream ← ArpaSMTPDescr.RetrieveMsgStream[descr];

SELECT ArpaSMTPDescr.GetFormat[descr] FROM

arpa => {

info ← ArpaMT.ParseHeaders[file: msgStream, errStream: errors];

msgStream.Close[];

ArpaMT.PrintHeaders[info, before];

ArpaMT.TranslateToGrapevine[info];

ArpaMT.PrintHeaders[info, after]; };

gv => { -- Copied from SMTPSendImpl

AssignTextStream: ArpaSMTPSyntax.GVItemProc = {

currentIndex: INT;

IF itemHeader.type # Text THEN RETURN;

currentIndex ← msgStream.GetIndex[];

msgStream ← CreateSubrangeStream[

origStream: msgStream, min: currentIndex, max: currentIndex+itemHeader.length];

continue ← FALSE; };

ArpaSMTPSyntax.EnumerateGVItems[GVStream: msgStream, proc: AssignTextStream];

info ← ArpaMT.ParseHeaders[file: msgStream, errStream: errors];

msgStream.Close[];

ArpaMT.PrintHeaders[info, before];

ArpaMT.TranslateToArpa[info];

ArpaMT.PrintHeaders[info, after]; };

ENDCASE => ERROR;

body ← Rope.Cat[body, "Recipients: "];

FOR rest: LIST OF ROPE ← recipList, rest.rest UNTIL rest = NIL DO

IF rest # recipList THEN body ← Rope.Cat[body, ", "];

body ← Rope.Cat[body, rest.first];

ENDLOOP;

body ← Rope.Cat[body, "\n\n"];

body ← Rope.Cat[body, IO.RopeFromROS[errors], "\n"];

body ← Rope.Cat[body, "Before translation:\n\n", IO.RopeFromROS[before], "\n\n"];

body ← Rope.Cat[body, "After translation:\n\n"];

IF getReturnPathLine # NIL THEN body ← Rope.Cat[body, getReturnPathLine, "\n"];

IF getPrecedeMsgText # NIL THEN body ← Rope.Cat[body, getPrecedeMsgText, "\n"];

body ← Rope.Cat[body, IO.RopeFromROS[after], "\n\n"];

new ← ArpaSMTPDescr.Create[

gvSender: ArpaSMTPControl.deadLetterSenderName,

rawRecipients: ArpaSMTPControl.arpaExceptions,

format: arpa, -- don't have GV items

msgStream: IO.RIS[Rope.Cat[header, body]]];

ForkNewMessage[new, "HeaderParseError"]; };

Undeliverable: PROC [why: ROPE, descr: Descr] = {

ENABLE ArpaSMTPDescr.CreateFailed => CONTINUE;

now: BasicTime.GMT ← BasicTime.Now[];

date: ROPE ← Rope.Cat["Date: ", RFC822Date[now], "\n"];

from: ROPE ← Rope.Cat["From: ", ArpaSMTPControl.deadLetterSenderName, "\n"];

to: ROPE ← Rope.Cat["To: ", ArpaSMTPControl.deadLetterName, "\n"];

subject: ROPE ← "Subject: Undeliverable mail notification\n\n";

header: ROPE ← Rope.Cat[date, from, to, subject];

getReturnPathLine: ROPE ← ArpaSMTPDescr.GetReturnPathLine[descr];

getPrecedeMsgText: ROPE ← ArpaSMTPDescr.GetPrecedeMsgText[descr];

msgStream: IO.STREAM;

errors: IO.STREAM ← IO.ROS[];

before: IO.STREAM ← IO.ROS[];

info: ArpaMT.Info;

sender, body: ROPE;

new: Descr;

msgStream ← ArpaSMTPDescr.RetrieveMsgStream[descr];

SELECT ArpaSMTPDescr.GetFormat[descr] FROM

arpa => {

sender ← ArpaSMTPDescr.GetArpaReversePath[descr];

info ← ArpaMT.ParseHeaders[file: msgStream, errStream: errors];

msgStream.Close[];

ArpaMT.PrintHeaders[info, before]; };

gv => { -- Copied from SMTPSendImpl

AssignTextStream: ArpaSMTPSyntax.GVItemProc = {

currentIndex: INT;

IF itemHeader.type # Text THEN RETURN;

currentIndex ← msgStream.GetIndex[];

msgStream ← CreateSubrangeStream[

origStream: msgStream, min: currentIndex, max: currentIndex+itemHeader.length];

continue ← FALSE; };

sender ← ArpaSMTPDescr.GetGvSender[descr];

ArpaSMTPSyntax.EnumerateGVItems[GVStream: msgStream, proc: AssignTextStream];

info ← ArpaMT.ParseHeaders[file: msgStream, errStream: errors];

msgStream.Close[];

ArpaMT.PrintHeaders[info, before]; };

ENDCASE => ERROR;

body ← Rope.Cat[why, "\n\nThe message will be sent to:\n", sender, ".\n\n"];

body ← Rope.Cat[body, "The header of the message was:\n--------------------\n"];

IF getReturnPathLine # NIL THEN body ← Rope.Cat[body, getReturnPathLine, "\n"];

IF getPrecedeMsgText # NIL THEN body ← Rope.Cat[body, getPrecedeMsgText, "\n"];

body ← Rope.Cat[body, IO.RopeFromROS[before], "\n\n"];

new ← ArpaSMTPDescr.Create[

gvSender: ArpaSMTPControl.deadLetterSenderName,

rawRecipients: LIST[ArpaSMTPControl.deadLetterName],

format: arpa, -- don't have GV items

msgStream: IO.RIS[Rope.Cat[header, body]]];

ForkNewMessage[new, "Undeliverable"]; };

WriteToLog: ENTRY PROC [priority: ArpaSMTPSupport.LogPriority, now: BasicTime.GMT,
note1, note2, note3, note4, note5, note6, note7, note8, note9, note10: Rope.ROPE ← NIL] = {

Monitored so we don't interleave messages on the log.

logViewerOut.PutRope[Convert.RopeFromTime[from: now, start: hours, end: seconds, useAMPM: FALSE, includeZone: FALSE]];

logViewerOut.PutRope[" "];

IF priority > noteworthy THEN {

logViewerOut.PutRope[logPriorityNames[priority]];

logViewerOut.PutRope[": "]; };

logViewerOut.PutRope[note1];

logViewerOut.PutRope[note2];

logViewerOut.PutRope[note3];

logViewerOut.PutRope[note4];

logViewerOut.PutRope[note5];

logViewerOut.PutRope[note6];

logViewerOut.PutRope[note7];

logViewerOut.PutRope[note8];

logViewerOut.PutRope[note9];

logViewerOut.PutRope[note10];

logViewerOut.PutChar['\n];

logViewerOut.Flush[];

};

logPriorityNames: PUBLIC ARRAY ArpaSMTPSupport.LogPriority OF ROPE
← ["verbose", "noteworthy", "Important", "ATTENTION", "CRITICAL"];

logViewerIn, logViewerOut: STREAM; -- initialized below

Housekeeping

There is similar code in SMTPQueueImpl

letNonMembersPlay: BOOL ← TRUE;

goodGuys, badGuys: LIST OF ROPE;

AuthorizationCheck: PUBLIC PROC [sender: ROPE] RETURNS [ok: BOOLEAN] = {

RETURN[TRUE]};

membership: GVNames.Membership;

IF Rope.Find[sender, "@"] # -1 THEN RETURN[TRUE]; -- Arpa => GV DL => Arpa

sender ← StripQuotes[sender];

FOR list: LIST OF ROPE ← goodGuys, list.rest UNTIL list = NIL DO

IF Rope.Equal[sender, list.first, FALSE] THEN RETURN[TRUE];

ENDLOOP;

FOR list: LIST OF ROPE ← badGuys, list.rest UNTIL list = NIL DO

IF Rope.Equal[sender, list.first, FALSE] THEN RETURN[letNonMembersPlay];

ENDLOOP;

membership ← GVNames.IsMemberDirect["ArpanetUsers^.X", sender];

SELECT membership FROM

yes => {

goodGuys ← CONS[sender, goodGuys];

RETURN[TRUE]; };

no => {

Log[important, "\"", sender, "\" isn't a member of ArpanetUsers^.X"];

badGuys ← CONS[sender, badGuys];

RETURN[letNonMembersPlay]; };

notGroup => Log[ATTENTION, "GV Claims ArpanetUsers^.X isn't a group"];

allDown => Log[ATTENTION, "GV Claims all servers for the X registry are down"];

ENDCASE => NULL;

RETURN[TRUE]; };

StripQuotes: PROC [old: ROPE] RETURNS [new: ROPE] = {

JSmith.OSBUNorth => JSmith.OSBUNorth

"John Smith".OSBUNorth => John Smith.OSBUNorth

length: INT ← Rope.Length[old];

new ← old;

IF length < 2 THEN RETURN;

IF Rope.Fetch[old, 0] # '\" THEN RETURN;

BEGIN

quoteSeen: BOOLEAN ← FALSE;

text: REF TEXT ← RefText.ObtainScratch[length];

FOR i: INT IN [0..length) DO

c: CHAR = Rope.Fetch[new, i];

IF c = '\\ AND ~quoteSeen THEN { quoteSeen ← TRUE; LOOP; };

quoteSeen ← FALSE;

IF c = '\" THEN LOOP; -- Not quite right, but works for reasonable input

text ← RefText.AppendChar[text, c];

ENDLOOP;

new ← Rope.FromRefText[text];

RefText.ReleaseScratch[text];

END; };

CheckHeader: PUBLIC PROC [sender: ROPE, descr: Descr] RETURNS [ok: BOOLEAN ← TRUE] = {

msgStream: IO.STREAM;

errors: IO.STREAM ← IO.ROS[];

precede: ROPE ← ArpaSMTPDescr.GetPrecedeMsgText[descr];

errorRope: ROPE;

info: ArpaMT.Info;

Beware: Returned mail uses the precede hackery. The actual descr has the same body and hence looks like it has the same header so it will hit the same problem each time it gets returned.

IF Rope.Find[precede, "\n\n"] #-1 THEN RETURN;

SELECT ArpaSMTPDescr.GetFormat[descr] FROM

arpa => RETURN; -- Don't check ARPA headers (yet)

gv => { -- Copied from SMTPSendImpl

AssignTextStream: ArpaSMTPSyntax.GVItemProc = {

currentIndex: INT;

IF itemHeader.type # Text THEN RETURN;

currentIndex ← msgStream.GetIndex[];

msgStream ← CreateSubrangeStream[

origStream: msgStream, min: currentIndex, max: currentIndex+itemHeader.length];

continue ← FALSE; };

ArpaSender: PROC[descr: Descr] RETURNS[BOOLEAN] = {

arpaReversePath: Rope.ROPE ← ArpaSMTPDescr.GetArpaReversePath[descr];

IF Rope.Find[ArpaSMTPDescr.GetGvSender[descr], "@"] > -1 THEN RETURN[TRUE];

IF Rope.Find[s1: arpaReversePath, s2: "Owners-"] > -1 THEN RETURN[TRUE];

RETURN[Rope.Find[arpaReversePath, "@"] > -1 AND
Rope.Find[s1: arpaReversePath, s2: "@Xerox", case: FALSE] = -1];

};

msgStream ← ArpaSMTPDescr.RetrieveMsgStream[descr];

ArpaSMTPSyntax.EnumerateGVItems[GVStream: msgStream, proc: AssignTextStream];

info ← ArpaMT.ParseHeaders[file: msgStream, errStream: errors];

msgStream.Close[];

errorRope ← IO.RopeFromROS[errors];

IF Rope.IsEmpty[errorRope] AND ~ArpaSender[descr] AND ~ArpaMT.CheckFromField[info] THEN

errorRope ← "A non-Ascii or unprintable character in the From or Sender fields (even if properly quoted) kills some mailers. If your address (shown below) ends with a \".ns\", check with CINSupport:All Areas to see if your domain should be registered with the Grapevine mail gateways.";

IF ~Rope.IsEmpty[errorRope] AND ~ArpaSender[descr] THEN {

recipients: ROPE;

CopyRawRecipient: ArpaSMTPDescr.RawRecipProc = {

IF recipients = NIL THEN recipients ← "Recipients: "

ELSE recipients ← Rope.Cat[recipients, ", "];

recipients ← Rope.Cat[recipients, rawRecipient]; };

ArpaSMTPDescr.EnumerateRawRecipients[descr, CopyRawRecipient, NIL];

errorRope ← Rope.Cat["The Arpa Mail Gateway encountered troubles in the header of your message. In order to avoid confusing other ARPA Internet sites, your message was not delivered to the following ARPA Internet recipients. (\n\n", recipients, "\n\n", errorRope];

NotifySender[descr, errorRope];

ok ← FALSE; }; };

ENDCASE => ERROR; };

Notification of Undeliverable Mail

NotifySender: PUBLIC PROC [descr: Descr,
why1, why2, why3, why4, why5: ROPE ← NIL] = {

ENABLE {

ArpaSMTPDescr.CreateFailed =>

Log[ATTENTION,
"Unable to create descriptor to return item ", ArpaSMTPDescr.Unparse[descr],
" to sender. Being returned because: \"",
why1, why2, why3, why4, why5, "\".\nToo bad!"];

ArpaSMTPDescr.WrongState =>

Log[noteworthy,
"Asked to return item ", ArpaSMTPDescr.Unparse[descr], " to sender, because: \"",
why1, why2, why3, why4, why5,
"\"\nThe item has a null reverse path (possibly a return message itself). Too bad!"];

};

why: ROPE = Rope.Cat[why1, why2, why3, why4, why5];

new: Descr;

Undeliverable[why, descr];

new ← ArpaSMTPDescr.CopyForReturn[descr,
Rope.Cat[why,
"\n\nThe text of your message was\n--------------------\n"]];

Log[important,
ArpaSMTPDescr.Unparse[descr], " is being returned because:\n",
why1, why2, why3, why4, why5];

ForkNewMessage[new, "ReturnToSender"]; };

Current Date and Time (in SMTP format)

monthText: ARRAY BasicTime.MonthOfYear OF ROPE = ["JAN", "FEB", "MAR", "APR", "MAY", "JUN", "JUL", "AUG", "SEP", "OCT", "NOV", "DEC", "???"];

USzones: TYPE ~ [4..10];

zones1stChar: ARRAY USzones OF ROPE = ["A", "E", "C", "M", "P", "Y", "H"];

Now: PUBLIC PROC [compressed: BOOL ← FALSE] RETURNS [rope: ROPE, gmt: BasicTime.GMT] = {

Returns the current time in format specified for Arpa SMTP. The "compressed" form is suitable for a file name.

unpacked: BasicTime.Unpacked;

date, time: ROPE;

z: INT;

unpacked ← BasicTime.Unpack[gmt ← BasicTime.Now[]];

IF compressed THEN {

date ← IO.PutFR["%02G%02G%02G-",
IO.int[unpacked.year MOD 100],
IO.int[unpacked.month.ORD+1],
IO.int[unpacked.day]];

time ← IO.PutFR["%02g%02g%02g",
IO.int[unpacked.hour],
IO.int[unpacked.minute],
IO.int[unpacked.second]]; }

ELSE {

date ← IO.PutFR["%02g %g %02g ",
IO.int[unpacked.day],
IO.rope[monthText[unpacked.month]],
IO.int[unpacked.year MOD 100]];

time ← IO.PutFR["%02g:%02g:%02g ",
IO.int[unpacked.hour],
IO.int[unpacked.minute],
IO.int[unpacked.second]];

z ← unpacked.zone/60; -- gives zone in range -12 to 12

IF (FIRST[USzones] <= z) AND (z <= LAST[USzones]) THEN

time ← Rope.Cat[time, zones1stChar[z], IF unpacked.dst = yes THEN "D" ELSE "S", "T"]

ELSE {

IF unpacked.dst = yes THEN z ← z - 1;

IF z = 0 THEN time ← Rope.Concat[time, "GMT"]

ELSE time ← Rope.Cat[

time, IF z > 0 THEN "+" ELSE "-", Convert.RopeFromInt[ABS[z]]]; }; };

RETURN[Rope.Concat[date, time], gmt];

}; -- end Now

RFC822Date: PUBLIC PROC[gmt: BasicTime.GMT← BasicTime.nullGMT] RETURNS[date: ROPE] =

generates arpa standard time, dd mmm yy hh:mm:ss zzz

BEGIN OPEN IO;

upt: BasicTime.Unpacked ← BasicTime.Unpack[IF gmt = BasicTime.nullGMT THEN

BasicTime.Now[] ELSE gmt];

zone: ROPE;

weekday, month, tyme, year: ROPE;

timeFormat: ROPE = "%02g:%02g:%02g %g"; -- "hh:mm:ss zzz"

dateFormat: ROPE = "%2g %g %g %g"; -- "dd mmm yy timeFormat"

arpaNeg: BOOL ← upt.zone > 0;

aZone: INT ← ABS[upt.zone];

zDif: INT ← aZone / 60;

zMul: INT ← zDif * 60;

IF (zMul = aZone) AND arpaNeg THEN {

IF upt.dst = yes THEN

SELECT zDif FROM

0 => zone← "UT";

4 => zone← "EDT";

5 => zone← "CDT";

6 => zone← "MDT";

8 => zone← "PDT";

ENDCASE

ELSE

SELECT zDif FROM

0 => zone← "UT";

5 => zone← "EST";

6 => zone← "CST";

7 => zone← "MST";

8 => zone← "PST";

ENDCASE; };

IF zone = NIL THEN {

mm: INT← aZone - zMul;

zone← PutFR[IF arpaNeg THEN "-%02g%02g" ELSE "+%02g%02g", int[zDif], int[mm]]; };

SELECT upt.month FROM

January => month← "Jan";

February => month← "Feb";

March => month← "Mar";

April => month← "Apr";

May => month← "May";

June => month← "Jun";

July => month← "Jul";

August => month← "Aug";

September => month← "Sep";

October => month← "Oct";

November => month← "Nov";

December => month← "Dec";

unspecified => ERROR;

ENDCASE => ERROR;

SELECT upt.weekday FROM

Monday => weekday← "Monday";

Tuesday => weekday← "Tuesday";

Wednesday => weekday ← "Wednesday";

Thursday => weekday ← "Thursday";

Friday => weekday ← "Friday";

Saturday => weekday ← "Saturday";

Sunday => weekday ← "Sunday";

unspecified => ERROR;

ENDCASE => ERROR;

year← Rope.Substr[PutFR[NIL, int[upt.year]], 2];

tyme← PutFR[timeFormat, int[upt.hour], int[upt.minute], int[upt.second], rope[zone]];

date← PutFR[dateFormat, int[upt.day], rope[month], rope[year], rope[tyme]];

date ← Rope.Cat[date, " (", weekday, ")"];

END;

Subrange Streams

CreateSubrangeStream: PUBLIC PROC [origStream: STREAM, min, max: INT] RETURNS [STREAM] = {

Create a new stream encompassing only a subrange of the original one. If the original stream is already a subrange stream, do not layer again.

newStreamData: REF SubrangeStreamData;

newBackingStream: STREAM;

IF origStream.GetInfo[].class = $Subrange THEN {

origStreamData: REF SubrangeStreamData = NARROW[origStream.streamData];

origMinIndex: INT = origStreamData.min;

origMaxIndex: INT = origStreamData.max;

newBackingStream ← origStream.backingStream;

newStreamData ← NEW[SubrangeStreamData ← [min: MAX[min, origMinIndex],
max: MIN[max, origMaxIndex]]];

}

ELSE {

newBackingStream ← origStream;

newStreamData ← NEW[SubrangeStreamData ←
[min: min,
max: MIN[max, origStream.GetLength[]]]];

};

RETURN[IO.CreateStream[

backingStream: newBackingStream,

streamProcs: SubrangeStreamProcs,

streamData: newStreamData]];

};

SubrangeStreamProcs: REF IO.StreamProcs = IO.CreateStreamProcs[

variety: input,

class: $Subrange,

getChar: SubrangeGetChar,

getBlock: SubrangeGetBlock,

endOf: SubrangeEndOf,

backup: SubrangeBackup, -- Bug in real one

setIndex: SubrangeSetIndex,

getLength: SubrangeGetLength];

SubrangeStreamData: TYPE = RECORD[min, max: INT]; -- Info is [min..max)

SubrangeBackup: PROC [self: STREAM, char: CHAR] = {

me: REF SubrangeStreamData = NARROW[self.streamData];

self.SetIndex[self.GetIndex[]-1]; };

SubrangeEndOf: PROC [self: STREAM] RETURNS [BOOL] = {

me: REF SubrangeStreamData = NARROW[self.streamData];

This assumes that GetChar/GetBlock set the index to the length after reading the last char.

RETURN[self.backingStream.GetIndex[] >= me.max]; };

SubrangeGetLength: PROC [self: STREAM] RETURNS [length: INT] = {

me: REF SubrangeStreamData = NARROW[self.streamData];

RETURN[me.max]; };

SubrangeSetIndex: PROC [self: STREAM, index: INT] = {

me: REF SubrangeStreamData = NARROW[self.streamData];

IF index > me.max OR index < me.min THEN ERROR IO.Error[BadIndex, self];

self.backingStream.SetIndex[index]; };

SubrangeGetBlock: PROC [self: STREAM, block: REF TEXT, startIndex: NAT ← 0, count: NAT ← NAT.LAST] RETURNS [nBytesRead: NAT] = {

me: REF SubrangeStreamData = NARROW[self.streamData];

bytesLeft: INT = me.max - self.backingStream.GetIndex[];

bytesToRead: INT = MIN[count, bytesLeft];

natBytesToRead: NAT = bytesToRead;

nBytesRead ← self.backingStream.GetBlock[

block: block, startIndex: startIndex, count: natBytesToRead]; };

SubrangeGetChar: PROC [self: STREAM] RETURNS [CHAR] = {

me: REF SubrangeStreamData = NARROW[self.streamData];

fullStream: STREAM ~ self.backingStream;

IF fullStream.GetIndex[] >= me.max THEN IO.EndOfStream[self];

RETURN[fullStream.GetChar[]]; };

RopeFromSubrange: PUBLIC PROC [origStream: STREAM, min, max: INT] RETURNS [rope: ROPE] = {

EverythingProc: IO.BreakProc = {RETURN[other]};

subrangeStream: STREAM;

subrangeStream ← CreateSubrangeStream[origStream: origStream, min: min, max: max];

rope ← subrangeStream.GetTokenRope[EverythingProc !

IO.EndOfStream => CONTINUE ].token; };

Misc

[logViewerIn, logViewerOut] ← ViewerIO.CreateViewerStreams[

name: "MailGateway Log",

backingFile: "MailGateway.log"];

ViewerIO.GetViewerFromStream[logViewerOut].inhibitDestroy ← TRUE;

logViewerOut.PutRope["########## "];

logViewerOut.PutRope[ArpaSMTPControl.longGVMSName];

logViewerOut.PutRope[" Log ##########\n\n"];

END.