SMTPSupportImpl.mesa
Copyright © 1985 by Xerox Corporation. All rights reserved.
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, March 9, 1987 12:26:54 pm PST
DIRECTORY
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],
GVNames USING [IsMemberDirect, Membership],
Process USING [Detach],
RefText USING [AppendChar, ObtainScratch, ReleaseScratch],
Rope USING [Cat, Concat, Equal, Fetch, Find, FromRefText, IsEmpty, Length, ROPE, Substr],
ViewerIO USING [CreateViewerStreams, GetViewerFromStream],
MT USING [CheckFromField, Info, ParseHeaders, PrintHeaders, TranslateToArpa, TranslateToGrapevine],
SMTPControl USING [arpaExceptions, deadLetterName, deadLetterSenderName, defaultLogAcceptPriority, longGVMSName, notifyManagerNames],
SMTPDescr USING [CopyForReturn, Create, CreateFailed, Descr, EnumerateRawRecipients, GetArpaReversePath, GetFormat, GetGvSender, GetPrecedeMsgText, GetReturnPathLine, RawRecipProc, RetrieveMsgStream, Unparse, WrongState],
SMTPQueue USING [AddNewMessage],
SMTPSupport USING [LogPriority],
SMTPSyntax USING [EnumerateGVItems, GVItemProc];
SMTPSupportImpl:
CEDAR MONITOR
IMPORTS
BasicTime, Convert, IO, GVNames, Process, RefText, Rope, ViewerIO,
MT, SMTPControl, SMTPDescr, SMTPQueue, SMTPSyntax
EXPORTS SMTPSupport =
BEGIN
ROPE: TYPE = Rope.ROPE;
STREAM: TYPE = IO.STREAM;
Descr: TYPE = SMTPDescr.Descr;
Logging Information
currentLogAcceptPriority: PUBLIC SMTPSupport.LogPriority ← SMTPControl.defaultLogAcceptPriority;
Log:
PUBLIC PROC [priority: SMTPSupport.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
ENABLE SMTPDescr.CreateFailed => CONTINUE;
date: ROPE ← Rope.Cat["Date: ", RFC822Date[now], "\n"];
from: ROPE ← Rope.Cat["From: ", SMTPControl.deadLetterSenderName, "\n"];
to: ROPE ← Rope.Cat["To: ", SMTPControl.notifyManagerNames.first, "\n"];
subject: ROPE ← "Subject: Confusion in Mail Gateway\n\n";
header: ROPE ← Rope.Cat[date, from, to, subject];
descr: Descr ← SMTPDescr.Create[
gvSender: SMTPControl.deadLetterSenderName,
rawRecipients: SMTPControl.notifyManagerNames,
format: arpa, -- don't have GV items
msgStream:
IO.
RIS[Rope.Cat[header,
Rope.Cat[note1, note2, note3, note4, note5],
Rope.Cat[note6, note7, note8, note9, note10]]]];
ForkNewMessage[descr, "ATTENTION"]; }; };
ForkNewMessage:
PROC [descr: Descr, queue:
ROPE] =
TRUSTED {
Process.Detach[FORK SMTPQueue.AddNewMessage[descr, queue]]; };
HeaderParseError:
PUBLIC
PROC [recipList:
LIST
OF
ROPE, descr: Descr] = {
ENABLE SMTPDescr.CreateFailed => CONTINUE;
now: BasicTime.GMT ← BasicTime.Now[];
date: ROPE ← Rope.Cat["Date: ", RFC822Date[now], "\n"];
from: ROPE ← Rope.Cat["From: ", SMTPControl.deadLetterSenderName, "\n"];
to: ROPE ← Rope.Cat["To: ", SMTPControl.arpaExceptions.first, "\n"];
subject: ROPE ← "Subject: Parsing Error in Message Header\n\n";
header: ROPE ← Rope.Cat[date, from, to, subject];
getReturnPathLine: ROPE ← SMTPDescr.GetReturnPathLine[descr];
getPrecedeMsgText: ROPE ← SMTPDescr.GetPrecedeMsgText[descr];
msgStream: IO.STREAM;
errors: IO.STREAM ← IO.ROS[];
before: IO.STREAM ← IO.ROS[];
after: IO.STREAM ← IO.ROS[];
info: MT.Info;
body: ROPE;
new: Descr;
msgStream ← SMTPDescr.RetrieveMsgStream[descr];
SELECT SMTPDescr.GetFormat[descr]
FROM
arpa => {
info ← MT.ParseHeaders[file: msgStream, errStream: errors];
msgStream.Close[];
MT.PrintHeaders[info, before];
MT.TranslateToGrapevine[info];
MT.PrintHeaders[info, after]; };
gv => {
-- Copied from SMTPSendImpl
AssignTextStream: SMTPSyntax.GVItemProc = {
currentIndex: INT;
IF itemHeader.type # Text THEN RETURN;
currentIndex ← msgStream.GetIndex[];
msgStream ← CreateSubrangeStream[
origStream: msgStream, min: currentIndex, max: currentIndex+itemHeader.length];
continue ← FALSE; };
SMTPSyntax.EnumerateGVItems[GVStream: msgStream, proc: AssignTextStream];
info ← MT.ParseHeaders[file: msgStream, errStream: errors];
msgStream.Close[];
MT.PrintHeaders[info, before];
MT.TranslateToArpa[info];
MT.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 ← SMTPDescr.Create[
gvSender: SMTPControl.deadLetterSenderName,
rawRecipients: SMTPControl.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 SMTPDescr.CreateFailed => CONTINUE;
now: BasicTime.GMT ← BasicTime.Now[];
date: ROPE ← Rope.Cat["Date: ", RFC822Date[now], "\n"];
from: ROPE ← Rope.Cat["From: ", SMTPControl.deadLetterSenderName, "\n"];
to: ROPE ← Rope.Cat["To: ", SMTPControl.deadLetterName, "\n"];
subject: ROPE ← "Subject: Undeliverable mail notification\n\n";
header: ROPE ← Rope.Cat[date, from, to, subject];
getReturnPathLine: ROPE ← SMTPDescr.GetReturnPathLine[descr];
getPrecedeMsgText: ROPE ← SMTPDescr.GetPrecedeMsgText[descr];
msgStream: IO.STREAM;
errors: IO.STREAM ← IO.ROS[];
before: IO.STREAM ← IO.ROS[];
info: MT.Info;
sender, body: ROPE;
new: Descr;
msgStream ← SMTPDescr.RetrieveMsgStream[descr];
SELECT SMTPDescr.GetFormat[descr]
FROM
arpa => {
sender ← SMTPDescr.GetArpaReversePath[descr];
info ← MT.ParseHeaders[file: msgStream, errStream: errors];
msgStream.Close[];
MT.PrintHeaders[info, before]; };
gv => {
-- Copied from SMTPSendImpl
AssignTextStream: SMTPSyntax.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 ← SMTPDescr.GetGvSender[descr];
SMTPSyntax.EnumerateGVItems[GVStream: msgStream, proc: AssignTextStream];
info ← MT.ParseHeaders[file: msgStream, errStream: errors];
msgStream.Close[];
MT.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 ← SMTPDescr.Create[
gvSender: SMTPControl.deadLetterSenderName,
rawRecipients: LIST[SMTPControl.deadLetterName],
format: arpa, -- don't have GV items
msgStream: IO.RIS[Rope.Cat[header, body]]];
ForkNewMessage[new, "Undeliverable"]; };
WriteToLog:
ENTRY PROC [priority: SMTPSupport.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 SMTPSupport.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 ← SMTPDescr.GetPrecedeMsgText[descr];
errorRope: ROPE;
info: MT.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 SMTPDescr.GetFormat[descr]
FROM
arpa => RETURN; -- Don't check ARPA headers (yet)
gv => {
-- Copied from SMTPSendImpl
AssignTextStream: SMTPSyntax.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 ← SMTPDescr.GetArpaReversePath[descr];
IF Rope.Find[SMTPDescr.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 ← SMTPDescr.RetrieveMsgStream[descr];
SMTPSyntax.EnumerateGVItems[GVStream: msgStream, proc: AssignTextStream];
info ← MT.ParseHeaders[file: msgStream, errStream: errors];
msgStream.Close[];
errorRope ← IO.RopeFromROS[errors];
IF Rope.IsEmpty[errorRope]
AND ~ArpaSender[descr]
AND ~
MT.CheckFromField[info]
THEN
errorRope ← "A weird character in the From field (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: SMTPDescr.RawRecipProc = {
IF recipients = NIL THEN recipients ← "Recipients: "
ELSE recipients ← Rope.Cat[recipients, ", "];
recipients ← Rope.Cat[recipients, rawRecipient]; };
SMTPDescr.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 sites your message was not delivered to any remote 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 {
SMTPDescr.CreateFailed =>
Log[ATTENTION,
"Unable to create descriptor to return item ", SMTPDescr.Unparse[descr],
" to sender. Being returned because: \"",
why1, why2, why3, why4, why5, "\".\nToo bad!"];
SMTPDescr.WrongState =>
Log[noteworthy,
"Asked to return item ", SMTPDescr.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 ← SMTPDescr.CopyForReturn[descr,
Rope.Cat[why,
"\n\nThe text of your message was\n--------------------\n"]];
Log[important,
SMTPDescr.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[SMTPControl.longGVMSName];
logViewerOut.PutRope[" Log ##########\n\n"];
END.